Posts Tagged ‘nim’

Programming Praxis – Nim

January 8, 2010

In today’s Programming Praxis we have to program the game Nim. Let’s get started.

First, some imports:

import Data.Bits
import System.Random
import Text.Printf

We need a way to check if a move is valid to prevent illegal player input.

valid :: (Int, Int) -> [Int] -> Bool
valid (p, t) ps = and [p >= 0, p < length ps, t > 0, t <= ps !! p]

When the computer makes a move, we need to show it to the player.

showMove :: (Int, Int) -> IO ()
showMove (p, t) = printf "I remove %d stone%s from pile %d\n" t
                      (if t > 1 then "s" else "") (p + 1)

For the computer’s ai, use the xor approach or make a random move if there is no winning move.

cpu :: [Int] -> IO (Int, Int)
cpu ps = do p <- randomRIO (0, length ps - 1)
            t <- randomRIO (1, ps !! p)
            let n = foldl xor 0 ps
            let r = if n == 0 then (p, t) else (length a, b - xor b n)
                        where (a,b:_) = break (\x -> xor x n < x) ps
            if valid r ps then showMove r >> return r else cpu ps

A quick convenience function to make getting player input easier:

prompt :: Read a => String -> IO a
prompt s = putStr (s ++ " ") >> fmap read getLine

The player’s move is pretty straightforward.

human :: [Int] -> IO (Int, Int)
human ps = do p <- fmap pred $ prompt "Pile?"
              t <- prompt "Stones?"
              if valid (p, t) ps then return (p, t) else human ps

Each turn, check if the game is over. If not, show the board and let the correct player take a turn. The lazy pattern match in the turn function (the tilde) is to prevent the complaint about not matching [], since we’re going to feed this function with an infinite list anyway.

display :: [Int] -> String
display = unlines . zipWith (printf "%d: %d") [1 :: Int ..]

makeMove :: (Int, Int) -> [Int] -> [Int]
makeMove (p, t) = (\(a,b:c) -> a ++ b - t:c) . splitAt p

turn :: [([Int] -> IO (Int, Int), [Char])] -> [Int] -> IO ()
turn ~((f, w):ms) b = if all (== 0) b then putStrLn $ w ++ " win"
                      else do putStr $ display b
                              turn ms . flip makeMove b =<< f b

When starting a new game, we need to determine the correct turn order.

nim :: [Int] -> IO ()
nim ps = do f <- prompt "Enter 1 to move first or 2 to move second:"
            turn (drop f $ cycle [(cpu, "You"), (human, "I")]) ps

Let’s see if everything’s working correctly:

main :: IO ()
main = nim [3,4,5]

Yup. Have fun playing!