Bulls and cows/Player

From Rosetta Code
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.

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)
Retrieved from "https://rosettacode.org/wiki/Bulls_and_cows/Player?oldid=149570"