A few Math Club meetings ago we learned about the combinatorial game called Nim. I decided to play around with Nim in Haskell and came up with this bit of literate Haskell which you can paste into a text file with the extension ".lhs" and run with your favorite haskell compiler (GHC of course).

The game is a simple two player game. Start with some piles with various amounts of objects. Each player in turn takes at least one object from a single pile. The winning player is the one that takes the last object.

If you are coming from a math background you might want to keep this reference open.

For our Haskell code we start with some standard imports.

`> module GameNormal where`

>

> import System.IO

> import Data.Maybe

> import Data.Bits

> import Data.List

We declare a data type to abstract out the idea of a player:

`> data Player = Player { name :: String, play :: [Int] -> IO (Int,Int) }`

This means that a player has a name and a strategy for playing in the form of a function from a list of piles to a pair where the first entry is the index of the pile to take from and the second entry is the amount to take (we will ignore the `IO`

for now other than to say that it will allow us to make a play strategy that interacts with the user).

What would the simplest play strategy look like?

`> naivePlay :: [Int] -> (Int,Int)`

> naivePlay _ = (0,1)

This states that we ignore the input and always choose one object from the first pile (`0`

is our first index of course). Once we know what our play will be we need to produce a new pile. We will call this function `draw`

and it will have the type:

`> draw :: Int -> Int -> [Int] -> [Int]`

The first base case is when we have no piles to begin with. This condition should never happen so we define it to be an error.

`> draw _ _ [] = error "Invalid pile."`

The next base case is when we are drawing from the first pile. In this case we construct a new list of piles where the first element is the original first element `p`

minus the number to draw `n`

.

`> draw 0 n (p:ps) = (p - n) : ps`

Finally for other indexes we construct a new list with the existing first element and call `draw`

on the rest of the list with the index reduced by one.

`> draw i n (p:ps) = p : draw (i-1) n ps`

At this point we can test what we have so far in `ghci`

.

`*Main> naivePlay [4,3,2]`

(0,1)

*Main> draw 0 1 [4,3,2]

[3,3,2]

*Main> draw 2 2 [3,3,2]

[3,3,0]

We can see that `draw`

is producing a new list of pile as expected. If all the elements in a pile are taken we end up with a pile with zero elements. We can remove the empty piles by filtering them out:

`*Main> :t filter`

filter :: (a -> Bool) -> [a] -> [a]

*Main> filter (> 0) [3,3,0]

[3,3]

These two functions can of course be composed:

`*Main> :t (filter (> 0) . draw 2 2)`

(filter (> 0) . draw 2 2) :: [Int] -> [Int]

*Main> (filter (> 0) . draw 2 2) [3,3,2]

[3,3]

Now we turn to winning strategy. We learned in Math Club to look at the piles in their binary representation and if at the end of a player's turn they can end up with an even number of bits for each column in that representation then that player will win. For example `[4,3,2]`

can be written:

`100`

11

10

We can compute the evenness of the columns with the `xor`

(exclusive or) logic operation:

`100`

11

10

--- xor

101

Any columns with `1`

's after the computation mean that that column has an odd number of `1`

's. The problem now is how do we pick a single pile to change so that the `xor`

computation results in `0`

. One option is to just try every possibility until we find one that works. We can calculate the xor of a list of piles with a fold as in the following function:

`> xorAll :: [Int] -> Int`

> xorAll = foldl1 xor

We can think of a fold like we think of the mathematical sum but with the operation as an argument to the fold function. Folds are also specified to be either right (`foldr`

) or left (`foldl`

) associative. In Haskell the variants ending in a `1`

mean that they assume the list has at least one element and use that as the starting value for the running total. So if we use the symbol for `xor`

then `xorAll`

is similar to . Running we get:

`*Main> xorAll [4,3,2]`

5

We will also need to be able to generate all possible plays given a list of piles:

`> allPlays :: [Int] -> [(Int,Int)]`

> allPlays ps = [(i,n) | i <- [0..(length ps -1)], n <- [1..(ps !! i)]]

This code uses a list comprehension which looks very similar to what can be written in typical mathematical notation: where is the number of piles and is the amount in pile . Now we have all we need to write the strategy:

`brutePlay :: [Int] -> (Int,Int)`

brutePlay ps = (head . filter isWinningPlay . allPlays) ps

where isWinningPlay (i,n) = xorAll (draw i n ps) == 0

