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 |