Martin Sulzmann
We consider a simple Haskell implementation of Mastermind.
There is no fancy GUI interface. We use the console to print the board and ask the user to key in some guess.
-- Each color is represented by a string (e.g. "blue",...)
type Color = String
type Colors = [Color]
-- Row represents a row on the board
type Row = [Color]
-- Answer is a pair where the left component represents the number of black pegs and
-- the right component represents the number of white pegs
--
-- We find a black peg for each correct guess (correct color and position)
-- We find a white peg for each peg that belongs in the solution but is incorrectly positioned.
type Answer = (Int, Int)
-- A board is represented as a list of rows and answers
type Board = [(Row, Answer)]
printBoard :: Board -> IO ()
printBoard board = let print [] = putStr ("\n")
print (x:xs) = do putStr (show x)
putStr ("\n")
print xs
in do putStr ("\n BOARD\n")
print boardOur Mastermind implementation can be customized to different board sizes and various colors. Here’s the main function.
mmind ::
Int -- Length of each row
-> Colors -- Set of colors
-> (Int -> Colors -> Colors -> Bool) -- Checks if guess is valid
-> (Colors -> Colors -> Answer) -- Compares guess against hidden row
-> IO [(Colors, Answer)]
mmind size colors validGuess answerIs =
let input_row 0 = return []
input_row size = do putStr ("\n Input peg ")
putStr (show size); putStr (": ")
peg <- getLine
peg_list <- input_row (size - 1)
return ([peg] ++ peg_list)
make_a_guess = do putStr ("\n Input a row \n")
row <- input_row size
if validGuess size colors row then return row
else do putStr ("\n Input row is not valid, do it again \n")
make_a_guess
answerIsIO guess hiddenrow = return (answerIs guess hiddenrow)
validGuessIO row = return (validGuess row)
buildboardIO board guess answerIs = return (board ++ [(guess,answerIs)])
initialboard = []
playitIO hiddenrow board = do
newguess <- make_a_guess
if validGuess size colors newguess then return ()
else putStr ("\n Your player doesn't produce correct guesses\n")
newanswerIs <- answerIsIO newguess hiddenrow
newboard <- buildboardIO board newguess newanswerIs
printBoard newboard
if newanswerIs == (size,0) then (return newboard)
else (playitIO hiddenrow newboard)
in do hiddenrow <- randomRowIO size colors
playitIO hiddenrow initialboardImplement the following functions.
-- validGuess takes the size, the list of colors and the guess stored in a row
validGuess :: Int -> Colors -> Row -> Bool
-- answerIs guess answer = (no blacks, no whites)
answerIs :: Row -> Row -> AnswerFor example
validGuess 3 ["blue", "red", "yellow", "green"] ["blue", "red"] ===> Falsebecause our guess ["blue", "red"] lacks one color.
validGuess 3 ["blue", "red", "yellow", "green"] ["blue", "red", "yelow"] ===> Falsebecause our guess ["blue", "red", "yelow"] has a typo
(should be “yellow”).
validGuess 3 ["blue", "red", "yellow", "green"] ["blue", "red", "red"] ===> TrueFinally, our guess is valid.
answerIs ["red", "blue", "blue", "green"] ["red", "blue", "green", "yellow"] ===> (2,1)We assume that our guess is
["red", "blue", "blue", "green"] and needs to be checked
against the hidden row
["red", "blue", "green", "yellow"].
As answers, we find 2 black pegs (red and blue are matches) and 1 white peg (we correctly guess the color green but in some wrong position).
import System.Random
-- Each color is represented by a string (e.g. "blue",...)
type Color = String
type Colors = [Color]
-- Row represents a row on the board
type Row = [Color]
-- Answer is a pair where the left component represents the number of black pegs and
-- the right component represents the number of white pegs
--
-- We find a black peg for each correct guess (correct color and position)
-- We find a white peg for each peg that belongs in the solution but is incorrectly positioned.
type Answer = (Int, Int)
-- A board is represented as a list of rows and answers
type Board = [(Row, Answer)]
printBoard :: Board -> IO ()
printBoard board = let print [] = putStr ("\n")
print (x:xs) = do putStr (show x)
putStr ("\n")
print xs
in do putStr ("\n BOARD\n")
print board
-- mastermind
mmind ::
Int -- Length of each row
-> Colors -- Set of colors
-> (Int -> Colors -> Colors -> Bool) -- Checks if guess is valid
-> (Colors -> Colors -> Answer) -- Compares guess against hidden row
-> IO [(Colors, Answer)]
mmind size colors validGuess answerIs =
let input_row 0 = return []
input_row size = do putStr ("\n Input peg ")
putStr (show size); putStr (": ")
peg <- getLine
peg_list <- input_row (size - 1)
return ([peg] ++ peg_list)
make_a_guess = do putStr ("\n Input a row \n")
row <- input_row size
if validGuess size colors row then return row
else do putStr ("\n Input row is not valid, do it again \n")
make_a_guess
answerIsIO guess hiddenrow = return (answerIs guess hiddenrow)
validGuessIO row = return (validGuess row)
buildboardIO board guess answerIs = return (board ++ [(guess,answerIs)])
initialboard = []
playitIO hiddenrow board = do
newguess <- make_a_guess
if validGuess size colors newguess then return ()
else putStr ("\n Your player doesn't produce correct guesses\n")
newanswerIs <- answerIsIO newguess hiddenrow
newboard <- buildboardIO board newguess newanswerIs
printBoard newboard
if newanswerIs == (size,0) then (return newboard)
else (playitIO hiddenrow newboard)
in do hiddenrow <- randomRowIO size colors
playitIO hiddenrow initialboard
randomRowIO :: Int -> Colors -> IO Colors
randomRowIO size colors = do
xs <- mapM (\_ -> randomRIO (0::Int, size-1)) [1..size]
return [colors!!x | x <- xs]
-- check a guess is legitimate
-- validGuess takes the size, the list of colors and the guess stored in a row
validGuess :: Int -> Colors -> Row -> Bool
validGuess = error "your task"
-- answerIs guess answer = (no blacks, no whites)
answerIs :: Row -> Row -> Answer
answerIs = error "your task"
-- Play mastermind
colors :: Colors
colors = ["blue", "red", "yellow", "green"]
play_mm = mmind 4 colors validGuess answerIs
main = play_mm