Bulls and cows/Player

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.

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!

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>

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>#digits$ = "123456789"

1. digitCount = 9
2. 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 permutations(List remainingGuesses.s(), Array digits(1), Array workingGuess(1), picksRemaining)

 Protected i
 If picksRemaining = 0
   AddElement(remainingGuesses())
   For i = 0 To #answerSize - 1
     remainingGuesses() + Mid(#digits$, workingGuess(i) + 1, 1)
   Next
   ProcedureReturn
 Else
   For i = 0 To ArraySize(digits())
     If digits(i) = 1
       digits(i) = 0
       workingGuess(#answerSize - picksRemaining) = i
       permutations(remainingGuesses(), digits(), workingGuess(), picksRemaining - 1)
       digits(i) = 1
     EndIf 
   Next 
 EndIf 

EndProcedure

Procedure initGuesses(List remainingGuesses.s())

 Protected i
 Dim workingGuess(#answerSize - 1)
 Dim digits(#digitCount - 1)
 For i = 0 To ArraySize(digits())
   digits(i) = 1
 Next
 permutations(remainingGuesses(), digits(), workingGuess(), #answerSize)

EndProcedure

If OpenConsole()

 Define guess.s, guessNum, score.s, delimeter.s
 NewList remainingGuesses.s()
 NewList answer.history()
 initGuesses(remainingGuesses())
 
 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)

Tcl

Translation of: Python

Library: tcllib

<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)