Game of Life

When implementing Conway's Game of Life for the browser and the terminal with JavaScript, I fell in love with Game of Life. This is my Haskell implementation.

This is the rules of Conway's Game of Life:

Any live cell with fewer than two live neighbours dies, as if by underpopulation.
Any live cell with two or three live neighbours lives on to the next generation.
Any live cell with more than three live neighbours dies, as if by overpopulation.
Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.

I represent Game of Life patterns in a set of text files. A dead cell is represented by a dot, a living cell by an o.

...........
...oo.oo...
...oo.oo...
....o.o....
..o.o.o.o..
..o.o.o.o..
..oo...oo..
...........
...........

Firstly, I format the pattern so that a node contains an integer Point, a tuple with the x/y position, as well as a boolean Status, stating if the node is alive or not. A Node is a tuple with a Point and Status. The list of all existing nodes constitutes the Game. Each game state is a Generation.

type Point      = (Int, Int)
type Status     = Bool
type Node       = (Point, Status)
type Game       = [Node]
type Generation = Integer

isCharLiving ∷ Char → Bool
isCharLiving char
    | char == 'o' = True
    | otherwise   = False

makeRow ∷ String → Int → [Node]
makeRow row y =
      [((x,y), isCharLiving $ row !! x) | x ← [0..length row - 1]]

prepareData ∷ [String] → Game
prepareData rawData =
      concat [ makeRow (rawData !! y) y | y ← [0..length rawData - 1]]

In nextState I map the list of Nodes, transforming them according to the rules of Game of Life.

nextState ∷ Game → Game
nextState game = map (`makeNode` game) game

When quoting a few Haskell functions, the expressivness of the type signatures become clear. We pass a Node, and then a Game (the currying is abstracted away in Haskell), and get a new Node.

We don't care about the Point (it never changes), only the Status. We call nextNodeState with two (implicitly curried parameters), a function call to aliveNeighbours (couting the number of living neighbours), and the Status (alive or not).

makeNode ∷ Node → Game → Node
makeNode node game =
  (
    fst node,
    nextNodeState (aliveNeighbours game node directions 0) (snd node)
  )

Due to Haskell guards, evaluating predicates, we can formulate the rules very clearly in nextNodeState,

nextNodeState ∷ Integer → Bool → Bool
nextNodeState aliveNeighbours status
  | aliveNeighbours == 3 && not status = True
  | aliveNeighbours == 2 && status     = True
  | aliveNeighbours == 3 && status     = True
  | otherwise                          = False

and begin counting neighbours,

aliveNeighbours ∷ Game → Node → [Point] → Integer → Integer
aliveNeighbours game ((x,y), status) dirs count
  | null dirs         = count
  | isAlive game (x + fst (head dirs), y + snd (head dirs))
                      = aliveNeighbours game ((x,y), status) (tail dirs) (count + 1)
  | otherwise         = aliveNeighbours game ((x,y), status) (tail dirs) count

directions ∷ [Point]
directions = [(0,-1), (1,-1), (1,0), (1,1), (0,1), (-1,1), (-1,0), (-1,-1)]

isAlive ∷ Game → Point → Bool
isAlive game node
  | isNothing(getCell node game)      = False
  | snd (fromJust(getCell node game)) = True
  | otherwise                         = False

getCell ∷ Point → Game → Maybe Node
getCell pos [] = Nothing
getCell pos (((x,y), status) : rest)
  | pos == (x,y) = Just ((x,y), status)
  | otherwise = getCell pos rest

This pattern is subsumed the rules and the game continues until the application is ended.

main ∷ IO ()
main = do
  rawData ← readFile "./pentadecathlon"
  get (prepareData $ lines rawData)

representation ∷ Status → String
representation cell
  | cell      = "[●]"
  | otherwise = "[∙]"

putCell ∷ Cell → IO ()
putCell cell
  | fst (fst cell) == 0 = putStr $ "\n" ++ representation (snd cell)
  | otherwise           = putStr $ representation (snd cell)

clearScreen ∷ IO ()
clearScreen = putStr "\ESC[2J"

get ∷ Game → IO ()
get game = do
  sequence_ [putCell cell | cell ← game]
  clearScreen
  threadDelay 200000
  get (nextState game)

WireWorld

