advent24/src/advent24v.hs

   1
   2
   3 import Control.Concurrent (threadDelay)
   4
   5
   6 import Data.Functor.Compose (Compose(..))
   7 import Data.Vector (Vector, (!), generate)
   8 import Data.Bool (bool)
   9 import Data.Distributive (Distributive(..))
  10 import Data.Functor.Rep (Representable(..), distributeRep)
  11 import Data.Functor.Identity (Identity(..))
  12 import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment)
  13 import Control.Comonad (Comonad(..))
  14 import Control.Monad (forM_)
  15
  16 type Coord = (Int, Int)
  17 type Grid = Store (Compose Vector Vector) Bool
  18 type Rule = Grid -> Bool
  19
  20 instance Distributive Vector where
  21   distribute = distributeRep
  22
  23 instance Representable Vector where
  24   type Rep Vector = Int
  25   index v i = v ! (i `mod` gridSize)
  26   tabulate = generate gridSize
  27
  28 gridSize :: Int
  29 gridSize = 20
  30
  31 neighbourCoords :: [Coord]
  32 neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
  33
  34 addCoords :: Coord -> Coord -> Coord
  35 addCoords (x, y) (x', y') = (x + x', y + y')
  36
  37 basicRule :: Rule
  38 basicRule g = numNeighboursAlive == 3 || (alive && numNeighboursAlive == 2)
  39   where
  40     alive = extract g
  41     neighbours = experiment (at neighbourCoords) g
  42     numNeighboursAlive = length (filter id neighbours)
  43
  44 step :: Rule -> Grid -> Grid
  45 step = extend
  46
  47 render :: Grid -> String
  48 render (StoreT (Identity (Compose g)) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
  49
  50 mkGrid :: [Coord] -> Grid
  51 mkGrid xs = store (`elem` xs) (0, 0)
  52
  53 at :: [Coord] -> Coord -> [Coord]
  54 coords `at` origin = map (addCoords origin) coords
  55
  56 glider, blinker, beacon :: [Coord]
  57 glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
  58 blinker = [(0, 0), (1, 0), (2, 0)]
  59 beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
  60
  61
  62
  63
  64
  65
  66 tickTime :: Int
  67 tickTime = 200000
  68
  69 start :: Grid
  70 start = mkGrid $
  71      glider `at` (0, 0)
  72   ++ beacon `at` (15, 5)
  73
  74 main :: IO ()
  75 main = forM_ (iterate (step basicRule) start) $ \grid -> do
  76   putStr "\ESC[2J" -- Clear terminal screen
  77   putStrLn (render grid)
  78   threadDelay tickTime