In Mastermind, the CodeMaker determines a sequence of four pegs that the CodeBreaker must deduce. The codebreaker gets ten guesses, but each guess is followed by a clue from the codemaker, letting the former know how many pegs are the right color, and how many of the right color are in the right position.
The maker gives this information in the form of up to four pegs. A red peg means that the breaker got one color in the right position, but provides no further information. A white peg only means that one color is in the wrong position. No pegs means that no colors match the code.
data Peg = Red | Green | Blue | White | Yellow | Orange
deriving (Eq, Ord, Show)
data Code = Code [Peg] deriving Show
There are 1296 (6*6*6*6) possible codes, where order does matter.
code_space = [Code [a,b,c,d] | a <- ps, b <- ps, c <- ps, d <- ps]
where ps = [Red, Green, Blue, White, Yellow, Orange]
In response to a guess, the codemaker places some number of red and white pegs into the board. The red pegs correspond to the number of colors that match position between the breaker’s guess and the maker’s code. The white pegs correspond to colors that are in both codes, but in different positions.
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
Note: computing the number of white pegs to return requires an interesting intersect function. It should preserve duplicates, but only so far as they exist in both lists. The intersect function in the Data.List module is broken for this purpose. intersect [2,2,3] [1,5,2] returns [2,2], but the lists only share a single 2. I had to roll my own, which wasn’t too difficult.
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)
Edit: On Reddit, I was asked the following:
It isn’t entirely your fault as the standard library seems to have a similar problem but shouldn’t intersect be a set operation?
Isn’t the reason that it is an “interesting” intersect function the fact that it isn’t an intersect operation in the traditional mathematical sense of the word at all?
Yes, intersect should be a set operation (that is, removing duplicates), in the normal sense of the word.
Since the Data.List version of intersect isn’t a “set intersection,” and the documentation notes that “if the first list contains duplicates, so will the result,” I assumed it would work in a non-surprising way; the way I ended up implementing it (see below). The intersection of two sets returns only elements existing in both sets. The intersection of two lists, therefore, should return elements existing in both lists.
The way that the library actually implements it is very surprising — intersect as implemented in Data.List isn’t commutative:
intersect [2,2,4] [1,2,3] => [2,2]
intersect [1,2,3] [2,2,4] => [2]
That is why it’s “interesting” to me: the principle of least surprise has no place in that implementation.
There are 13 possible responses to a guess, where order doesn’t matter:
data Response = Respond (Int, Int) deriving Eq
- No pegs.
- One white.
- One red.
- Two whites.
- One white, one red.
- Two reds.
- Three whites.
- Two whites, one red.
- One white, two reds.
- Three reds.
- Four whites.
- Three whites, one red.
- Two whites, two reds.
- One white, three reds is impossible.
- Four reds is a correct guess.
This means that each guess is either correct, or leads to one of 13 different sets of remaining guesses, depending on the response of the maker. The optimal solution is to always guess the code that will lead to the smallest remaining set. That is, if I can guess code A or code B, and A will lead to at most 50 codes, B to at most 75, I should guess code A.
The simplest way to choose a guess, then, is to brute-force determine this information from what I know about the remaining codes in the solution space. This way of brute-forcing is also used to solve most other games, like chess or checkers. The idea is to create a game tree, with all possible moves for the current player followed by all possible moves from that state for the opposing player, and so forth. Choose the move that is guaranteed to put the current player in a good final state, and do it.
In Mastermind, these moves are guesses and responses. A guess is a choice of one code. When no clues are given, this code is chosen from the entire solution space.
space `when` [] = space
Of course, each response given by the codemaker cuts this space down — the only remaining codes must give the same response as the maker gave.
space `when` ((code, response):rest) =
[c | c <- space, diff c code == response] `when` rest
Since each code partitions the solution space into 13 or so different groups…
space `pivot_on` code =
[space `when` [(code, response)] | response <- all_responses]
where all_responses = [Respond (r, w) | r <- [0..4], w <- [0..4]]
…, we want to choose the code with the smallest maximum partition. That is, choose a guess that is guaranteed to reduce the solution space after the maker responds. This is the complicated part. (In comprehension, fortunately not in code.)
choose_from space =
fst $ minimumBy (comparing snd)
[(code, maximum $ map (length) (space `pivot_on` code)) | code <- space]
Now, just talk to the user and solve for the 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'
Yes, all of this code is legal Haskell. Copied and pasted to a file, it will run just fine, and usually solve codes in two or three guesses (most I’ve gotten to is five).