Conway’s game of life, Elm style.

gameoflife.elm

data Status = Alive | Dead
type Board = [[Status]]
type Coordinate = { row:Int, column:Int }

getNodeAt : Board -> Coordinate -> Status
getNodeAt graph coordinate =
    let maxRow = length graph
        maxColumn = maximum <| map length graph
        row = coordinate.row
        column = coordinate.column
    in
        if | (row < 0) || (row >= maxRow) -> Dead
           | (column < 0) || (column >= maxColumn) -> Dead
           | otherwise -> head <| drop column <| head <| drop row graph

getNeighborsOf : Board -> Coordinate -> [Status]
getNeighborsOf graph coordinate =
    [0..3] ++ [5..8] |> map (\offset ->
        let y = coordinate.row + (offset // 3 - 1)
            x = coordinate.column + (offset % 3 - 1)
        in
            getNodeAt graph { row=y, column=x })

countAliveNeighbors : Board -> Coordinate -> Int
countAliveNeighbors graph coordinate = length
    <| filter (\x -> x == Alive)
    <| getNeighborsOf graph coordinate

conwayRules : Board -> Coordinate -> Status
conwayRules graph coordinate =
    let livingNeighbors = countAliveNeighbors graph coordinate
    in
        if | livingNeighbors == 2 -> getNodeAt graph coordinate
           | livingNeighbors == 3 -> Alive
           | otherwise -> Dead

-- cartProd : [a] -> [b] -> [(a, b)]
-- f : [a] -> [(b -> (a, b)]
-- f [1, 2] = [(b -> (1, b)), (b -> (2, b)]
-- g : [f'] b -> [(a, b)]
-- g (f [1, 2]) 3 = [(1,3), (2,3)]
-- h : g -> lb -> [[(a, b)]]
-- h g [3, 4] = [[(1,3), (2,3)], [(1,4), (2,4)]]
-- foldr (++) [] : [[(a,b)]] -> [(a,b)]

cartProd la lb = let f la' = map (\x -> (\y -> (x, y))) la'
                     g lf b = map (\f' -> f' b) lf
                     h g lb' = map (\b -> g b) lb'
                in
                    foldr (++) [] <| h (g (f la)) lb

pCartProd la lb = let f la' = map (\x -> (\y -> (x, y))) la'
                      g lf b = map (\f' -> f' b) lf
                      h g lb' = map (\b -> g b) lb'
                in
                     h (g (f la)) lb

iterateBoard : Board -> Board
iterateBoard board =
    let rowCount = length board
        columnCount = maximum <| map length board
    in
        pCartProd [0..rowCount-1] [0..columnCount-1] |> map (\row ->
            row |> map (\rctuple ->
            let coordinate = {row=(fst rctuple), column=(snd rctuple)} in
                conwayRules board coordinate))

g = [[Dead, Alive, Dead, Dead, Dead],
     [Alive, Dead, Alive, Dead, Dead],
     [Dead, Alive, Dead, Dead, Dead],
     [Dead, Dead, Alive, Alive, Dead],
     [Dead, Dead, Dead, Dead, Alive]]

height = 400
width = 400

drawBoard : Board -> Element
drawBoard board =
    let rowCount = length board
        columnCount = maximum <| map length board
        cellSize = width / (toFloat columnCount)
        xOffset = -(width - cellSize) / 2
        yOffset = (height - cellSize) / 2
    in
        collage height width
            (cartProd [0..rowCount-1] [0..columnCount-1] |> map (\cell ->
                let status = getNodeAt board {row=(fst cell), column=(snd cell)}
                    cellColor = (if status == Alive then lightGrey else charcoal)
                    x = xOffset + (toFloat (snd cell)) * cellSize
                    y = yOffset - (toFloat (fst cell)) * cellSize
                in
                    square cellSize
                        |> filled cellColor
                        |> move (x, y)))


main : Signal Element
main = drawBoard <~ (foldp (\time -> iterateBoard) g (every second))