Nim Game in Haskell

Question

I wrote Nim Game in Haskell. Since I'm just learning any review comments are highly appreciated.

module Nim where 
import Char 
import List
import Maybe

--Domain 
--Nim is a mathematical game of strategy 
--in which two players take turns removing objects from distinct heaps. 
--On each turn, a player must remove at least one object, and may remove 
--any number of objects provided they all come from the same heap.
--Read more at http://en.wikipedia.org/wiki/Nim
--
type Board = [Int]  --number of objects in each heap
type Heap = Int     --Heap id
type Turn = (Int, Int)  --heap and number of objects to remove 

--Build new board according to old one and turn.
applyTurn :: Turn -> Board -> Board
applyTurn t b = map 
    (\ (i, v) -> if (i == fst t) then v - snd t else v)
    (zip [1..] b)

--Check if board is empty. When it is, game is over.
empty :: Board -> Bool
empty b = all (<= 0) b

--Returns tupples of (heap index, number of object in the heap).
indexedHeaps :: Board -> [(Heap, Int)]
indexedHeaps b = zip [1..] b

--Returns heaps that contains one or more objects.
availableHeaps :: Board -> [Heap]
availableHeaps b = map fst (filter (\ (_, h) -> h > 0) (indexedHeaps b))

--Return number of objects in the heap.
availableObjectsByHeap :: Board -> Heap -> Int
availableObjectsByHeap b h = snd (head (
    filter (\ (i, _) -> i == h) (indexedHeaps b)))

--IO Utils
--
--Read Int from console. There could be validation using predicate.
promtInt :: String -> (Int -> Bool) -> IO Int
promtInt msg p = do 
    putStr (msg ++ "> ")
    c <- getChar
    ignored <- getLine
    let x = ((ord c) - ord('0'))
    if(p x) 
        then return x 
        else promtInt msg p

--Read Int from console. Int should be in range.
promtIntFromRange :: String -> (Int, Int) -> IO Int
promtIntFromRange msg (from, to) = promtInt newMsg p where 
    newMsg = msg ++ "[" ++ show from ++ ";" ++ show to ++"]" 
    p v = v >= from && v <= to

--Read Int from console. Int should be in set.
promtIntFromSet :: String -> [Int] -> IO Int
promtIntFromSet msg s = promtInt newMsg p where 
    newMsg = msg ++ show s
    p v = isJust (find (== v) s)

--Print each string from new line.
putAllStr :: [String] -> IO()
putAllStr [x] = do putStrLn x
putAllStr (x:xs) = do 
    putAllStr [x]
    putAllStr xs

--Game specific IO
--
--Dialog for inputing turn data.
readTurn :: Board -> IO(Turn)
readTurn b = do 
    heap <- promtIntFromSet "heap" (availableHeaps b)
    objects <- promtIntFromRange "number" 
        (1, (availableObjectsByHeap b heap))
    return (heap, objects)

--Displays board in user friendly interface.
showBoard :: Board -> IO()
showBoard b = do 
    putAllStr (map stringify (indexedHeaps b)) where
        objectsAtHeap n =  concat(replicate n "*")
        heapIndex  i = "[" ++ show i ++ "]"
        stringify (i, n) =  heapIndex i ++ objectsAtHeap n

--Game
--
--Actually game.
play :: IO(Board)-> IO(Board)
play b = do 
    board <- b
    if (empty board)
    then return [] 
    else do 
        showBoard board
        t <- readTurn board
        play (return (applyTurn t board))

--Runner function.
nim :: IO() 
nim = do    
    ignored <- play (return [1, 2, 3, 1])
    putStrLn "done"

Answer 1

First, here's an overview on style and idiom without changing anything too significantly.

import Data.Char 
import Data.List
import Data.Maybe

Switching to the current names for these modules. The non-hierarchical names exist only for compatibility.

type Board = [Integer]         -- number of objects in each heap
type Heap = Integer            -- Heap id
type Turn = (Integer, Integer) -- heap and number of objects to remove 

There's really no reason to use Int except for number-crunching with small integers. Not that it's likely to matter here, but getting in the habit of using Integer by default means you don't have to worry about bugs due to, say, a counter in a long-running program exceeding the maximum size of Int. Mystery bugs that only occur on large data sets or after running for a long time are not fun to track down.

The only problem is that some standard functions take only Int arguments for no good reason, rather than any integral type. This is a misfeature of the standard libraries and not one you should emulate.

