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 !?)