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 .

Slang.

From John Badcock's:

Slang.
A Dictionary
of
the Turf, the Ring, the Chase, the Pit, of Bon-Ton,
and the
Varieties of Life,
Forming the Completest and Most Authentic
Lexicon Balatronicum
Hitherto Offered to the Notice of
the Sporting World,
For elucidating Words and Phrases that are necessarily, or purposely,
cramp, mutative, and unintelligible, outside their
respective Spheres.
Interspersed with
Anecdotes and Whimsies,
with Tart Quotations, and Rum-Ones;
with Examples, Proofs, and Monitory Precepts,
Useful and Proper for
Novices, Flats, and Yokels.

Computational Thinking

Alan Jacobs linked to this article recently (PDF):

http://www.cs.cmu.edu/afs/cs/usr/wing/www/publications/Wing06.pdf

I agree with much of what Wing says. I think the article is motivated by a general trend in Computer Science higher education that amounts to CS departments failing to "attract" good students. On the other hand it remains true that computational thinking applied to many other fields (essentially science in general) continues to be the foremost innovation for that field. Wing gets the distinction right that it isn't about programming. The example I always use is that cellular biology must be concerned with how cells communicate and act on each other. This problem has it's theoretical underpinnings in computer science. Not on using computers to run simulations on how cells might communicate (while that can be an interesting thing to study), but on answering questions like "What ways can discrete objects communicate?"

So why, given the importance of computational thinking to so much of science, is Computer Science failing to attract good students who want "go on to a career in medicine, law, business, politics, any type of science or engineering, and even the arts."? In my experience the public perception of CS is that it is all about programming or all about computer hardware. Computer Scientists most important body part is their fingers because that works the keyboard right? The cultural stereotype that gets assigned to Computer Scientists is the geek or nerd. As a consequence people who identify with that stereotype (for whatever reason) see themselves as cast in the role of Computer Scientist regardless of their ability or desire to reason well computationally. The ETS's major field test reports (pdf) that only 28% of CS seniors have an overall GPA above 3.5. Only 36% have that high a GPA in their major. Mathematics comes in at 47% and 43%.