We could say that `brutePlay`

is defined to be the first (`head`

) winning (`filter isWinningPlay`

) play (`allPlays`

), but what if there isn't a winning play?

`*Main> brutePlay [2,2]`

*** Exception: Prelude.head: empty list

It isn't very sportsmanlike for a program to throw an exception just because it doesn't have a winning play, so we amend:

`> brutePlay :: [Int] -> (Int,Int)`

> brutePlay ps = fromMaybe (0,1) winningPlays

> where isWinningPlay (i,n) = xorAll (draw i n ps) == 0

> winningPlays = (listToMaybe . filter isWinningPlay . allPlays) ps

Lets try this out on the examples we had before:

`*Main> brutePlay [2,2]`

(0,1)

*Main> brutePlay [4,3,2]

(0,3)

Pulling it all together we can now run a game by alternating turns and drawing on the current pile until we hit the base case of having no piles left.

`> runGame :: Player -> Player -> [Int] -> IO ()`

> runGame a b [] = putStrLn ("The winner is: " ++ name b)

> runGame a b p = do

> putStrLn . concat $ [name a, "'s turn. Piles are: ", show p]

> (i,n) <- play a p

> runGame b a . filter (>0) . draw i n $ p

>

> main :: IO ()

> main = runGame a b ps

> where a = Player "Brute" (return . brutePlay)

> b = Player "Naive" (return . naivePlay)

> ps = [4,3,2]

Loading in `ghci`

we can run and see the outcome:

`*Main> :main`

Brute's turn. Piles are: [4,3,2]

Naive's turn. Piles are: [1,3,2]

Brute's turn. Piles are: [3,2]

Naive's turn. Piles are: [2,2]

Brute's turn. Piles are: [1,2]

Naive's turn. Piles are: [1,1]

Brute's turn. Piles are: [1]

The winner is: Brute

*Main>

We can do better though. If we look at `allPlays`

we will notice that it returns a list with a length equal to the sum of the entries. Instead let's consider what value the xor of the piles would be if we took away an arbitrary pile we will call `i`

. Lets assume there were `a`

objects in the pile we are removing. If the resulting xor of the remaining piles it is zero then we know what move we should make (take `a`

objects from `i`

). If it is some non-zero value `b`

then if we put back into pile `i`

`b`

objects then we know that the xor of the new piles would be zero (using the identity that any value `xor`

itself is zero). As long as `b`

is smaller than `a`

then we will be able to do this. This means that now we only consider one possible play for each pile.

`> smartPlay :: [Int] -> (Int,Int)`

> smartPlay ps = fromMaybe (0,1) winningPlays

> where s = xorAll ps

> bs = map (xor s) ps

> ds = zipWith (-) ps bs

> ts = zip [0..] ds

> winningPlays = (listToMaybe . filter ((> 0) . snd)) ts

Breaking this down:

`s`

is the xor of all the piles.`bs`

is the xor of all the piles but the pile at index`i`

of `bs.`ds`

is the element-wise difference between the original pile and`bs`

.`ts`

is the pairing of indexes with the differences.`winningPlays`

is`Nothing`

or the first element in`ts`

with a positive difference.

Finally the following code allows interactive play. Notice that we need the `IO`

type in `promptPlay`

because we are interacting with the environment.

`> promptPlay :: [Int] -> IO (Int,Int)`

> promptPlay p = do

> j <- promptInt "Enter pile to draw from" 1 (length p)

> let i = j - 1

> n <- promptDraw (p !! i)

> return (i,n)

>

> promptDraw :: Int -> IO Int

> promptDraw 1 = putStrLn "There is only one object. You take it." >> return 1

> promptDraw n = do

> putStrLn . concat $ ["That pile has ", show n, " objects."]

> promptInt "Enter number to draw" 1 n

>

> parseInt :: String -> Maybe Int

> parseInt = listToMaybe . map fst . reads

>

> inRange :: Int -> Int -> Int -> Maybe Int

> inRange a b n = if a <= n && n <= b then Just n else Nothing

>

> promptInt :: String -> Int -> Int -> IO Int

> promptInt p a b = do

> putStr . concat $ [p, " (", show a, ", ", show b, "): "]

> r <- getLine

> maybe (promptInt p a b) return (parseInt r >>= inRange a b)

(Created with pandoc: `pandoc -f markdown+lhs -t html+lhs .\input.lhs -o output.html --offline --webtex`

)