👨💻 about me home CV/Resume 🖊️ Contact Github LinkedIn I’m a Haskeller 🏆 Best of Haskell abp hCalc bl todo pwd TPG

🆕 **Sunday 24. May 2020**: Working at EasyMile for more than 3 years. Critical real-time software in C, simulation and monitoring in Haskell ➡️ perfect combo! It’s efficient and funny ;-)

🚌 And**we are recruiting!** Contact if you are interested in **Haskell** or **embedded softwares** (or both).

🚌 And

27 September 2017

This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses/.

A long long time ago I wrote a Minstermind game in Pascal. And I recently watched a video of Peter Marks about lazy evaluation in Haskell. Mastermind is used as an example of lazy evaluation.

So here is my own version…

The user interface is a small and ugly text interface. It’s source code is here: TUI.hs.

```
module Main where
import Data.List
import Data.Char
import Control.Monad
import System.Random
import System.IO
import TUI
```

The original game has pegs of six different colors. Pegs are here represented by letters from `a`

to `f`

. The secret code to guess is made of 4 pegs.

```
pegs :: [Char]
= ['a'..'f']
pegs
nbPegs :: Int
= 4 nbPegs
```

First we need a function to generate all the possible combinations. The first combination is, arbitrarily, `"abcd"`

.

```
type Guess = [Char]
allGuesses :: Int -> [Guess]
= init : filter (/=init) (all n)
allGuesses n where
init = take n $ cycle pegs
all 0 = [[]]
all n = [p:ps | p <- pegs, ps <- all (n-1)]
```

Then a function to evaluate a guess. A score is a tuple of integers indication the number of pegs in the right position and the number of pegs in wrong positions:

`right`

is computed by*zipping*the secret code and the guess and counting pegs that are equal.`wrong`

is then the number of pegs in`secret`

but not in the right places. The trick is that`secret \\ guess`

removes one and only one item in`secret`

for each item in`guess`

.

```
type Score = (Int, Int)
calcScore :: Guess -> Guess -> Score
= (right, wrong)
calcScore secret guess where
= sum [1 | (x,y) <- zip secret guess, x == y]
right = secret \\ guess
notFound = length secret - length notFound - right wrong
```

To let the computer play, it must be able to filter the current list of guesses to keep only the guesses that give the same score than the ones previously played. `guess`

is the last guess made by the computer and `(right, wrong)`

its score given by the opponent.

```
makeGuess :: Guess -> Score -> [Guess] -> [Guess]
=
makeGuess guess (right, wrong) filter (\g -> calcScore g guess == (right, wrong))
```

The human player has to give scores to the computer. Here is a function to parse a score. A score is a string of two digits. Both digits and their sum must be in `[0, nbPegs]`

. If the input string is not valid, the function returns `Nothing`

so that the user can retry entering a valid score.

```
parseScore :: String -> Maybe Score
parseScore [r, w]| valid right && valid wrong && valid (right+wrong)
= Just (right, wrong)
where valid n = 0 <= n && n <= nbPegs
= ord r - ord '0'
right = ord w - ord '0'
wrong = Nothing parseScore _
```

`randomPegs`

is an infinite list of randomly choosen pegs. It’s used by `randomSecret`

to make a list of `nbPegs`

rangom pegs.

```
randomPegs :: [IO Char]
= fmap ( (pegs!!).(`mod`length pegs) ) randomIO : randomPegs
randomPegs
randomSecret :: IO Guess
= sequence $ take nbPegs randomPegs randomSecret
```

The human player has to guess the secret code choosen by the computer.

He enters its guesses as strings of `nbPegs`

. The computer computes and show the score of the human guess until he finds the secret code.

```
human :: IO ()
= do
human putStrLn ""
<- randomSecret
secret 1 secret
humanTurn
humanTurn :: Int -> Guess -> IO ()
= do
humanTurn n secret <- readLine $ "Human turn " ++ show n ++ ": "
guess if length guess /= nbPegs
then humanTurn n secret
else do
let (right, wrong) = calcScore secret guess
putStrLn $ "score: " ++ show right ++ "-" ++ show wrong
if right == nbPegs
then putStrLn "Congratulation!"
else humanTurn (n+1) secret
```

The computer player tries to guess the secret code choosen by the human player.

For each guess made by the computer, the human player has to enter a score. The computer filters its guesses until it finds the secret code.

```
computer :: IO ()
= do
computer putStrLn ""
1 $ allGuesses nbPegs
computerTurn
computerTurn :: Int -> [Guess] -> IO ()
:guesses) = do
computerTurn n (guess--putStrLn $ "Possible guesses: " ++ show (1 + length guesses)
<- readLine $ "Computer turn " ++ show n ++ ": " ++ show guess ++ " => "
s let score = parseScore s
case score of
Nothing -> computerTurn n (guess:guesses)
Just (right, wrong) ->
if right < nbPegs
then computerTurn (n+1) $ makeGuess guess (right, wrong) guesses
else putStrLn "I'm the best!"
=
computerTurn n [] putStrLn "You, cheater! You've made a mistake, haven't you?"
```

The computer plays against itself. This mode is for lazy humans :-)

```
both :: IO ()
= do
both putStrLn ""
<- randomSecret
secret 1 $ allGuesses nbPegs
bothTurn secret
bothTurn :: Guess -> Int -> [Guess] -> IO ()
:guesses) = do
bothTurn secret n (guess--putStrLn $ "Possible guesses: " ++ show (1 + length guesses)
putStr $ "Computer turn " ++ show n ++ ": " ++ show guess ++ " => "
hFlush stdoutlet (right, wrong) = calcScore secret guess
putStrLn $ show right ++ show wrong
if right < nbPegs
then bothTurn secret (n+1) $ makeGuess guess (right, wrong) guesses
else putStrLn "I'm the best!"
```

```
main :: IO ()
= do
main putStrLn ""
"Mastermind in Haskell"]
menu ['H', "Human player", human >> main),
[ ('C', "Computer player", computer >> main),
('B', "Both players are computers", both >> main),
('Q', "Quit", return ())
(
]putStrLn ""
```

Let’s see how the computer plays…

```
$ runhashell mastermind.lhs
/================================\
| Mastermind in Haskell |
|~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
| [H] Human player |
| [C] Computer player |
| [B] Both players are computers |
| [Q] Quit |
|~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
|> | ==> Both players are computers |
\================================/
Computer turn 1: "abcd" => 02
Computer turn 2: "baaa" => 10
Computer turn 3: "bcbb" => 10
Computer turn 4: "bdde" => 01
Computer turn 5: "ccea" => 21
Computer turn 6: "ecfa" => 40
I'm the best!
/================================\
| Mastermind in Haskell |
|~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
| [H] Human player |
| [C] Computer player |
| [B] Both players are computers |
| [Q] Quit |
|~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
|> | ==> Quit |
\================================/
```