## mark a section (Learn more)

-- Master: Mastermind Solver -- Adam Blinkinsop <blinks@google.com> import Data.Ord import Data.List -- Types for pegs and codes, mainly for display. data Peg = Red | Green | Blue | White | Yellow | Orange deriving (Eq, Ord, Show) data Code = Code [Peg] deriving Show data Response = Respond (Int, Int) deriving Eq -- Whites uses an intersection that must not remove duplicates. The one that -- comes with Haskell's Data.List library is documented to work the way I -- wanted, but it breaks with the following input: -- [2,2,3] `intersect` [1,5,2] => [2,2] for Data.List's intersect. -- This is clearly incorrect by my semantics, because the lists only share -- a single two. The following implements my semantics. intersect x y = intersect' (sort x) (sort y) intersect' [] _ = [] intersect' _ [] = [] intersect' (x:xs) (y:ys) | (x == y) = x : (intersect' xs ys) | (x < y) = intersect' xs (y:ys) | (x > y) = intersect' ys (x:xs) -- The scoring function, to partition the solution space by pivoting on the -- responses to any one code. diff (Code x) (Code y) = Respond (reds, whites) -- Reds gives the number of slots that match between two codes. where reds = length [t | t <- zip x y, fst t == snd t] -- Whites gives the number of remaining colors in wrong slots. whites = (length $ Main.intersect x y) - reds -- The initial solution space. code_space = [Code [a,b,c,d] | a <- ps, b <- ps, c <- ps, d <- ps] where ps = [Red, Green, Blue, White, Yellow, Orange] -- Reduce the solution space to match the clues given. space `when` [] = space space `when` ((code, response):rest) = [c | c <- space, diff c code == response] `when` rest -- Partition the solution space by responses to an arbitrary code. space `pivot_on` code = [space `when` [(code, response)] | response <- all_responses] where all_responses = [Respond (r, w) | r <- [0..4], w <- [0..4]] -- Choose the best guess from a solution space. choose_from space = fst $ minimumBy (comparing snd) [(code, maximum $ map (length) (space `pivot_on` code)) | code <- space] -- Talk to the user, solving for an arbitrary code. solve_with clues = do putStrLn ("It looks like there are " ++ (show $ length code_space') ++ " possible codes left, " ++ "after " ++ (show $ length clues) ++ " clues. Hmm.") putStrLn ("I'll guess " ++ (show best_guess) ++ ".") putStrLn "How many colors are in the correct location?" reds <- getLine if (read reds) == 4 then putStrLn "Woohoo!" else do putStrLn "How many colors are in incorrect locations?" whites <- getLine solve_with ((best_guess, Respond (read reds, read whites)):clues) where code_space' = code_space `when` clues best_guess = choose_from code_space' -- Make it run when compiled. main = solve_with []

This paste will be private.