applyTurn :: Turn -> Board -> Board
applyTurn (heapId, removed) board = zipWith decHeap [1..] board
  where decHeap idx n | idx == heapId = n - removed
                      | otherwise     = n

Several things here:

• Pattern matching on the turn instead of using fst and snd, as well as better names for everything.
• Zipping lists and then mapping a function over that is what zipWith is for.
• Replacing the lambda with a function in the where clause, and using guards on that rather than an if expression.

I've left the algorithm unchanged for now. It could be improved, as Paul Martel shows, but using lists for this purpose at all is really not ideal. I'll return to this point later.

availableHeaps :: Board -> [Heap]
availableHeaps b = [heapId | (heapId, count) <- indexedHeaps b, count > 0]

A slightly different way of writing the same list comprehension Paul Martel used. Many Haskell programmers prefer using map, filter, &c. directly; doing so, it would look like this instead:

availableHeaps b = map fst . filter ((> 0) . snd) $ indexedHeaps b

But I think the list comprehension is clearer in this case.

availableObjectsByHeap :: Board -> Heap -> Integer
availableObjectsByHeap board heapId = board !! (fromInteger heapId - 1)

The (!!) function gives zero-based indexing into a list, so we adjust to account for heap numbers starting from 1. It takes an Int argument, as noted above. Using (!!)--or any sort of indexing into a list--continues to be less than ideal, and a sign that some other data structure should be used.

I'll be correcting the spelling of "prompt" as I go, incidentally.

Now, we could try the following to tidy up promptInt:

promptInt :: String -> (Integer -> Bool) -> IO Integer
promptInt msg p = do 
    putStr (msg ++ "> ")
    x <- readLn -- Don't actually do this!
    if p x
        then return x 
        else promptInt msg p

Unfortunately, this is a distinct disimprovement. Using readLn raises an exception when it can't parse the user input, which makes it needlessly awkward to use. Rather than messing with catching exceptions, we'll whip up a replacement using the reads function, which returns a list of possible parses, and use Maybe to indicate success vs. failure.

-- Why doesn't this exist in the Prelude?
maybeRead :: (Read a) => String -> Maybe a
maybeRead str = listToMaybe [x | (x, "") <- reads str]

maybeReadLn :: (Read a) => IO (Maybe a)
maybeReadLn = fmap maybeRead getLine

Now, we can fix promptInt correctly:

promptInt :: String -> (Integer -> Bool) -> IO Integer
promptInt msg p = do 
    putStr (msg ++ "> ")
    mx <- maybeReadLn
    case mx of
        Just x | p x -> return x
        _            -> promptInt msg p

Using the standard Read instance instead of doing calculations with ord makes it easier to see what's going on here. The predicate has also been combined with the pattern match, so the default pattern handles both parse failures and invalid inputs.

promptIntFromRange :: String -> (Integer, Integer) -> IO Integer
promptIntFromRange msg (from, to) = promptInt newMsg inRange 
  where newMsg = concat [msg, "[", show from, ";", show to, "]"]
        inRange v = v >= from && v <= to

It's more typical to have where begin a new line, in order to clearly distinguish a where clause from a multi-line expression. Using concat tends to be tidier than repeated (++), and again improving a name--for an arbitrary predicate p makes sense, but here we have a specific predicate, and should indicate such.

promptIntFromSet :: String -> [Integer] -> IO Integer
promptIntFromSet msg s = promptInt (msg ++ show s) (`elem` s)

This can all be done in-line, since the standard library already has a function for your predicate.

putAllStr :: [String] -> IO ()
putAllStr xs = mapM_ putStrLn xs

You'll probably reinvent large sections of the standard library at various points while learning Haskell. Figuring out that you've done so is half the fun.

printBoard :: Board -> IO ()
printBoard board = putAllStr $ showHeaps board

showHeaps :: Board -> [String]
showHeaps board = map showIdxHeap (indexedHeaps board)

showIdxHeap :: (Heap, Integer) -> String
showIdxHeap (heapId, n) = heapIndex ++ objects
  where heapIndex = concat ["[", show heapId, "]"]
        objects = genericReplicate n '*'

As Paul Martel did, I've separated the string representation of the board from the printing. Note that String is simply [Char], so replicating '*' suffices. The use of genericReplicate here is because of using Integer rather than Int.

play :: Board -> IO Board
play board | empty board = return []
           | otherwise   = do printBoard board
                              t <- readTurn board
                              play $ applyTurn t board

nim :: IO () 
nim = do play [1, 2, 3, 1]
         putStrLn "done"

