11 May 2023

Throwback Thursday: Haskell Game of Life

Almost two years ago now, at a Mycs company party, I was chatting with some other devs when I confessed to having never implemented a "Game of Life". To remedy this, I wrote one in Haskell (iirc I actually started this at the party itself).

module Main where

import Control.Concurrent (threadDelay)
import Data.Map ((!?))
import qualified Data.Map as M
import Data.Maybe

main :: IO ()
main = mapM_ ((>> threadDelay 250000) . putStrLn . render . nState) [0 .. 100]

data Board = Board Int (M.Map (Int, Int) Bool)

render :: Board -> String
render (Board size b) = foldr f "" (indices size)
    where
      f (i, j) a =
          let c = cellChar $ getCell b (i, j)
           in if j == 0
                then '\n' : c : a
                else c : a

cellChar :: Bool -> Char
cellChar True = '#' -- Char if live
cellChar False = ' ' -- Char if dead

nState :: Int -> Board
nState 0 = startState
nState n = step $ nState (n -1)

startState :: Board
startState =
  let startingLiveCells =
        [ (10, 10),(10, 11),(11, 11),(11, 12),(11, 13),
          (11, 14),(10, 13),(11, 16),(10, 15),(10, 16),
          (12, 10),(13, 10),(14, 12),(14, 13),(14, 14),
          (15, 10),(15, 08),(13, 11),(10, 08),(10, 10)
        ]
   in Board 20 $ foldr (`M.insert` True) M.empty startingLiveCells

step :: Board -> Board
step (Board size b) = Board size . foldl stepCell b $ indices size -- New Board is old with all cells stepped
  where
    stepCell b1 (i, j) =
        let cellLive = getCell b (i, j)
            liveNeighbours =
              length $ filter (getCell b)
                  [ (i, j -1),(i -1, j),(i + 1, j),
                    (i, j + 1),(i + 1, j + 1),(i + 1, j -1),
                    (i -1, j + 1),(i -1, j -1)
                  ]
            newCellLive =
              (cellLive && (liveNeighbours == 2 || liveNeighbours == 3))
                || (not cellLive && liveNeighbours == 3)
         in M.insert (i, j) newCellLive b1

indices :: Int -> [(Int, Int)]
indices s = [(x, y) | x <- [0 .. s], y <- [0 .. s]]

getCell :: M.Map (Int, Int) Bool -> (Int, Int) -> Bool
getCell b = fromMaybe False . (b !?)
Tags: Haskell Tech