GameOfLife.hs

import Data.List (intercalate)
import Data.Maybe (fromJust, fromMaybe)
import Debug.Trace (trace)

data Point = Point Int Int
    deriving (Show, Eq)

parsePoint :: String -> Point
parsePoint as = Point x y
  where
    [x, y] = map read $ words as

neighbors :: Point -> [Point]
neighbors (Point x y) =
    [ Point (x - 1) (y - 1)
    , Point x (y - 1)
    , Point (x + 1) (y - 1)
    , Point (x - 1) y
    , Point (x + 1) y
    , Point (x - 1) (y + 1)
    , Point x (y + 1)
    , Point (x + 1) (y + 1)
    ]

data State
    = DEAD
    | ALIVE
    deriving (Eq)

instance Show State where
    show DEAD = "_"
    show ALIVE = "*"

type Game = [(Point, State)]

showGame :: Game -> String
showGame game = unlines $ map (intercalate "" . map (\p -> show $ fromMaybe DEAD $ lookup p game)) [[Point x y | x <- [minx .. maxx]] | y <- [miny .. maxy]]
  where
    ps = map fst game
    xs = map (\(Point x _) -> x) ps
    ys = map (\(Point _ y) -> y) ps
    minx = minimum xs
    maxx = maximum xs
    miny = minimum ys
    maxy = maximum ys

inside :: Point -> Game -> Bool
inside p game = any ((== p) . fst) game

parseGame :: [Point] -> Game
parseGame = map (,ALIVE)

-- Include outer dead neighbors for processing
expandGame :: Game -> Game
expandGame game = game ++ dng
  where
    ps = map fst $ filter (\(_, s) -> s == ALIVE) game
    dng = map (,DEAD) $ filter (\p -> not (inside p game)) $ flatten $ map neighbors ps

nextState :: Point -> State -> Int -> (Point, State)
nextState p ALIVE 2 = (p, ALIVE)
nextState p _ 3 = (p, ALIVE)
nextState p _ _ = (p, DEAD)

flatten :: [[a]] -> [a]
flatten [] = []
flatten (x : xs) = x ++ flatten xs

countAliveNeighbors :: Game -> Point -> Int
countAliveNeighbors game = length . filter (== ALIVE) . map (\p -> fromMaybe DEAD $ lookup p game) . neighbors

nextGeneration :: Game -> Game
nextGeneration game = map (\(p, s) -> nextState p s (countAliveNeighbors game p)) $ expandGame game

nextGenerations :: Int -> Game -> Game
nextGenerations 1 g = g
nextGenerations n g = nextGenerations (n - 1) ng
  where
    ng = nextGeneration (trace (showGame g) g)

main :: IO ()
main = interact $ showGame . nextGenerations 10 . parseGame . map parsePoint . lines