Somehow Mathematics is able to attract thinking students while still getting a similar stereotyping from broader culture and I can't help but think that has to do with the seat it has a the education table as a first class member (never mind that the system at large fails to emphasize the important parts of mathematics). I like Wing's vision of a world where Computational Thinking has a place at that table (though I shudder to think of the tortures the education system could inflict in CS's name).

The man of action

To the Greeks the Private Realm was the sphere of life ruled by the necessity of sustaining life, and the Public Realm the sphere of freedom where a man could disclose himself to others. Today, the significance of the terms private and public has been reversed; public life is the necessary impersonal life, the place where a man fulfills his social function, and it is in his private life that he is free to be his personal self.

In consequence the arts, literature in particular, have lost their traditional principal human subject, the man of action, the doer of public deeds.

—W. H. Auden

More LINQ translation.

We will get to the second part of the last post later, but right now I wanted to post another quick "convert to Haskell from LINQ" entry this time from a post by Eric Lippert.

> import Control.Monad

Notice how similar this definition is to the C# version:

> data Tree = Node Tree Tree | Empty

In both version Node is the name of the constructor taking two arguments. Both cases make an immutable "object".

> instance Show Tree where
>   show Empty = "x"
>   show (Node l r) = "(" ++ show l ++ show r ++ ")"

The C# version's BinaryTreeString has a helper function doing the recursion, but it isn't really necessary (in the C# or Haskell). What the C# gains is the ability to side-effect on a StringBuilder directly rather than returning partial results.

> allTrees :: Int -> [Tree]
> allTrees 0 = [Empty]
> allTrees n = [Node l r | i <- [0..n-1]
>                        , l <- allTrees i
>                        , r <- allTrees (n - 1 - i)
>                        ]

This translates very directly from the LINQ code, each from statement becomes a statement with a <-. That's it! Testing we have:

> trees = mapM_ (putStrLn . show) (allTrees 4)

giving the output:

*Main> trees
(x(x(x(xx))))
(x(x((xx)x)))
(x((xx)(xx)))
(x((x(xx))x))
(x(((xx)x)x))
((xx)(x(xx)))
((xx)((xx)x))
((x(xx))(xx))
(((xx)x)(xx))
((x(x(xx)))x)
((x((xx)x))x)
(((xx)(xx))x)
(((x(xx))x)x)
((((xx)x)x)x)

In the comments we have several answers to the challenge the last of which translates to this:

> data ATree = ANode [ATree]

> instance Show ATree where
>   show (ANode [])   = "{}"
>   show (ANode xs) = "{" ++ (foldl1 (++) (map show xs)) ++ "}"

> allATrees :: Int -> [ATree]
> allATrees n = [ANode x | x <- h (n - 1)]
>   where h 0 = [[]]
>         h n = [(ANode l) : r | i <- [1..n]
>                              , l <- h (i - 1)
>                              , r <- h (n - i)
>                              ]

> aTrees = mapM_ (putStrLn . show) (allATrees 4)

Evaluating aTrees gives:

*Main> aTrees
{{}{}{}}
{{}{{}}}
{{{}}{}}
{{{}{}}}
{{{{}}}}

Note that this output is all strings of nested braces that are in a single outer pair of braces and are eight characters long. If we called allATrees's helper function h directly we would be removing the "single outer pair of braces" constraint. So h of n is of the same order as allTrees.

Solving Combinatory Problems with Haskell

Today my Visual Studio start page had a link to an interesting blog post by Octavio Hernandez and I couldn't pass up the opportunity to solve the problem with Haskell. Please note that this is not in anyway a commentary on language X is better than Language Y, rather looking at the same problem in many different languages is very helpful in understanding the problem itself better. I'll try and make this a literate Haskell post so you should be able to copy and paste the text into a text file with the ".lhs" extension and have everything run. So we begin by importing an operator that we will use later:

> import Data.List ((\\))

We will need a list of the digits.

> num = [1..9]


The first generation is all of the one digit numbers that satisfy n mod 1 == 0. That's an easy one, all of them satisfy that condition!

> m1 = num

We can see this in the C# version as from i1 in oneToNine without any where clause. The next step is to look at two digit numbers without repeating digits where n mod 2 == 0. So we write this:

> m2 = [n | a <- num
>         , b <- num \\ [a]
>         , n <- [a*10 + b]
>         , n `mod` 2 == 0
>         ]

This is a Haskell list comprehension and it can be read as "list ([) of n's (n) such that (|)...". Where the "..." is a series of conditions. The conditions are either pulling a value from a list (the ones with the left arrow <-), or are predicate statements. It will only use values that cause all the predicate statements to be true. We specifically have a being a digit. The second value b is using the list difference operator // which takes a list on the left and a list of values to remove on the right.

We will pause for a second and notice how similar this is to the mathematical statement:



If we run the code so far in ghci we can see that evaluating m2 gives us:

*Main> m2
[12,14,16,18,24,26,28,32,34,36,38,42,46,48,52,54,56,58,62,64,68,72,74,76,78,82,8
4,86,92,94,96,98]

Notice no digits repeat and all the numbers are even. Evaluating length m2 we see:

*Main> length m2
32

Since there are 9 digits (greater than 0) half of which are even (round down because 1 is odd) there should be four repeating digit even two digit number (22,44,66,88). Since we are not considering zero, there are nine possibilities for the first digit and four for the second (same as our repeats). This gives four times nine (36) minus our repeats (4) which equals 32. We now should be convinced that m2 is correct.

At this point we might be tempted to do the same thing for m3 but replacing our a to draw from m2. Instead we will capture the idea of that step in a more generic way. First we need a helper:

> toDigits a   = reverse $ h a
>    where h 0 = []
>          h a = a `mod` 10 : (h $ a `div` 10)

Back to ghci:

*Main> :t toDigits
toDigits :: (Integral a) => a -> [a]

This Haskell type shows that toDigits takes an Integral and gives a list of Integrals. It could be helpful to construct a sort of inverse to toDigits called fromDigits which could be defined as:

> fromDigits = foldl1 (\a b -> 10*a + b)

The details are not important, but it is helpful to notice that these two functions are nearly inverses of each other:

*Main> :t fromDigits . toDigits
fromDigits . toDigits :: Integer -> Integer
*Main> :t toDigits . fromDigits
toDigits . fromDigits :: [Integer] -> [Integer]

Here the . operator is composing the two functions.

*Main> fromDigits [1,2,3]
123
*Main> toDigits 123
[1,2,3]
*Main> (fromDigits . toDigits) 123
123

When we use fromDigits on a list with numbers larger than nine toDigits fails to be an inverse:

*Main> fromDigits [12,3]
123
*Main> toDigits 123
[1,2,3]
*Main> fromDigits [1,23]
33

This "failure" would still be useful in the case where only the first item in the list is greater than nine. In general it is nearly always instructive to try and construct an inverse function as it tells you quite a lot about your original function. You might observe similarities between fromDigits and n in m2. It turns out that there is another way to generalize n which we will come back to later.

Looking back at our definition of m2 we want to make that work for any step so we look for the parts that need to change. We know that we want to have a pull from the numbers from the previous step. And we know that we will be "modding" by a higher number each time. This implies two inputs to our step function which we will call ns and m respectively. We also have a problems that our helper function will fix for us. First the numbers from the previous step need to be split into digits for them to be subtracted from the pool of digits for b. So that becomes b <- num \\ (toDigits a). Now we can write our function down:

> step ns m = [n | a <- ns
>                , b <- num \\ (toDigits a)
>                , n <- [10*a + b]
>                , n `mod` m == 0
>                ]

We can test this out and see if it produces the next step:

*Main> let m3 = step m2 3
*Main> m3
[123,126,129,147,162,165,168,183,186,189,243,246,249,261,264,267,285,321,324,327
,342,345,348,369,381,384,387,423,426,429,462,465,468,483,486,489,528,543,546,549
,561,564,567,582,621,624,627,642,645,648,681,684,687,723,726,729,741,762,765,768
,783,786,789,825,843,846,849,861,864,867,921,924,927,942,945,948,963,981,984,987
]
*Main> length m3
80

I'll leave it as an exercise to the reader to determine if that is correct for m3.

We can now write out all the steps to get to m9 but we will now call them s1...s9 for steps one through nine:

> s1 = num
> s2 = step s1 2
> s3 = step s2 3
> s4 = step s3 4
> s5 = step s4 5
> s6 = step s5 6
> s7 = step s6 7
> s8 = step s7 8
> s9 = step s8 9

We can verify s9 is in fact the same result as the C# code gives:

*Main> s9
[381654729]

But we are not done yet! Writing out all the steps is repetitive. We will do a little bit of Haskell trickery to see how we can easily write this more simpily:

> s 1 = num
> s 2 = step (s 1) 2
> s 3 = step (s 2) 3
> s 4 = step (s 3) 4
> s 5 = step (s 4) 5
> s 6 = step (s 5) 6
> s 7 = step (s 6) 7
> s 8 = step (s 7) 8
> s 9 = step (s 8) 9

Here we used Haskell's pattern matching style of function definition to turn our s1 through s9 functions into a single function s that takes one parameter. All we had to do was add a few spaces and parentheses Now it should be clear how to collapse this down to two statements:

> s' 1 = num
> s' m = step (s (m-1)) m

We have s' 1 as the base case and s' m as the m^th case.

*Main> s' 9
[381654729]


Next time we will go further and look at some other ways to generalize this kind of problem.

Haskell

I've been learning more about Haskell and came across this paper:

http://conal.net/papers/beautiful-differentiation/beautiful-differentiation-long.pdf

Reading it made some things start clicking...