Computing Nim

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)

Haskell for Math People

I'd like to keep a little quick reference here of tips for reading Haskell code if you are coming from a math background:

• Function application is left associative and doesn't use parenthesis so f a b c is the same as (((f a) b) c) which is the same as the normal math notation .
• Writing function application this way makes it easy to do partial application. For instance if we have a math function we can think of it as function . That is a function from a space to a space of functions. This function would naturally take one parameter and the "value" that it represents would also take one parameter. To partially apply in Haskell we just provide the number of parameters we want to apply.
• We often talk about "types" in Haskell and this is somewhat analogous to making statements about the domain and range of a function. For example when we write f :: Int -> Int -> Int in Haskell we are saying that we have a function named where . More precicely types are isomorphic to proofs in constructive mathmatics (see Curry–Howard correspondence).
• The following program often uses a data structure called a list. We write the type of a list as [a] where a is some type. We construct lists in a few ways
  1. As a list of values: [1,2,3].
  2. Using the : (called "Cons") operator: 1:2:3:[]. The Cons operator is a function that takes a value and a list and produces a new list with that value at the head of the list. The empty list is written as [].
  3. As a list comprehension which we will talk about later.
• Function definitions in haskell are written with the function name followed by pattern matched arguments, an equals sign, then an expression in terms of the arguments given. We call everything to the left of the equals sign the "left-hand side" or lhs and everything to the right of the equals the "right-hand side" or rhs. Pattern matching is where instead of listing a name for an argument we specify some structure or pattern that the value must fit for the function to be applicable. Haskell will look for the first applicable function and use that expression. For example the function f (x:xs) = (1 + x) : f xs is applicable when given a list. The first element of the list will be bound to x on the rhs while the rest of the list (the tail) will be bound to xs on the rhs. Attempting to apply f to [] would result in a "Non-exhaustive patterns" exception because [] is the empty list and does not have a head and a tail. To fix this we would have to define that base case with f [] = []. We now have a function where given a list of numbers it would result in a new list of numbers where each number is incremented by one.
• Function composition is written with a period f . g which is meant to mimic the math notation .