Bulls and cows: Difference between revisions
Content added Content deleted
(→{{header|Lasso}}: Adding Lasso example) |
|||
| Line 1,575: | Line 1,575: | ||
}</lang> |
}</lang> |
||
=={{header|Haskell}}== |
|||
<lang haskell>import Data.List (partition, intersect, nub) |
|||
import Control.Monad |
|||
import System.Random (StdGen, getStdRandom, randomR) |
|||
import Text.Printf |
|||
Program BullCow; |
|||
numberOfDigits = 4 :: Int |
|||
{$mode objFPC} |
|||
main = bullsAndCows |
|||
uses Math, SysUtils; |
|||
bullsAndCows :: IO () |
|||
bullsAndCows = do |
|||
type |
|||
digits <- getStdRandom $ pick numberOfDigits ['1' .. '9'] |
|||
TFourDigit = array[1..4] of integer; |
|||
putStrLn "Guess away!" |
|||
loop digits |
|||
Procedure WriteFourDigit(fd: TFourDigit); |
|||
{ Write out a TFourDigit with no line break following. } |
|||
where loop digits = do |
|||
var |
|||
input <- getLine |
|||
i: integer; |
|||
if okay input |
|||
begin |
|||
then |
|||
for i := 1 to 4 do |
|||
let (bulls, cows) = score digits input in |
|||
begin |
|||
if bulls == numberOfDigits then |
|||
Write(fd[i]); |
|||
putStrLn "You win!" |
|||
end; |
|||
else do |
|||
end; |
|||
printf "%d bulls, %d cows.\n" bulls cows |
|||
loop digits |
|||
Function WellFormed(Tentative: TFourDigit): Boolean; |
|||
else do |
|||
{ Does the TFourDigit avoid repeating digits? } |
|||
putStrLn "Malformed guess; try again." |
|||
var |
|||
loop digits |
|||
current, check: integer; |
|||
begin |
|||
okay :: String -> Bool |
|||
okay input = |
|||
Result := True; |
|||
length input == numberOfDigits && |
|||
input == nub input && |
|||
for current := 1 to 4 do |
|||
all legalchar input |
|||
begin |
|||
where legalchar c = '1' <= c && c <= '9' |
|||
for check := current + 1 to 4 do |
|||
begin |
|||
score :: String -> String -> (Int, Int) |
|||
if Tentative[check] = Tentative[current] then |
|||
score secret guess = (length bulls, cows) |
|||
begin |
|||
where (bulls, nonbulls) = partition (uncurry (==)) $ |
|||
Result := False; |
|||
end; |
|||
cows = length $ uncurry intersect $ unzip nonbulls |
|||
end; |
|||
end; |
|||
pick :: Int -> [a] -> StdGen -> ([a], StdGen) |
|||
{- Randomly selects items from a list without replacement. -} |
|||
end; |
|||
pick n l g = f n l g (length l - 1) [] |
|||
where f 0 _ g _ ps = (ps, g) |
|||
Function MakeNumber(): TFourDigit; |
|||
f n l g max ps = |
|||
{ Make a random TFourDigit, keeping trying until it is well-formed. } |
|||
f (n - 1) (left ++ right) g' (max - 1) (picked : ps) |
|||
var |
|||
where (i, g') = randomR (0, max) g |
|||
i: integer; |
|||
(left, picked : right) = splitAt i l</lang> |
|||
begin |
|||
for i := 1 to 4 do |
|||
begin |
|||
Result[i] := RandomRange(1, 9); |
|||
end; |
|||
if not WellFormed(Result) then |
|||
begin |
|||
Result := MakeNumber(); |
|||
end; |
|||
end; |
|||
Function StrToFourDigit(s: string): TFourDigit; |
|||
{ Convert an (input) string to a TFourDigit. } |
|||
var |
|||
i: integer; |
|||
begin |
|||
for i := 1 to Length(s) do |
|||
begin |
|||
StrToFourDigit[i] := StrToInt(s[i]); |
|||
end; |
|||
end; |
|||
Function Wins(Num, Guess: TFourDigit): Boolean; |
|||
{ Does the guess win? } |
|||
var |
|||
i: integer; |
|||
begin |
|||
Result := True; |
|||
for i := 1 to 4 do |
|||
begin |
|||
if Num[i] <> Guess[i] then |
|||
begin |
|||
Result := False; |
|||
Exit; |
|||
end; |
|||
end; |
|||
end; |
|||
Function GuessScore(Num, Guess: TFourDigit): string; |
|||
{ Represent the score of the current guess as a string. } |
|||
var |
|||
i, j, bulls, cows: integer; |
|||
begin |
|||
bulls := 0; |
|||
cows := 0; |
|||
{ Count the cows and bulls. } |
|||
for i := 1 to 4 do |
|||
begin |
|||
for j := 1 to 4 do |
|||
begin |
|||
if (Num[i] = Guess[j]) then |
|||
begin |
|||
{ If the indices are the same, that would be a bull. } |
|||
if (i = j) then |
|||
begin |
|||
bulls := bulls + 1; |
|||
end |
|||
else |
|||
begin |
|||
cows := cows + 1; |
|||
end; |
|||
end; |
|||
end; |
|||
end; |
|||
{ Format the result as a sentence. } |
|||
Result := IntToStr(bulls) + ' bulls, ' + IntToStr(cows) + ' cows.'; |
|||
end; |
|||
Function GetGuess(): TFourDigit; |
|||
{ Get a well-formed user-supplied TFourDigit guess. } |
|||
var |
|||
input: string; |
|||
begin |
|||
WriteLn('Enter a guess:'); |
|||
ReadLn(input); |
|||
{ Must be 4 digits. } |
|||
if Length(input) = 4 then |
|||
begin |
|||
Result := StrToFourDigit(input); |
|||
if not WellFormed(Result) then |
|||
begin |
|||
WriteLn('Four unique digits, please.'); |
|||
Result := GetGuess(); |
|||
end; |
|||
end |
|||
else |
|||
begin |
|||
WriteLn('Please guess a four-digit number.'); |
|||
Result := GetGuess(); |
|||
end; |
|||
end; |
|||
var |
|||
Num, Guess: TFourDigit; |
|||
Turns: integer; |
|||
begin |
|||
{ Initialize the randymnity. } |
|||
Randomize(); |
|||
{ Make the secred number. } |
|||
Num := MakeNumber(); |
|||
WriteLn('I have a secret number. Guess it!'); |
|||
Turns := 0; |
|||
{ Guess until the user gets it. } |
|||
While True do |
|||
begin |
|||
Guess := GetGuess(); |
|||
{ Count each guess as a turn. } |
|||
Turns := Turns + 1; |
|||
{ If the user won, tell them and ditch. } |
|||
if Wins(Num, Guess) then |
|||
begin |
|||
WriteLn('You won in ' + IntToStr(Turns) + ' tries.'); |
|||
Write('The number was '); |
|||
WriteFourDigit(Num); |
|||
WriteLn('!'); |
|||
Exit; |
|||
end |
|||
else { Otherwise, score it and get a new guess. } |
|||
begin |
|||
WriteLn(GuessScore(Num, Guess)); |
|||
end; |
|||
end; |
|||
end. |
|||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |
||