|
}</lang>
=={{header|Haskell}}==
<lang haskell>import Data.List (partition, intersect, nub)
import Control.Monad
import System.Random (StdGen, getStdRandom, randomR)
import Text.Printf
numberOfDigits = 4 :: Int
Program BullCow;
main = bullsAndCows
{$mode objFPC}
bullsAndCows :: IO ()
uses Math, SysUtils;
bullsAndCows = do
digits <- getStdRandom $ pick numberOfDigits ['1' .. '9']
type
putStrLn "Guess away!"
TFourDigit = array[1..4] of integer;
loop digits
Procedure WriteFourDigit(fd: TFourDigit);
where loop digits = do
{ Write out a TFourDigit with no line break following. }
input <- getLine
var
if okay input
i: integer;
then
begin
let (bulls, cows) = score digits input in
for i := 1 to 4 do
if bulls == numberOfDigits then
begin
putStrLn "You win!"
Write(fd[i]);
else do
end;
printf "%d bulls, %d cows.\n" bulls cows
end;
loop digits
else do
Function WellFormed(Tentative: TFourDigit): Boolean;
putStrLn "Malformed guess; try again."
{ Does the TFourDigit avoid repeating digits? }
loop digits
var
current, check: integer;
okay :: String -> Bool
begin
okay input =
length input == numberOfDigits &&
Result := True;
input == nub input &&
all legalchar input
for current := 1 to 4 do
where legalchar c = '1' <= c && c <= '9'
begin
for check := current + 1 to 4 do
score :: String -> String -> (Int, Int)
begin
score secret guess = (length bulls, cows)
if Tentative[check] = Tentative[current] then
where (bulls, nonbulls) = partition (uncurry (==)) $
begin
Result := False; zip secret guess
cows = length $ uncurry intersect $ unzip nonbulls
end;
end;
pick :: Int -> [a] -> StdGen -> ([a], StdGen)
end;
{- Randomly selects items from a list without replacement. -}
pick n l g = f n l g (length l - 1) []
end;
where f 0 _ g _ ps = (ps, g)
f n l g max ps =
Function MakeNumber(): TFourDigit;
f (n - 1) (left ++ right) g' (max - 1) (picked : ps)
{ Make a random TFourDigit, keeping trying until it is well-formed. }
where (i, g') = randomR (0, max) g
var
(left, picked : right) = splitAt i l</lang>
i: integer;
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}}==
|