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.Strict as M
23 import Control.Concurrent (threadDelay)
24 import Control.Monad (forM_)
27 data Coord = Ongrid Int Int | Offgrid deriving (Show, Eq, Ord)
28 data Grid a = Grid a (M.Map Coord a) deriving (Show, Eq, Ord)
29 type StoredGrid = Store Grid Bool
30 type Rule = StoredGrid -> Bool
32 type GridCache = S.Set (Grid Bool)
35 instance Functor Grid where
36 fmap f (Grid a m) = Grid (f a) (fmap f m)
38 instance Distributive Grid where
39 distribute = distributeRep
41 instance Representable Grid where
43 index (Grid a m) Offgrid = a
44 index (Grid a m) here = M.findWithDefault a here m
47 (M.union (M.singleton c (f c))
48 (M.unions (fmap (mapOfGrid . tabulate)
49 (fmap (f . ) (fmap addCoords neighbourCoords)))
50 -- (fmap (f . addCoords . ) neighbourCoords))
55 mapOfGrid (Grid _ m) = m
60 -- validCoord :: Coord -> Bool
61 -- validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
63 boundCoord :: Coord -> Coord
64 boundCoord Offgrid = Offgrid
65 boundCoord (Ongrid r c)
66 | r >= 1 && r <= gridSize && c >= 1 && c <= gridSize = Ongrid r c
69 neighbourCoords :: [Coord]
70 -- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
71 neighbourCoords = [(Ongrid -1 0), (Ongrid 1 0), (Ongrid 0 -1), (Ongrid 0 1)]
73 addCoords :: Coord -> Coord -> Coord
74 addCoords Offgrid _ = Offgrid
75 addCoords _ Offgrid = Offgrid
76 addCoords (Ongrid x y) (Ongrid x' y') = boundCoord $ Ongrid (x + x') (y + y')
79 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
82 neighbours = experiment ((map boundCoord) . (at neighbourCoords)) g
83 numNeighboursAlive = length (filter id neighbours)
85 step :: Rule -> StoredGrid -> StoredGrid
88 render :: StoredGrid -> String
89 -- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
90 -- render grid = X.prettyMatrix $ X.mapPos (\_ c -> bool "." "#" c) g
91 -- where g = unGrid grid
92 render grid = show $ unGrid grid
95 mkGrid :: [Coord] -> StoredGrid
96 mkGrid xs = store (`elem` xs) (Ongrid 1 1)
98 unGrid :: StoredGrid -> Grid Bool
99 -- unGrid (StoreT (Identity g) _) = g
100 unGrid grid = Grid False $ M.fromList gridList
101 where (sgf, _sgl) = runStore grid
102 gridList = [((Ongrid r c), sgf (Ongrid r c)) | c <- [1..gridSize], r <- [1..gridSize]]
105 at :: [Coord] -> Coord -> [Coord]
106 coords `at` origin = map (addCoords origin) coords
108 -- glider, blinker, beacon :: [Coord]
109 -- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
110 -- blinker = [(0, 0), (1, 0), (2, 0)]
111 -- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
117 start :: IO StoredGrid
118 start = do coords <- readGrid
119 return $ mkGrid coords
120 -- glider `at` (1, 1)
121 -- ++ beacon `at` (15, 5)
127 let grids = map unGrid $ iterate (step basicRule) sG
128 forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
129 putStr "\ESC[2J" -- Clear terminal screen
130 putStrLn (render grid)
135 do gs <- readFile "data/advent24.txt"
137 let isBug r c = (grid!!r)!!c == '#'
138 let ng = gridSize - 1
139 return [Ongrid (r + 1) (c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
142 -- part1 :: Grid -> [Grid]
143 part1 :: StoredGrid -> Integer
144 -- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
145 -- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
146 -- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
147 part1 startingGrid = bioDiversity firstRepeat
149 -- grids = map unGrid $ iterate (step basicRule) startingGrid
150 -- gridCache = scanl' (flip . S.insert) S.empty grids
151 grids = fGrids startingGrid
152 gridCache = fGridCache grids
153 firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
155 fGrids :: StoredGrid -> [Grid Bool]
156 fGrids stG = map unGrid $ iterate (step basicRule) stG
158 fGridCache :: [Grid Bool] -> [S.Set (Grid Bool)]
159 fGridCache gs = scanl' (flip S.insert) S.empty gs
160 -- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
163 bioDiversity :: (Grid Bool) -> Integer
164 bioDiversity (Grid _ g) = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
165 where bugs = [ M.findWithDefault False (Ongrid r c) g