4 import Data.Finite (Finite, modulo, getFinite)
5 import GHC.TypeNats (KnownNat)
8 -- import Data.Functor.Compose (Compose(..))
9 -- import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
10 import qualified Data.Matrix as X
11 import Data.Bool (bool)
12 import Data.Distributive (Distributive(..))
13 import Data.Functor.Rep (Representable(..), distributeRep)
14 import Data.Functor.Identity (Identity(..))
15 import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
16 import Control.Comonad (Comonad(..))
20 import qualified Data.Set as S
21 import qualified Data.Map as M
23 import Control.Concurrent (threadDelay)
24 import Control.Monad (forM_)
27 instance Ord Grid where
28 m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
31 type Coord = (Int, Int)
32 type Grid = X.Matrix Bool
33 type StoredGrid = Store X.Matrix Bool
34 type Rule = StoredGrid -> Bool
36 type GridCache = S.Set Grid
38 -- mGet :: Coord -> Matrix a -> a
39 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
40 -- mGet rc mtx = mtx ! rc
43 validCoord :: Coord -> Bool
44 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
47 instance Distributive X.Matrix where
48 distribute = distributeRep
50 instance Representable X.Matrix where
51 type Rep X.Matrix = Coord
52 index m c = (X.!) m c -- mGet c m
53 tabulate = X.matrix gridSize gridSize
59 neighbourCoords :: [Coord]
60 -- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
61 neighbourCoords = [(-1, 0), (1, 0), (0, -1), (0, 1)]
63 addCoords :: Coord -> Coord -> Coord
64 addCoords (x, y) (x', y') = (x + x', y + y')
67 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
70 neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
71 numNeighboursAlive = length (filter id neighbours)
73 step :: Rule -> StoredGrid -> StoredGrid
76 render :: StoredGrid -> String
77 -- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
78 render grid = X.prettyMatrix $ X.mapPos (\_ c -> bool "." "#" c) g
82 mkGrid :: [Coord] -> StoredGrid
83 mkGrid xs = store (`elem` xs) (1, 1)
85 unGrid :: StoredGrid -> Grid
86 -- unGrid (StoreT (Identity g) _) = g
87 unGrid grid = X.fromList gridSize gridSize gridList
88 where (sgf, _sgl) = runStore grid
89 gridList = [sgf (r, c) | r <- [1..gridSize], c <- [1..gridSize]]
92 at :: [Coord] -> Coord -> [Coord]
93 coords `at` origin = map (addCoords origin) coords
95 -- glider, blinker, beacon :: [Coord]
96 -- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
97 -- blinker = [(0, 0), (1, 0), (2, 0)]
98 -- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
104 start :: IO StoredGrid
105 start = do coords <- readGrid
106 return $ mkGrid coords
107 -- glider `at` (1, 1)
108 -- ++ beacon `at` (15, 5)
114 -- let grids = map unGrid $ iterate (step basicRule) sG
115 -- forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
116 -- -- putStr "\ESC[2J" -- Clear terminal screen
117 -- putStrLn (render grid)
118 -- -- threadDelay tickTime
122 do gs <- readFile "data/advent24.txt"
124 let isBug r c = (grid!!r)!!c == '#'
125 let ng = gridSize - 1
126 return [(r + 1, c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
129 -- part1 :: Grid -> [Grid]
130 part1 :: StoredGrid -> Integer
131 -- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
132 -- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
133 -- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
134 part1 startingGrid = bioDiversity firstRepeat
136 -- grids = map unGrid $ iterate (step basicRule) startingGrid
137 -- gridCache = scanl' (flip . S.insert) S.empty grids
138 grids = fGrids startingGrid
139 gridCache = fGridCache grids
140 firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
142 fGrids :: StoredGrid -> [Grid]
143 fGrids stG = map unGrid $ iterate (step basicRule) stG
145 fGridCache :: [Grid] -> [S.Set Grid]
146 fGridCache gs = scanl' (flip S.insert) S.empty gs
147 -- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
150 bioDiversity :: Grid -> Integer
151 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
152 where bugs = X.toList g