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
<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
do i = 1, size(candidates)
if (candidates(i) == 0) cycle
b = 0
c = 0
write(n1, "(i4)") guess
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"
- digitCount = 9
- 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
<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]
}
- 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)