Bulls and cows/Player: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|Go}}: simplify description)
m (→‎{{header|Go}}: library change)
Line 687: Line 687:
s2 := strings.Fields(score)
s2 := strings.Fields(score)
if len(s2) == 2 {
if len(s2) == 2 {
c, err = strconv.Atoui(s2[0])
c2, err := strconv.ParseUint(s2[0], 10, 0)
if err == nil && c <= 4 {
if err == nil && c2 <= 4 {
b, err = strconv.Atoui(s2[1])
b2, err := strconv.ParseUint(s2[1], 10, 0)
if err == nil && c+b <= 4 {
if err == nil && c2+b2 <= 4 {
c = uint(c2)
b = uint(b2)
break
break
}
}

Revision as of 03:49, 15 December 2011

Task
Bulls and cows/Player
You are encouraged to solve this task according to the task description, using any language you may know.

The task is to write a player of the Bulls and Cows game, rather than a scorer. The player should give intermediate answers that respect the scores to previous attempts.

One method is to generate a list of all possible numbers that could be the answer, then to prune the list by keeping only those numbers that would give an equivalent score to how your last guess was scored. Your next guess can be any number from the pruned list.
Either you guess correctly or run out of numbers to guess, which indicates a problem with the scoring.

C.f: Guess the number/With Feedback (Player)

Ada

Works with: Ada 2005

bulls_player.adb: <lang Ada>with Ada.Text_IO; with Ada.Containers.Vectors; with Ada.Numerics.Discrete_Random;

procedure Bulls_Player is

  -- package for In-/Output of natural numbers
  package Nat_IO is new Ada.Text_IO.Integer_IO (Natural);
  -- for comparing length of the vectors
  use type Ada.Containers.Count_Type;
  -- number of digits
  Guessing_Length : constant := 4;
  -- digit has to be from 1 to 9
  type Digit is range 1 .. 9;
  -- a sequence has specified length of digits
  type Sequence is array (1 .. Guessing_Length) of Digit;
  -- data structure to store the possible answers
  package Sequence_Vectors is new Ada.Containers.Vectors
    (Element_Type => Sequence,
     Index_Type   => Positive);
  -- check if sequence contains each digit only once
  function Is_Valid (S : Sequence) return Boolean is
     Appeared : array (Digit) of Boolean := (others => False);
  begin
     for I in S'Range loop
        if Appeared (S (I)) then
           return False;
        end if;
        Appeared (S (I))  := True;
     end loop;
     return True;
  end Is_Valid;
  -- calculate all possible sequences and store them in the vector
  procedure Fill_Pool (Pool : in out Sequence_Vectors.Vector) is
     Finished : exception;
     -- count the sequence up by one
     function Next (S : Sequence) return Sequence is
        Result : Sequence := S;
        Index  : Positive := S'Last;
     begin
        loop
        -- overflow at a position causes next position to increase
           if Result (Index) = Digit'Last then
              Result (Index) := Digit'First;
              -- overflow at maximum position
              -- we have processed all possible values
              if Index = Result'First then
                 raise Finished;
              end if;
              Index := Index - 1;
           else
              Result (Index) := Result (Index) + 1;
              return Result;
           end if;
        end loop;
     end Next;
     X        : Sequence := (others => 1);
  begin
     loop
     -- append all valid values
        if Is_Valid (X) then
           Pool.Append (X);
        end if;
        X := Next (X);
     end loop;
  exception
     when Finished =>
        -- the exception tells us that we have added all possible values
        -- simply return and do nothing.
        null;
  end Fill_Pool;
  -- generate a random index from the pool
  function Random_Index (Pool : Sequence_Vectors.Vector) return Positive is
     subtype Possible_Indexes is Positive range
       Pool.First_Index .. Pool.Last_Index;
     package Index_Random is new Ada.Numerics.Discrete_Random
       (Possible_Indexes);
     Index_Gen : Index_Random.Generator;
  begin
     Index_Random.Reset (Index_Gen);
     return Index_Random.Random (Index_Gen);
  end Random_Index;
  -- get the answer from the player, simple validity tests
  procedure Get_Answer (S : Sequence; Bulls, Cows : out Natural) is
     Valid : Boolean := False;
  begin
     Bulls := 0;
     Cows  := 0;
     while not Valid loop
        -- output the sequence
        Ada.Text_IO.Put ("How is the score for:");
        for I in S'Range loop
           Ada.Text_IO.Put (Digit'Image (S (I)));
        end loop;
        Ada.Text_IO.New_Line;
        begin
           Ada.Text_IO.Put ("Bulls:");
           Nat_IO.Get (Bulls);
           Ada.Text_IO.Put ("Cows:");
           Nat_IO.Get (Cows);
           if Bulls + Cows <= Guessing_Length then
              Valid := True;
           else
              Ada.Text_IO.Put_Line ("Invalid answer, try again.");
           end if;
        exception
           when others =>
              null;
        end;
     end loop;
  end Get_Answer;
  -- remove all sequences that wouldn't give an equivalent score
  procedure Strip
    (V           : in out Sequence_Vectors.Vector;
     S           : Sequence;
     Bulls, Cows : Natural)
  is
     function Has_To_Be_Removed (Position : Positive) return Boolean is
        Testant    : constant Sequence := V.Element (Position);
        Bull_Score : Natural           := 0;
        Cows_Score : Natural := 0;
     begin
        for I in Testant'Range loop
           for J in S'Range loop
              if Testant (I) = S (J) then
                 -- same digit at same position: Bull!
                 if I = J then
                    Bull_Score := Bull_Score + 1;
                 else
                    Cow_Score := Cow_Score + 1;
                 end if;
              end if;
           end loop;
        end loop;
        return Cow_Score /= Cows or else Bull_Score /= Bulls;
     end Has_To_Be_Removed;
  begin
     for Index in reverse V.First_Index .. V.Last_Index loop
        if Has_To_Be_Removed (Index) then
           V.Delete (Index);
        end if;
     end loop;
  end Strip;
  -- main routine
  procedure Solve is
     All_Sequences : Sequence_Vectors.Vector;
     Test_Index    : Positive;
     Test_Sequence : Sequence;
     Bulls, Cows   : Natural;
  begin
     -- generate all possible sequences
     Fill_Pool (All_Sequences);
     loop
     -- pick at random
        Test_Index    := Random_Index (All_Sequences);
        Test_Sequence := All_Sequences.Element (Test_Index);
        -- ask player
        Get_Answer (Test_Sequence, Bulls, Cows);
        -- hooray, we have it!
        exit when Bulls = 4;
        All_Sequences.Delete (Test_Index);
        Strip (All_Sequences, Test_Sequence, Bulls, Cows);
        exit when All_Sequences.Length <= 1;
     end loop;
     if All_Sequences.Length = 0 then
        -- oops, shouldn't happen
        Ada.Text_IO.Put_Line
          ("I give up, there has to be a bug in" &
           "your scoring or in my algorithm.");
     else
        if All_Sequences.Length = 1 then
           Ada.Text_IO.Put ("The sequence you thought has to be:");
           Test_Sequence := All_Sequences.First_Element;
        else
           Ada.Text_IO.Put ("The sequence you thought of was:");
        end if;
        for I in Test_Sequence'Range loop
           Ada.Text_IO.Put (Digit'Image (Test_Sequence (I)));
        end loop;
     end if;
  end Solve;

begin

  -- output blah blah
  Ada.Text_IO.Put_Line ("Bulls and Cows, Your turn!");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line
    ("Think of a sequence of" &
     Integer'Image (Guessing_Length) &
     " different digits.");
  Ada.Text_IO.Put_Line ("I will try to guess it. For each correctly placed");
  Ada.Text_IO.Put_Line ("digit I score 1 Bull. For each digit that is on");
  Ada.Text_IO.Put_Line ("the wrong place I score 1 Cow. After each guess");
  Ada.Text_IO.Put_Line ("you tell me my score.");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line ("Let's start.");
  Ada.Text_IO.New_Line;
  -- solve the puzzle
  Solve;

end Bulls_Player;</lang>

output:

Bulls and Cows, Your turn!

Think of a sequence of 4 different digits.
I will try to guess it. For each correctly placed
digit I score 1 Bull. For each digit that is on
the wrong place I score 1 Cow. After each guess
you tell me my score.

Let's start.

How is the score for: 8 1 7 5
Bulls:2
Cows:0
How is the score for: 4 1 6 5
Bulls:1
Cows:0
How is the score for: 3 9 7 5
Bulls:1
Cows:2
How is the score for: 9 1 7 3
Bulls:0
Cows:2
The sequence you thought has to be: 8 3 9 5

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <string.h>
  3. include <time.h>

char *list; const char *line = "--------+--------------------\n"; int len = 0;

int irand(int n) { int r, rand_max = RAND_MAX - (RAND_MAX % n); do { r = rand(); } while(r >= rand_max); return r / (rand_max / n); }

char* get_digits(int n, char *ret) { int i, j; char d[] = "123456789";

for (i = 0; i < n; i++) { j = irand(9 - i); ret[i] = d[i + j]; if (j) d[i + j] = d[i], d[i] = ret[i]; } return ret; }

  1. define MASK(x) (1 << (x - '1'))

int score(const char *digits, const char *guess, int *cow) { int i, bits = 0, bull = *cow = 0;

for (i = 0; guess[i] != '\0'; i++) if (guess[i] != digits[i]) bits |= MASK(digits[i]); else ++bull;

while (i--) *cow += ((bits & MASK(guess[i])) != 0);

return bull; }

void pick(int n, int got, int marker, char *buf) { int i, bits = 1; if (got >= n) strcpy(list + (n + 1) * len++, buf); else for (i = 0; i < 9; i++, bits *= 2) { if ((marker & bits)) continue; buf[got] = i + '1'; pick(n, got + 1, marker | bits, buf); } }

void filter(const char *buf, int n, int bull, int cow) { int i = 0, c; char *ptr = list;

while (i < len) { if (score(ptr, buf, &c) != bull || c != cow) strcpy(ptr, list + --len * (n + 1)); else ptr += n + 1, i++; } }

void game(const char *tgt, char *buf) { int i, p, bull, cow, n = strlen(tgt);

for (i = 0, p = 1; i < n && (p *= 9 - i); i++); list = malloc(p * (n + 1));

pick(n, 0, 0, buf); for (p = 1, bull = 0; n - bull; p++) { strcpy(buf, list + (n + 1) * irand(len)); bull = score(tgt, buf, &cow);

printf("Guess %2d| %s (from: %d)\n" "Score | %d bull, %d cow\n%s", p, buf, len, bull, cow, line);

filter(buf, n, bull, cow); } }

int main(int c, char **v) { int n = c > 1 ? atoi(v[1]) : 4;

char secret[10] = "", answer[10] = ""; srand(time(0));

printf("%sSecret | %s\n%s", line, get_digits(n, secret), line); game(secret, answer);

return 0; }</lang>sample output for 4 digits:<lang>--------+-------------------- Secret | 5437


+--------------------

Guess 1| 7198 (from: 3024) Score | 0 bull, 1 cow


+--------------------

Guess 2| 2386 (from: 720) Score | 0 bull, 1 cow


+--------------------

Guess 3| 5743 (from: 122) Score | 1 bull, 3 cow


+--------------------

Guess 4| 5437 (from: 5) Score | 4 bull, 0 cow


+--------------------

</lang>sample output for 9 digits<lang>--------+-------------------- Secret | 758214936


+--------------------

Guess 1| 245863197 (from: 362880) Score | 0 bull, 9 cow


+--------------------

Guess 2| 964715382 (from: 133496) Score | 1 bull, 8 cow


+--------------------

Guess 3| 614927853 (from: 48722) Score | 0 bull, 9 cow


+--------------------

Guess 4| 567391248 (from: 15926) Score | 0 bull, 9 cow


+--------------------

Guess 5| 839174562 (from: 4473) Score | 1 bull, 8 cow


+--------------------

Guess 6| 489635721 (from: 1503) Score | 0 bull, 9 cow


+--------------------

Guess 7| 723156984 (from: 317) Score | 2 bull, 7 cow


+--------------------

Guess 8| 953278614 (from: 89) Score | 2 bull, 7 cow


+--------------------

Guess 9| 321479685 (from: 24) Score | 0 bull, 9 cow


+--------------------

Guess 10| 893752416 (from: 4) Score | 1 bull, 8 cow


+--------------------

Guess 11| 758214936 (from: 1) Score | 9 bull, 0 cow


+--------------------</lang>

C#

Works with: C# version 3.0

<lang csharp> using System; using System.Collections.Generic; using System.Linq; using System.Text;

namespace BullsAndCows {

   class Program
   {
       const int ANSWER_SIZE = 4;
       static IEnumerable<string> Permutations(int size)
       {
           if (size > 0)
           {
               foreach (string s in Permutations(size - 1))
                   foreach (char n in "123456789")
                       if (!s.Contains(n))
                           yield return s + n;
           }
           else
               yield return "";
       }
       static IEnumerable<T> Shuffle<T>(IEnumerable<T> source)
       {
           Random random = new Random();
           List<T> list = source.ToList();
           while (list.Count > 0)
           {
               int ix = random.Next(list.Count);
               yield return list[ix];
               list.RemoveAt(ix);
           }
       }
       static bool ReadBullsCows(out int bulls, out int cows)
       {
           string[] input = Console.ReadLine().Split(',').ToArray();
           bulls = cows = 0;
           if (input.Length < 2)
               return false;
           else
               return int.TryParse(input[0], out bulls)
                   && int.TryParse(input[1], out cows);
       }
       static void Main(string[] args)
       {
           Console.WriteLine("Bulls and Cows");
           Console.WriteLine("==============");
           Console.WriteLine();
           List<string> answers = Shuffle(Permutations(ANSWER_SIZE)).ToList();
           while (answers.Count > 1)
           {
               string guess = answers[0];
               Console.Write("My guess is {0}. How many bulls, cows? ", guess);
               int bulls, cows;
               if (!ReadBullsCows(out bulls, out cows))
                   Console.WriteLine("Sorry, I didn't understand that. Please try again.");
               else
                   for (int ans = answers.Count - 1; ans >= 0; ans--)
                   {
                       int tb = 0, tc = 0;
                       for (int ix = 0; ix < ANSWER_SIZE; ix++)
                           if (answers[ans][ix] == guess[ix])
                               tb++;
                           else if (answers[ans].Contains(guess[ix]))
                               tc++;
                       if ((tb != bulls) || (tc != cows))
                           answers.RemoveAt(ans);
                   }
           }
           if (answers.Count == 1)
               Console.WriteLine("Hooray! The answer is {0}!", answers[0]);
           else
               Console.WriteLine("No possible answer fits the scores you gave.");
       }
   }

} </lang> Example output:-

Bulls and Cows
==============

My guess is 7854. How many bulls, cows? 0,1
My guess is 1539. How many bulls, cows? 1,2
My guess is 2935. How many bulls, cows? 2,1
My guess is 9635. How many bulls, cows? 1,3
Hooray! The answer is 5936!

Fortran

Works with: Fortran version 90 and later

<lang fortran>module Player

 implicit none

contains

subroutine Init(candidates)

 integer, intent(in out) :: candidates(:)
 integer :: a, b, c, d, n
   
          n = 0

thousands: do a = 1, 9 hundreds: do b = 1, 9 tens: do c = 1, 9 units: do d = 1, 9

                  if (b == a) cycle hundreds
                  if (c == b .or. c == a) cycle tens
                  if (d == c .or. d == b .or. d == a) cycle units
                  n = n + 1
                  candidates(n) = a*1000 + b*100 + c*10 + d
                end do units
              end do tens
            end do hundreds
          end do thousands

end subroutine init

subroutine Evaluate(bulls, cows, guess, candidates)

 integer, intent(in) :: bulls, cows, guess
 integer, intent(in out) :: candidates(:)
 integer :: b, c, s, i, j
 character(4) :: n1, n2
  
 write(n1, "(i4)") guess
 do i = 1, size(candidates)
   if (candidates(i) == 0) cycle
   b = 0
   c = 0
   write(n2, "(i4)") candidates(i)
   do j = 1, 4
     s = index(n1, n2(j:j)) 
     if(s /= 0) then
       if(s == j) then
         b = b + 1
       else
         c = c + 1
       end if
     end if
   end do
   if(.not.(b == bulls .and. c == cows)) candidates(i) = 0
 end do

end subroutine Evaluate

function Nextguess(candidates)

 integer :: Nextguess
 integer, intent(in out) :: candidates(:)
 integer :: i
 nextguess = 0
 do i = 1, size(candidates)
   if(candidates(i) /= 0) then
     nextguess = candidates(i)
     candidates(i) = 0
     return
    end if
 end do

end function end module Player

program Bulls_Cows

 use Player
 implicit none
 integer :: bulls, cows, initial, guess
 integer :: candidates(3024) = 0
 real :: rnum

! Fill candidates array with all possible number combinations

 call Init(candidates)

! Random initial guess

 call random_seed
 call random_number(rnum)
 initial = 3024 * rnum + 1
 guess = candidates(initial)
 candidates(initial) = 0
 
 do 
   write(*, "(a, i4)") "My guess is ", guess
   write(*, "(a)", advance = "no") "Please score number of Bulls and Cows: "
   read*, bulls, cows
   write(*,*)
   if (bulls == 4) then
     write(*, "(a)") "Solved!"
     exit
   end if

! We haven't found the solution yet so evaluate the remaining candidates ! and eliminate those that do not match the previous score given

   call Evaluate(bulls, cows, guess, candidates)

! Get the next guess from the candidates that are left

   guess = Nextguess(candidates)
   if(guess == 0) then

! If we get here then no solution is achievable from the scores given or the program is bugged

     write(*, "(a)") "Sorry! I can't find a solution. Possible mistake in the scoring"
     exit
   end if
 end do

end program</lang> Output

My guess is 1528
Please score number of Bulls and Cows: 0 1

My guess is 2346
Please score number of Bulls and Cows: 0 1

My guess is 3179
Please score number of Bulls and Cows: 1 2

My guess is 3795
Please score number of Bulls and Cows: 0 2

My guess is 4971
Please score number of Bulls and Cows: 2 2

My guess is 9471
Please score number of Bulls and Cows: 4 0

Solved!

Go

Notes: Strategy per the suggestion in the problem description. Check algorithm lifted from Bulls and cows program. Code here uses Go's built in map type as the container for the list of still-possible numbers; only the map key is used, the value is assigned a dummy of 0. <lang go>package main

import (

   "bufio"
   "fmt"
   "os"
   "strconv"
   "strings"

)

func main() {

   fmt.Println(`Cows and bulls/player

You think of four digit number of unique digits in the range 1 to 9. I guess. You score my guess:

   A correct digit but not in the correct place is a cow.
   A correct digit in the correct place is a bull.

You give my score as two numbers separated with a space.`)

   // generate possible patterns, store in map
   m := make(map[string]int)
   var g func([]byte, int)
   g = func(digits []byte, fixed int) {
       if fixed == 4 {
           m[string(digits[:4])] = 0
           return
       }
       for i := fixed; i < len(digits); i++ {
           digits[fixed], digits[i] = digits[i], digits[fixed]
           g(digits, fixed+1)
           digits[fixed], digits[i] = digits[i], digits[fixed]
       }
   }
   g([]byte("123456789"), 0)
   // guess/score/eliminate loop
   for in := bufio.NewReader(os.Stdin);; {
       // pick a value, ie, guess
       var guess string
       for guess = range m {
           delete(m, guess)
           break
       }
       // get and parse score
       var c, b uint
       for ;; fmt.Println("Score guess as two numbers: cows bulls") {
           fmt.Printf("My guess: %s.  Score? (c b) ", guess)
           score, err := in.ReadString('\n')
           if err != nil {
               fmt.Println("\nSo, bye.")
               return
           }
           s2 := strings.Fields(score)
           if len(s2) == 2 {
               c2, err := strconv.ParseUint(s2[0], 10, 0)
               if err == nil && c2 <= 4 {
                   b2, err := strconv.ParseUint(s2[1], 10, 0)
                   if err == nil && c2+b2 <= 4 {
                       c = uint(c2)
                       b = uint(b2)
                       break
                   }
               }
           }
       }
       // check for win
       if b == 4 {
           fmt.Println("I did it. :)")
           return
       }
       // eliminate patterns with non-matching scores
       for pat := range m {
           var cows, bulls uint
           for ig, cg := range guess {
               switch strings.IndexRune(pat, cg) {
               case -1:
               default: // I just think cows should go first
                   cows++
               case ig:
                   bulls++
               }
           }
           if cows != c || bulls != b {
               delete(m, pat)
           }
       }
       // check for inconsistency
       if len(m) == 0 {
           fmt.Println("Oops, check scoring.")
           return
       }
   }

}</lang>

Haskell

<lang haskell>import Data.List import Control.Monad import System.Random (randomRIO) import Data.Char(digitToInt)

combinationsOf 0 _ = [[]] combinationsOf _ [] = [] combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs

player = do

 let ps = concatMap permutations $ combinationsOf 4 ['1'..'9']
 play ps   where
 
 play ps =
   if null ps then 

putStrLn "Unable to find a solution"

   else do i <- randomRIO(0,length ps - 1)
           let p = ps!!i :: String

putStrLn ("My guess is " ++ p) >> putStrLn "How many bulls and cows?" input <- takeInput let bc = input ::[Int] ps' = filter((==sum bc).length. filter id. map (flip elem p)) $ filter((==head bc).length. filter id. zipWith (==) p) ps if length ps' == 1 then putStrLn $ "The answer is " ++ head ps' else play ps'

 takeInput = do
   inp <- getLine
   let ui = map digitToInt $ take 2 $ filter(`elem` ['0'..'4']) inp
   if sum ui > 4 || length ui /= 2 then
     do putStrLn "Wrong input. Try again"

takeInput else return ui</lang> Example: <lang haskell>*Main> player My guess is 4923 How many bulls and cows? 2 2 My guess is 3924 How many bulls and cows? 1 3 My guess is 4329 How many bulls and cows? 1 3 My guess is 4932 How many bulls and cows? 4 0 The answer is 4932</lang>

J

<lang j>require'misc'

poss=:1+~.4{."1 (i.!9)A.i.9 fmt=: ' ' -.~ ":

play=:3 :0

 while.1<#poss=.poss do.
   smoutput'guessing ',fmt guess=.({~ ?@#)poss
   bc=.+/\_".prompt 'how many bull and cows? '
   poss=.poss #~({.bc)=guess+/@:="1 poss
   poss=.poss #~({:bc)=guess+/@e."1 poss
 end.
 if.#poss do.
   'the answer is ',fmt,poss
 else.
   'no valid possibilities'
 end.

)</lang>

For example: <lang j> play guessing 7461 how many bull and cows? 0 1 guessing 3215 how many bull and cows? 0 3 guessing 2357 how many bull and cows? 2 0 guessing 1359 how many bull and cows? 3 0 the answer is 1358</lang>


Liberty BASIC

As supplied rhe code shows the remaining pool of numbers after each guess is scored. <lang lb> guesses =0

do while len( secret$) <4 ' zero not allowed <<<<<<<<<

   n$ =chr$( int( rnd( 1) *9) +49)
   if not( instr( secret$, n$)) then secret$ =secret$ +n$

loop

print " Secretly, my opponent just chose a number. But she didn't tell anyone! "; secret$; "." print " I can however be given a score for my guesses."

for i =1234 to 9876 ' <<<<<<<<<

   if check( str$( i)) =0 then available$ =available$ +" " +str$( i): k =k +1

next i

available$ =trim$( available$) ' remove the surplus, leading space

print print "Currently holding "; k; " possible numbers. "

while 1

   guess$ =word$( available$, 1 +int( k *rnd( 1)), " ")
   print
   print "Computer guessed "; guess$; " & got ";
   bulls    =0
   cows     =0
   guesses  =guesses +1
   r$    =score$( guess$, secret$)
   bulls =val( word$( r$, 1, ","))
   cows  =val( word$( r$, 2, ","))
   print bulls; " bull(s), and "; cows; " cow(s), .... ";
   if guess$ =secret$ then
       print "Computer won after "; guesses; " guesses!";
       secs =( time$( "seconds") -now +86400) mod 86400
       print " That took "; secs; " seconds. ENDED!"
       print
       print " Now scroll right to see original choice and check!"
       exit while
   end if
   print " so possible numbers are now only..."
   kk      =0
   new$    =""
   for j =1 to k
       bullsT    =0
       cowsT     =0
       possible$ =word$( available$, j, " ")
       r$ =score$( guess$, possible$)
       bullsT =val( word$( r$, 1, ","))
       cowsT  =val( word$( r$, 2, ","))
       if ( bullsT =bulls) and ( cowsT =cows)  then
           new$ =new$ +" " +possible$    '    keep those with same score
           kk =kk +1
           print possible$; " ";
           if ( kk mod 20) =0 then print
       end if
       scan
   next j
   available$ =trim$( new$)
   k =kk
   scan

wend

end

function score$( a$, b$) ' return as a csv string the number of bulls & cows.

   bulls    = 0:  cows     = 0
   for i = 1 to 4
       c$ = mid$( a$, i, 1)
       if mid$( b$, i, 1) = c$ then
           bulls = bulls + 1
       else
           if instr( b$, c$) <>0 and instr( b$, c$) <>i then cows = cows + 1
       end if
   next i
   score$ =str$( bulls); ","; str$( cows)

end function

function check( i$)

   check =0    '    zero flags available: 1 means not available
   for i =1 to 3
       for j =i +1 to 4
           if mid$( i$, i, 1) =mid$( i$, j, 1) then check =1
       next j
   next i
   if instr( i$, "0") then check =1

end function </lang>


Perl

<lang perl>#!/usr/bin/perl use warnings; use strict; use v5.10;

  1. Build a list of all possible solutions. The regular expression weeds
  2. out numbers containing zeroes or repeated digits. See how Perl
  3. automatically converts numbers to strings for us, just because we
  4. use them as if they were strings:

my @candidates = grep {not /0 | (\d) .* \1 /x} 1234 .. 9876;

  1. Repeatedly prompt for input until the user supplies a reasonable score.
  2. The regex validates the user's input and then returns two numbers,
  3. $+{BULLS} and $+{COWS}.

sub read_score($) {

   (my $guess) = @_;
   for (;;) {
       say "My guess: $guess   (from ", 0+@candidates, " possibilities)"; 
       if (<> =~ / ^ \h* (?<BULLS> \d) \h* (?<COWS> \d) \h* $ /x and
           $+{BULLS} + $+{COWS} <= 4) {
               return ($+{BULLS}, $+{COWS});
       }
       say "Please specify the number of bulls and the number of cows";
   }

}

sub score_correct($$$$) {

   my ($a, $b, $bulls, $cows) = @_;
   # Count the positions at which the digits match: 
   my $exact = () = grep {substr($a, $_, 1) eq substr($b, $_, 1)} 0 .. 3;
   # Cross-match all digits in $a against all digits in $b, using a regex
   # (specifically, a character class) instead of an explicit loop:
   my $loose = () = $a =~ /[$b]/g;
   return $bulls == $exact && $cows == $loose - $exact;

}

do {

   # Pick a number, display it, get the score, and discard candidates
   # that don't match the score:
   my $guess = @candidates[rand @candidates];
   my ($bulls, $cows) = read_score $guess;
   @candidates = grep {score_correct $_, $guess, $bulls, $cows} @candidates;

} while (@candidates > 1);

say(@candidates?

   "Your secret number is @candidates":
   "I think you made a mistake with your scoring");

</lang>

Sample game: <lang perl>msl@64Lucid:~/perl$ ./bulls-and-cows My guess: 1869 (from 3024 possibilities) 1 0 My guess: 3265 (from 240 possibilities) 0 2 My guess: 7853 (from 66 possibilities) 1 2 My guess: 7539 (from 7 possibilities) 0 3 Your secret number is 1357 msl@64Lucid:~/perl$</lang>

PicoLisp

<lang PicoLisp>(load "@lib/simul.l")

(de bullsAndCows ()

  (let Choices (shuffle (mapcan permute (subsets 4 (range 1 9))))
     (use (Guess Bulls Cows)
        (loop
           (prinl "Guessing " (setq Guess (pop 'Choices)))
           (prin "How many bulls and cows? ")
           (setq Bulls (read)  Cows (read))
           (setq Choices
              (filter
                 '((C)
                    (let B (cnt = Guess C)
                       (and
                          (= Bulls B)
                          (= Cows (- (length (sect Guess C)) B)) ) ) )
                 Choices ) )
           (NIL Choices "No matching solution")
           (NIL (cdr Choices) (pack "The answer is " (car Choices))) ) ) ) )</lang>

Output:

: (bullsAndCows)
Guessing 4217
How many bulls and cows? 0 2
Guessing 5762
How many bulls and cows? 1 1
Guessing 9372
How many bulls and cows? 0 1
Guessing 7864
How many bulls and cows? 1 2
Guessing 8754
How many bulls and cows? 0 2
-> "The answer is 2468"

PureBasic

<lang PureBasic>#answerSize = 4 Structure history

 answer.s
 bulls.i
 cows.i

EndStructure

Procedure evaluateGuesses(*answer.history, List remainingGuesses.s())

 Protected i, cows, bulls
 ForEach remainingGuesses()
   bulls = 0: cows = 0 
   For i = 1 To #answerSize
     If Mid(remainingGuesses(), i, 1) = Mid(*answer\answer, i, 1)
       bulls + 1
     ElseIf FindString(remainingGuesses(), Mid(*answer\answer, i, 1), 1)
       cows + 1
     EndIf 
   Next
   If bulls <> *answer\bulls Or cows <> *answer\cows
     DeleteElement(remainingGuesses())
   EndIf
 Next

EndProcedure

Procedure findPermutations(List permutations.s(), elementChar.s, permSize)

 Protected i, j, stackDepth, elementCount = Len(elementChar) - 1, working.s = Space(permSize), *working = @working
 permSize - 1
 Dim stack(permSize) ;holds index states
 
 Dim elements(elementCount)
 Dim elementChar.c(elementCount)
 For i = 0 To elementCount
   elementChar(i) = PeekC(@elementChar + i * SizeOf(Character))
 Next
 
 i = 0
 Repeat 
   While i <= elementCount
     If elements(i) = 0
       stack(stackDepth) = i
       If stackDepth = permSize
         For j = 0 To permSize
           PokeC(*working + j * SizeOf(Character), elementChar(stack(j)))
         Next
         AddElement(permutations())
         permutations() = working
       Else
         elements(i) = 1
         stackDepth + 1
         i = 0
         Continue ;skip update
       EndIf 
     EndIf 
     i + 1
   Wend
   stackDepth - 1
   If stackDepth < 0
     Break
   EndIf 
   i = stack(stackDepth) + 1
   elements(i - 1) = 0
 ForEver

EndProcedure


If OpenConsole()

 Define guess.s, guessNum, score.s, delimeter.s
 NewList remainingGuesses.s()
 NewList answer.history()
 findPermutations(remainingGuesses(), "123456789", 4)
 
 PrintN("Playing Bulls & Cows with " + Str(#answerSize) + " unique digits." + #CRLF$)
 Repeat
   If ListSize(remainingGuesses()) = 0
     If answer()\bulls = #answerSize And answer()\cows = 0
       PrintN(#CRLF$ + "Solved!")
       Break ;exit Repeat/Forever
     EndIf
     
     PrintN(#CRLF$ + "BadScoring!  Nothing fits the scores you gave.")
     ForEach answer()
       PrintN(answer()\answer + " -> [" + Str(answer()\bulls) + ", " + Str(answer()\cows) + "]")
     Next
     Break ;exit Repeat/Forever
   Else
     guessNum + 1
     SelectElement(remainingGuesses(), Random(ListSize(remainingGuesses()) - 1))
     guess = remainingGuesses()
     DeleteElement(remainingGuesses())
     
     Print("Guess #" + Str(guessNum) + " is " + guess + ".  What does it score (bulls, cows)?")
     score = Input()
     If CountString(score, ",") > 0: delimeter = ",": Else: delimeter = " ": EndIf
     
     AddElement(answer())
     answer()\answer = guess
     answer()\bulls = Val(StringField(score, 1, delimeter))
     answer()\cows = Val(StringField(score, 2, delimeter))
     evaluateGuesses(@answer(), remainingGuesses())
   EndIf
 ForEver
 
 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() 
 CloseConsole()

EndIf</lang> Sample output:

Playing Bulls & Cows with 4 unique digits.

Guess #1 is 6273.  What does it score (bulls, cows)?0,2
Guess #2 is 7694.  What does it score (bulls, cows)?0,2
Guess #3 is 9826.  What does it score (bulls, cows)?0,3
Guess #4 is 2569.  What does it score (bulls, cows)?2,0
Guess #5 is 2468.  What does it score (bulls, cows)?4,0

Solved!


Press ENTER to exit

Python

<lang python>from itertools import permutations from random import shuffle

try:

   raw_input

except:

   raw_input = input

try:

   from itertools import izip

except:

   izip = zip
   

digits = '123456789' size = 4

def parse_score(score):

   score = score.strip().split(',')
   return tuple(int(s.strip()) for s in score)

def scorecalc(guess, chosen):

   bulls = cows = 0
   for g,c in izip(guess, chosen):
       if g == c:
           bulls += 1
       elif g in chosen:
           cows += 1
   return bulls, cows

choices = list(permutations(digits, size)) shuffle(choices) answers = [] scores = []

print ("Playing Bulls & Cows with %i unique digits\n" % size)

while True:

   ans = choices[0]
   answers.append(ans)
   #print ("(Narrowed to %i possibilities)" % len(choices))
   score = raw_input("Guess %2i is %*s. Answer (Bulls, cows)? "
                     % (len(answers), size, .join(ans)))
   score = parse_score(score)
   scores.append(score)
   #print("Bulls: %i, Cows: %i" % score)
   found =  score == (size, 0)
   if found:
       print ("Ye-haw!")
       break
   choices = [c for c in choices if scorecalc(c, ans) == score]
   if not choices:
       print ("Bad scoring? nothing fits those scores you gave:")
       print ('  ' +
              '\n  '.join("%s -> %s" % (.join(an),sc)
                          for an,sc in izip(answers, scores)))
       break</lang>

Sample output

Playing Bulls & Cows with 4 unique digits

Guess  1 is 1935. Answer (Bulls, cows)? 0,2
Guess  2 is 4169. Answer (Bulls, cows)? 0,3
Guess  3 is 6413. Answer (Bulls, cows)? 1,1
Guess  4 is 9612. Answer (Bulls, cows)? 1,1
Guess  5 is 9481. Answer (Bulls, cows)? 3,0
Guess  6 is 9471. Answer (Bulls, cows)? 4,0
Ye-haw!

Sample bad output
If the scores are inconsistent you get output like:

Playing Bulls & Cows with 4 unique digits

Guess  1 is 1549. Answer (Bulls, cows)? 0,0
Guess  2 is 3627. Answer (Bulls, cows)? 1,0
Bad scoring? nothing fits those scores you gave:
  1549 -> (0, 0)
  3627 -> (1, 0)

Ruby

<lang ruby>size = 4 scores = [] guesses = [] puts "Playing Bulls & Cows with #{size} unique digits." possible_guesses = ('1'..'9').to_a.permutation(size).to_a.shuffle

while

 guesses << current_guess = possible_guesses.pop
 print "Guess #{guesses.size} is #{current_guess.join}. Answer (bulls,cows)? "
 scores << score = gets.split(',').map(&:to_i)
 # handle win
 break (puts "Yeah!") if score == [size,0]

 # filter possible guesses
 possible_guesses.select! do |pos_guess| 
   bulls = pos_guess.zip(current_guess).count{|digit_pair| digit_pair[0] == digit_pair[1]}   
   cows = pos_guess.count{|digit| current_guess.include?( digit )} - bulls
   [bulls, cows] == score  
 end
 # handle 'no possible guesses left'
 if possible_guesses.empty? then
   puts "Error in scoring?"
   guesses.zip(scores).each{|g, s| puts "#{g.join} => bulls #{s.first} cows #{s.last}"}
   break
 end

end</lang> Regular output

Playing Bulls & Cows with 4 unique digits.
Guess 1 is 7158. Answer (bulls,cows)? 0,1
Guess 2 is 6843. Answer (bulls,cows)? 0,2
Guess 3 is 1439. Answer (bulls,cows)? 2,1
Guess 4 is 3479. Answer (bulls,cows)? 0,2
Guess 5 is 1234. Answer (bulls,cows)? 4,0
Yeah!

Wrong scoring

Playing Bulls & Cows with 4 unique digits.
Guess 1 is 2857. Answer (bulls,cows)? 0,0
Guess 2 is 6419. Answer (bulls,cows)? 1,0
Error in scoring?
2857 => bulls 0 cows 0
6419 => bulls 1 cows 0

Tcl

Translation of: Python
Library: Tcllib (Package: struct::list)
Library: Tcllib (Package: struct::set)

<lang tcl>package require struct::list package require struct::set

proc scorecalc {guess chosen} {

   set bulls 0
   set cows 0
   foreach g $guess c $chosen {

if {$g eq $c} { incr bulls } elseif {$g in $chosen} { incr cows }

   }
   return [list $bulls $cows]

}

  1. Allow override on command line

set size [expr {$argc ? int($argv) : 4}]

set choices {} struct::list foreachperm p [split 123456789 ""] {

   struct::set include choices [lrange $p 1 $size]

} set answers {} set scores {}

puts "Playing Bulls & Cows with $size unique digits\n" fconfigure stdout -buffering none while 1 {

   set ans [lindex $choices [expr {int(rand()*[llength $choices])}]]
   lappend answers $ans
   puts -nonewline \

"Guess [llength $answers] is [join $ans {}]. Answer (Bulls, cows)? "

   set score [scan [gets stdin] %d,%d]
   lappend scores $score
   if {$score eq {$size 0}} {

puts "Ye-haw!" break

   }
   foreach c $choices[set choices {}] {

if {[scorecalc $c $ans] eq $score} { lappend choices $c }

   }
   if {![llength $choices]} {

puts "Bad scoring? nothing fits those scores you gave:" foreach a $answers s $scores { puts " [join $a {}] -> ([lindex $s 0], [lindex $s 1])" } break

   }

}</lang> Sample Output

Playing Bulls & Cows with 4 unique digits

Guess 1 is 8527. Answer (Bulls, cows)? 0,1
Guess 2 is 5143. Answer (Bulls, cows)? 0,2
Guess 3 is 9456. Answer (Bulls, cows)? 2,0
Guess 4 is 9412. Answer (Bulls, cows)? 2,1
Guess 5 is 9481. Answer (Bulls, cows)? 3,0
Guess 6 is 9471. Answer (Bulls, cows)? 4,0
Ye-haw!

Sample Bad Output

Playing Bulls & Cows with 4 unique digits

Guess 1 is 6578. Answer (Bulls, cows)? 0,0
Guess 2 is 3241. Answer (Bulls, cows)? 1,0
Bad scoring? nothing fits those scores you gave:
  6578 -> (0, 0)
  3241 -> (1, 0)