Programming Praxis – Nim

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!

Tags: , , , , , , ,

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: