Game of Life implementation in Haskell

Question

I've written a small Game of Life module in Haskell, as well as a small testing application. I'm relatively new to the language, so any kind of comment about the code is welcome. The most important comments for me are comments about efficiency of the code, and of course bugs. I would also be happy to accept comments about:

• Coding Style
• "Reinventing the wheel"
• Misuse of features
• Show instance efficiency

module GameOfLife
       ( State(..)
       , Board
       , evolve
       , initBoard
       , setStates
       , nextGen ) where
import Data.List
import Data.Maybe
import qualified Data.Map as Map


data State = Alive | Dead deriving (Eq, Show)
type Coord = (Int,Int)
data Cell = Cell { cellState :: State
                 , cellCoord :: Coord } deriving Show
data Board = Board { boardGrid :: (Map.Map Coord Cell)
                   , boardWidth :: Int
                   , boardHeight :: Int}


initBoard :: Int -> Int -> Board
initBoard width height =
  let grid = Map.fromList $ [(c, Cell Dead c) | x <- [0..width - 1], y <- [0..height - 1], let c = (x,y)]
  in Board grid width height


setState :: Board -> State -> Coord -> Board
setState (Board grid width height) state (x,y)
  | y >= height || y < 0 = error "Height is off bounds"
  | x >= width || x < 0 = error "Width is off bounds"
  | otherwise =
    let c = (x,y)
        newGrid = Map.insert c (Cell state c) grid
    in Board newGrid width height


setStates :: Board -> State -> [Coord] -> Board
setStates board state = foldl (\board coord -> setState board state coord) board


neighbours :: Board -> Coord -> [Cell]
neighbours (Board grid width height) c@(x,y)
  | not (inBounds c) = error "Coordinate off bounds"
  | otherwise =
    let neighboursCoords = filter (/= c) $ filter inBounds [(x',y') | x' <- [x - 1..x + 1], y' <- [y - 1..y + 1]]
    in map getCell neighboursCoords
  where
    inBounds (x,y) = x >= 0 && y >= 0 && x < width && y < height
    getCell (x,y) = fromJust $ Map.lookup (x,y) grid


nextGen :: Board -> Board
nextGen board =
  let
    livingNeighbours c = length $ filter (==Alive) $ map cellState (neighbours board c)
    takeState state = map cellCoord $ filter (\c -> cellState c == state) $ Map.elems $ boardGrid board
    underPop = filter (\coords -> (livingNeighbours coords) < 2) $ takeState Alive
    overPop = filter (\coords -> (livingNeighbours coords) > 3) $ takeState Alive
    newBorn = filter (\coords -> (livingNeighbours coords) == 3) $ takeState Dead
    revive b = setStates b Alive newBorn
    kill b = setStates b Dead (overPop ++ underPop)
  in kill $ revive board


evolve :: Board -> [Board]
evolve board =
  let next = nextGen board
  in next:evolve next


-- Show instances --

instance Show Board where
  show (Board grid width height) =
    intercalate "\n" $ map gridLine [0..height - 1]
    where gridLine l =
            concat $ map (charState . cellState . fromJust) [Map.lookup (x,l) grid | x <- [0..width -1]]
          charState state
            | state == Dead = " "
            | state == Alive = "@"

EDIT: New version with Array:

module GameOfLife
       ( State(..)
       , Board
       , evolve
       , initBoard
       , setStates
       , nextGen
       , toText
       ) where
import Data.List
import Data.Array
import System.IO
import qualified Data.Text as T


data State = Alive | Dead deriving (Eq, Show)
type Coord = (Int,Int)
type Board = Array Coord State


initBoard :: Coord -> Board
initBoard (width,height) =
  let bounds = ((0,0),(width - 1,height - 1))
  in array bounds $ zip (range bounds) (repeat Dead)


setStates :: Board -> [(Coord,State)] -> Board
setStates = (//)

getStates :: Board -> [Coord] -> [State]
getStates board coords = map (board!) coords


neighbours :: Board -> Coord -> [Coord]
neighbours board c@(x,y) =
  filter (/= c) $ filter (inRange (bounds board)) [(x',y') | x' <- [x - 1..x + 1], y' <- [y - 1..y + 1]]


nextGen :: Board -> Board
nextGen board =
  let
    allCells = range (bounds board)
    takeState state coords = map fst . filter (\(_,s) -> s == state) $ zip coords (getStates board coords)
    livingNeighbours = length . takeState Alive . neighbours board
    zipState state coords = zip coords (repeat state)
    underPop = zipState Dead . filter (\c -> (livingNeighbours c) < 2) $ takeState Alive allCells
    overPop = zipState Dead .filter (\c -> (livingNeighbours c) > 3) $ takeState Alive allCells
    newBorn = zipState Alive .filter (\c -> (livingNeighbours c) == 3) $ takeState Dead allCells
  in setStates board (concat [underPop, overPop, newBorn])


evolve :: Board -> [Board]
evolve = iterate nextGen


toText :: Board -> T.Text
toText board = T.intercalate (T.singleton '\n') (rows minY)
  where
    ((minX,minY),(maxX,maxY)) = bounds board
    rows y
      | y > maxY = []
      | otherwise = (row y minX):rows (y + 1)
    row y x
      | x > maxX = T.empty
      | otherwise = T.cons (stateToChar $ board!(x,y)) (row y (x + 1))
    stateToChar state
      | state == Alive = '@'
      | otherwise = ' '

EDIT 2: nextGen implemented using do notation:

nextGen :: Board -> Board
nextGen board =
  let
    allCells = range (bounds board)
    takeState dstate coords = do
      coord <- coords
      let state = board ! coord
      guard $ state == dstate
      return (coord)
    theLiving = takeState Alive allCells
    theDead = takeState Dead allCells
    livingNeighbours = length . takeState Alive . neighbours board
    underPop = do
      alive <- theLiving
      guard $ (livingNeighbours alive) < 2
      return (alive,Dead)
    overPop = do
      alive <- theLiving
      guard $ (livingNeighbours alive) > 3
      return (alive,Dead)
    newBorn = do
      dead <- theDead
      guard $ (livingNeighbours dead) == 3
      return (dead,Alive)
  in setStates board (concat [underPop, overPop, newBorn])

Answer 1

First of all you should consider how you represent your board.

• Using Array with two-dimension index (Ix) would be a good choice for the way you work right now. You define value for each cell individually no matter what is in that cell.
• Alternative way is to use Map to () or Set of coordinates to represent Alive cells while treating rest of the board as Dead.
• Yet another is to use own container without even mentioning of coordinates.
  Consider the way how list ([a]) defined. That's actually a single-linked list. And you can create double-linked list like data DList a = DList DList a DList. In a same way you can define a double-linked grid (4 directions). Going further will let you define 5th dimension that represents generations.
  Such approach often used to represent lazy infinite structures that grow while you walk over them (ex. you walk around some cell and then dive into next generation and walk around again revealing how everythin were changed).
  I remember some term associated with that called "cellular automaton"

Next would be state (in case of Array and "cellular automaton")

Here you can define your own State just to make it clear, but you as well can use Bool. Note that it doesn't look like you need coordinates at all (consider dropping them from Cell).

Producing of new Map, Set, Array should be considered carefully I guess

One of the important thing is that its better to avoid producing of new board on each intermediate step (killing and reviving). I'd suggest to build up delta and then apply to original board. That should guard you from building almost similar copies of board.

Signatures

• It's a very common practice for update functions to take input as a last argument. I.e. setState :: State -> [Coord] -> Board -> Board. That allows to write something like: killTopLeft = setStates Dead [(0,0)]

Using high-order functions

evolve = iterate nextGen

And

setStates board state coords = Map.union updates board where
    updates = Map.fromList $ map (\c -> (c, Cell state c)) coords