Contact/support | Changelog

bulls and cows

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
import Data.List

pool :: [[Int]]
pool = [[a,b,c,d] | a <- [0..9], b <- [0..9], c <- [0..9], d <- [0..9], b /= a && c `notElem` [a,b] && d `notElem` [a,b,c]]

bc guess secret = (bulls, cows)
  where res = zipWith (\n x -> case elemIndex x secret of 
                           Just y -> if y == n then 1 else 2
                           _      -> 0) [0..3] guess
        bulls = length $ filter (== 1) res      
        cows = length $ filter (== 2) res      

prune guess (0,0) vars = filter (null . intersect guess) vars
prune guess@[a,b,c,d] (0,cow) vars = filter (\g@[a',b',c',d'] -> a /= a' && b' /= b && c' /= c && d' /= d && length (guess `intersect` g) == cow) vars
prune guess (b,c) vars = filter (\x -> let (b',c') = bc x guess in x /= guess && b' == b && c' == c) vars


solve secret = if length (nub $ take 4 secret) < 4 then [] 
               else solve' pool []
    where solve' [] log = log
          solve' pool' log =
                 let l = length pool'
                     guess = head pool'
                     res = bc guess secret
                     log' = (guess, res, l) : log in
                 if fst res == 4 then log'
                 else solve' (prune guess res pool') log'
                                
run = mapM_ print . zip [1..] . reverse . solve

main = mapM_ (\x -> run x >> getLine) pool