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 Data.Bool (bool)
11 import Data.Distributive (Distributive(..))
12 import Data.Functor.Rep (Representable(..), distributeRep)
13 import Data.Functor.Identity (Identity(..))
14 import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
15 import Control.Comonad (Comonad(..))
19 import qualified Data.Set as S
21 import Control.Concurrent (threadDelay)
22 import Control.Monad (forM_)
25 instance Ord Grid where
26 m1 `compare` m2 = (toList m1) `compare` (toList m2)
29 type Coord = (Int, Int)
30 type Grid = Matrix Bool
31 type StoredGrid = Store Matrix Bool
32 type Rule = StoredGrid -> Bool
34 type GridCache = S.Set Grid
36 -- mGet :: Coord -> Matrix a -> a
37 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
38 -- mGet rc mtx = mtx ! rc
41 validCoord :: Coord -> Bool
42 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
45 instance Distributive Matrix where
46 distribute = distributeRep
48 instance Representable Matrix where
49 type Rep Matrix = Coord
50 index m c = m ! c -- mGet c m
51 tabulate = matrix gridSize gridSize
57 neighbourCoords :: [Coord]
58 -- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
59 neighbourCoords = [(-1, 0), (1, 0), (0, -1), (0, 1)]
61 addCoords :: Coord -> Coord -> Coord
62 addCoords (x, y) (x', y') = (x + x', y + y')
65 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
68 neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
69 numNeighboursAlive = length (filter id neighbours)
71 step :: Rule -> StoredGrid -> StoredGrid
74 render :: StoredGrid -> String
75 -- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
76 render grid = prettyMatrix $ mapPos (\_ c -> bool "." "#" c) g
80 mkGrid :: [Coord] -> StoredGrid
81 mkGrid xs = store (`elem` xs) (1, 1)
83 unGrid :: StoredGrid -> Grid
84 -- unGrid (StoreT (Identity g) _) = g
85 unGrid grid = fromList gridSize gridSize gridList
86 where (sgf, _sgl) = runStore grid
87 gridList = [sgf (r, c) | r <- [1..gridSize], c <- [1..gridSize]]
90 at :: [Coord] -> Coord -> [Coord]
91 coords `at` origin = map (addCoords origin) coords
93 -- glider, blinker, beacon :: [Coord]
94 -- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
95 -- blinker = [(0, 0), (1, 0), (2, 0)]
96 -- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
102 start :: IO StoredGrid
103 start = do coords <- readGrid
104 return $ mkGrid coords
105 -- glider `at` (1, 1)
106 -- ++ beacon `at` (15, 5)
112 -- let grids = map unGrid $ iterate (step basicRule) sG
113 -- forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
114 -- -- putStr "\ESC[2J" -- Clear terminal screen
115 -- putStrLn (render grid)
116 -- -- threadDelay tickTime
120 do gs <- readFile "data/advent24.txt"
122 let isBug r c = (grid!!r)!!c == '#'
123 let ng = gridSize - 1
124 return [(r + 1, c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
127 -- part1 :: Grid -> [Grid]
128 part1 :: StoredGrid -> Integer
129 -- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
130 -- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
131 -- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
132 part1 startingGrid = bioDiversity firstRepeat
134 -- grids = map unGrid $ iterate (step basicRule) startingGrid
135 -- gridCache = scanl' (flip . S.insert) S.empty grids
136 grids = fGrids startingGrid
137 gridCache = fGridCache grids
138 firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
140 fGrids :: StoredGrid -> [Grid]
141 fGrids stG = map unGrid $ iterate (step basicRule) stG
143 fGridCache :: [Grid] -> [S.Set Grid]
144 fGridCache gs = scanl' (flip S.insert) S.empty gs
145 -- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
148 bioDiversity :: Grid -> Integer
149 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
150 where bugs = toList g