Learning Haskell, projects such as Conway’s Game of Life and WireWorld are valuable to me. They are narrow, include interesting parts, and don’t take too much time to implement. Most of all, they’re fascinating ‘games’ in themselves.

When making WireWorld we can reuse large parts (with some trivial changes) of the UI made for the implementation of Conway’s Game of Life.

These are the rules for WireWorld:

A cell has four possible states:

empty (1),
electron head (2),
electron tail (3),
conductor (4).

Each cell evolves from one generation to the next and depending on the game circumstances its state may change. Change occurs according to his schedule:

empty → empty,
electron head → electron tail,
electron tail → conductor,
conductor → electron head if exactly one or two of the neighbouring cells are electron heads, otherwise remains conductor.

In fact, with some trivial changes, we can reuse pattern formatting as well. I store ‘patterns’ in a similar fashion using a text file. This is a logical OR-gate:

.......**.....................
h******..*....................
........**********************
h******..*....................
.......**.....................

If you compare with my implementation of Conway’s Game of Life the only important thing changed is name of the function determining a cell state, and the conditions (since WireWorld have four possible states and Conway’s Game of Life only have two):

stateEMPTY     = 0
stateHEAD      = 1
stateTAIL      = 2
stateCONDUCTOR = 3

main ∷ IO ()
main = do
  rawData ← readFile "./demo"
  get (prepareData $ lines rawData)

representation ∷ State → String
representation node
  | node == stateHEAD      = "██"
  | node == stateTAIL      = "▓▓"
  | node == stateCONDUCTOR = "░░"
  | otherwise              = "  "

putNode ∷ Node → IO ()
putNode node
  | fst (fst node) == 0 = putStr $ "\n" ++ representation (snd node)
  | otherwise           = putStr $ representation (snd node)

clearScreen ∷ IO ()
clearScreen = putStr "\ESC[2J"

get ∷ Game → IO ()
get game = do
  sequence_ [putNode node | node ← game]
  clearScreen
  threadDelay 500000
  get (nextState game)

nodeState ∷ Char → Integer
nodeState char
  | char == '.' = stateEMPTY
  | char == 'h' = stateHEAD
  | char == '*' = stateCONDUCTOR
  | otherwise   = stateTAIL

makeRow ∷ String → Int → [Node]
makeRow row y =
  [((x,y), nodeState $ row !! x) | x ← [0..length row - 1]]

prepareData ∷ [String] → Game
prepareData rawData =
  concat [ makeRow (rawData !! y) y | y ← [0..length rawData - 1]]

As for the logic, we use similar procedures, only slightly refactoring my implementation of the logic for Conway’s Game of Life:

directions ∷ [Point]
directions = [(0,-1), (1,-1), (1,0), (1,1), (0,1), (-1,1), (-1,0), (-1,-1)]

getNode ∷ Point → Game → Maybe Node
getNode pos [] = Nothing
getNode pos (((x,y), status) : rest)
  | pos == (x,y) = Just ((x,y), status)
  | otherwise = getNode pos rest

isHead ∷ Maybe Node → Integer
isHead node = case node of
  Just node → if snd node == stateHEAD
                then stateHEAD
                else stateCONDUCTOR
  Nothing   → stateCONDUCTOR

checkNeighbors ∷ Node → Game → [Point] → Integer → Integer
checkNeighbors ((x,y), nodeState) game dirs isAny
  | isAny == stateHEAD = stateHEAD
  | null dirs          = stateCONDUCTOR
  | otherwise          = checkNeighbors
     ((x,y), nodeState)
     game
     (tail dirs)
     (isHead (getNode (x + fst (head dirs), y + snd (head dirs)) game))

nextNodeState ∷ Node → Game → State
nextNodeState ((x,y), state) game
  | state == stateHEAD      = stateTAIL
  | state == stateTAIL      = stateCONDUCTOR
  | state == stateCONDUCTOR = checkNeighbors ((x,y), state) game directions state
  | otherwise               = stateEMPTY

makeNode ∷ Node → Game → Node
makeNode node game = (fst node, nextNodeState node game)

nextState ∷ Game → Game
nextState game = map (`makeNode` game) game

Cellular Automaton in Haskell

2020-10-22

Game of Life

WireWorld