There's no reason for play to take an IO Board, so I've removed the superfluous return and binding steps. This also allows using guards for the empty check, removing the conditional expression.

---

Ok. With that out of the way, time to revisit the earlier remarks about data structures. Lists in Haskell are sequential in nature, so indexing into them or replacing a single element is clumsy and inefficient at best. We'd like something more suitable here, and a good default choice is the Data.Map module.

import qualified Data.Map as Map

type HeapId = Integer
type Turn = (HeapId, Integer)
type Board = Map.Map HeapId Integer

The module is imported qualified to avoid name clashes with various list functions. I've also renamed Heap to HeapId to be more explicit about what it represents.

applyTurn :: Turn -> Board -> Board
applyTurn (heapId, removed) board = Map.adjust (subtract removed) heapId board

empty :: Board -> Bool
empty b = Map.null $ availableHeaps b

availableHeaps :: Board -> Board
availableHeaps b = Map.filter (> 0) b

Converting the game state functions to use Data.Map. They're much simpler this way, and some functions I've eliminated entirely.

nim :: IO () 
nim = do play $ Map.fromList (zip [1..] [1, 2, 3, 1])
         putStrLn "done"

Initializing the game doesn't need to change much, but note the construction using Map.fromList, assigning specific keys to each heap by counting from 1.

promptHeapSize :: String -> Board -> IO (HeapId, Integer)
promptHeapSize msg board = do 
    heapId <- promptInt msg' (`Map.member` board)
    case Map.lookup heapId board of
        Nothing -> promptHeapSize msg board
        Just sz -> return (heapId, sz)
  where msg' = msg ++ show (Map.keys board)

Here I've replaced promptIntFromSet with a smarter function that makes sure the requested heap number is valid, and returns the number of objects as well.

readTurn :: Board -> IO Turn
readTurn b = do 
    (heapId, heapSz) <- promptHeapSize "heap" b
    objects <- promptIntFromRange "number" (1, heapSz)
    return (heapId, objects)

showHeaps :: Board -> [String]
showHeaps board = map showIdxHeap (Map.assocs board)

Only a couple very minor changes here.

runNextTurn :: Board -> IO Board
runNextTurn b = do 
    printBoard board
    t <- readTurn board
    play $ applyTurn t board

play :: Board -> IO Board
play board | empty board = return board
           | otherwise   = runNextTurn board >>= play

I split play into two functions--one that does a single turn, and one that loops until the game is done. This doesn't really change anything, but makes it easier if you want to have more complicated interaction than the same loop every time.

The complete program using Data.Map, along with some other minor changes I made along the way, can be found here.

Answer 2

These variations seem more direct and make better use of standard functions and idioms

--Build new board according to old one and turn.
applyTurn :: Turn -> Board -> Board
applyTurn (heap, removed) b = 
    let (before, (at:after)) = splitAt (heap-1) b
    in  before ++ ((at-removed):after)

--Returns heaps that contains one or more objects.
availableHeaps :: Board -> [Heap]
availableHeaps b = [fst x | x <- indexedHeaps b, (snd x) > 0]

I'm still learning Haskell, too. There MAY be a more usual way of getting the nth element than head (drop (n-1) list).

--Return number of objects in the heap.
availableObjectsByHeap :: Board -> Heap -> Int
availableObjectsByHeap b h = head (drop (h-1) b)

I broke up your showBoard into putBoard and my showBoard to further isolate the pure code. This also makes a better analogy with "show" which does formatting but not IO

--Format board for user friendly interface.
showBoard :: Board -> [String]
showBoard b = map stringify (indexedHeaps b) where
        objectsAtHeap n =  concat(replicate n "*")
        heapIndex  i = "[" ++ show i ++ "]"
        stringify (i, n) =  heapIndex i ++ objectsAtHeap n

--Displays board in user friendly interface.
putBoard :: Board -> IO()
putBoard b = do 
    putAllStr (showBoard b)

I just changed showBoard to putBoard, below.

--Game
--
--Actually game.
play :: IO(Board)-> IO(Board)
play b = do 
    board <- b
    if (empty board)
    then return [] 
    else do 
        putBoard board
        t <- readTurn board
        play (return (applyTurn t board))

Aside from that, "prompt" is usually spelled with one more 'p' than "tuples" has.

Answer 3

Here's a simpler way to write the list-based availableHeaps, using findIndices from Data.List:

availableHeaps' :: Board -> [Heap]
availableHeaps' = findIndices (> 0)

Of course the Map version by McCann is more appropriate for the Nim data structure, but it's always good to become familiar with the standard list functions too.