Thursday, November 11, 2010

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 \oplus symbol for xor then xorAll is similar to s = ((\ldots((P_1 \oplus P_2) \oplus P_3)\ldots)\oplus P_n). 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: A = \{(i,n) | i \in [1, l], n \in [1, P_i]\} where l is the number of piles and P_i is the amount in pile i. 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)

3 comments:

stylian said...

hello, thanks for that wonderful code. I thing its the first AI on the game of nim on the web. One thing i would like to ask.. After trying to implement your function brutePlay there is a parse error on the input '=' after winningPLays. I am fairly a begginner in haskell. `
Is there something wrong with the code? i cant figure it out..

Thanks

Unknown said...

Hi stylian,

My guess is that some of the spacing changed when pasting the code. You can get the original file from here: http://www.cs.rochester.edu/u/ryates/files/GameNormal.lhs

Ryan

stylian said...

thanks a lot!! my nim game works perfectly :)