Twitter ⟐ LinkedIn

Christophe Delord

**Monday 18. july 2016**: Updates on my new simulation framework project in Haskell.

**Friday 25. march 2016**: Dear backers, unfortunately, the FUN project was not successfully funded. I will now focus on FRP (Functional Reactive Programming) applied to real-time critical system specification and simulation.

CDSoft :: CV/Resume :: Free softwares Essays Haskell Handy Calc pp TPG BonaLuna Calculadoira todo pwd w Live :: AI tools in Prolog AI dialog

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]
pegs = ['a'..'f']
nbPegs :: Int
nbPegs = 4
```

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

.

```
type Guess = [Char]
allGuesses :: Int -> [Guess]
allGuesses n = init : filter (/=init) (all 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
calcScore secret guess = (right, wrong)
where
right = sum [1 | (x,y) <- zip secret guess, x == y]
notFound = secret \\ guess
wrong = length secret - length notFound - right
```

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
right = ord r - ord '0'
wrong = ord w - ord '0'
parseScore _ = Nothing
```

`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]
randomPegs = fmap ( (pegs!!).(`mod`length pegs) ) randomIO : randomPegs
randomSecret :: IO Guess
randomSecret = sequence $ take nbPegs randomPegs
```

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 ()
human = do
putStrLn ""
secret <- randomSecret
humanTurn 1 secret
humanTurn :: Int -> Guess -> IO ()
humanTurn n secret = do
guess <- readLine $ "Human turn " ++ show n ++ ": "
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 ()
computer = do
putStrLn ""
computerTurn 1 $ allGuesses nbPegs
computerTurn :: Int -> [Guess] -> IO ()
computerTurn n (guess:guesses) = do
--putStrLn $ "Possible guesses: " ++ show (1 + length guesses)
s <- readLine $ "Computer turn " ++ show n ++ ": " ++ show guess ++ " => "
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 ()
both = do
putStrLn ""
secret <- randomSecret
bothTurn secret 1 $ allGuesses nbPegs
bothTurn :: Guess -> Int -> [Guess] -> IO ()
bothTurn secret n (guess:guesses) = do
--putStrLn $ "Possible guesses: " ++ show (1 + length guesses)
putStr $ "Computer turn " ++ show n ++ ": " ++ show guess ++ " => "
hFlush stdout
let (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 ()
main = do
putStrLn ""
menu ["Mastermind in Haskell"]
[ ('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
```