1 {-# language DeriveFunctor #-}
2 {-# language TypeFamilies #-}
3 {-# language InstanceSigs #-}
9 import Data.Finite (Finite, modulo, getFinite)
10 import GHC.TypeNats (KnownNat)
13 -- import Data.Functor.Compose (Compose(..))
14 -- import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
15 import qualified Data.Matrix as X
16 import Data.Bool (bool)
17 import Data.Distributive (Distributive(..))
18 import Data.Functor.Rep (Representable(..), distributeRep)
19 import Data.Functor.Identity (Identity(..))
20 import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
21 import Control.Comonad (Comonad(..))
25 import qualified Data.Set as S
26 import qualified Data.Map as M
28 import Control.Concurrent (threadDelay)
29 import Control.Monad (forM_)
31 import Control.Comonad
32 import Control.Comonad.Cofree
33 import Data.Distributive
34 import Data.Functor.Rep
35 import qualified Data.Sequence as S
36 import qualified Data.List.NonEmpty as NE
39 instance Ord Grid where
40 m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
43 type Coord = (Int, Int)
44 type Grid = X.Matrix Bool
45 type StoredGrid = Store X.Matrix Bool
46 type Rule = StoredGrid -> Bool
48 type GridCache = S.Set Grid
50 -- mGet :: Coord -> Matrix a -> a
51 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
52 -- mGet rc mtx = mtx ! rc
55 validCoord :: Coord -> Bool
56 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
59 instance Distributive X.Matrix where
60 distribute = distributeRep
62 instance Representable X.Matrix where
63 type Rep X.Matrix = Coord
64 index m c = (X.!) m c -- mGet c m
65 tabulate = X.matrix gridSize gridSize
71 neighbourCoords :: [Coord]
72 -- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
73 neighbourCoords = [(-1, 0), (1, 0), (0, -1), (0, 1)]
75 addCoords :: Coord -> Coord -> Coord
76 addCoords (x, y) (x', y') = (x + x', y + y')
79 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
82 neighbours = experiment ((filter validCoord) . (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
94 mkGrid :: [Coord] -> StoredGrid
95 mkGrid xs = store (`elem` xs) (1, 1)
97 unGrid :: StoredGrid -> Grid
98 -- unGrid (StoreT (Identity g) _) = g
99 unGrid grid = X.fromList gridSize gridSize gridList
100 where (sgf, _sgl) = runStore grid
101 gridList = [sgf (r, c) | r <- [1..gridSize], c <- [1..gridSize]]
104 at :: [Coord] -> Coord -> [Coord]
105 coords `at` origin = map (addCoords origin) coords
107 -- glider, blinker, beacon :: [Coord]
108 -- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
109 -- blinker = [(0, 0), (1, 0), (2, 0)]
110 -- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
116 start :: IO StoredGrid
117 start = do coords <- readGrid
118 return $ mkGrid coords
119 -- glider `at` (1, 1)
120 -- ++ beacon `at` (15, 5)
126 -- let grids = map unGrid $ iterate (step basicRule) sG
127 -- forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
128 -- -- putStr "\ESC[2J" -- Clear terminal screen
129 -- putStrLn (render grid)
130 -- -- threadDelay tickTime
134 do gs <- readFile "data/advent24.txt"
136 let isBug r c = (grid!!r)!!c == '#'
137 let ng = gridSize - 1
138 return [(r + 1, c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
141 -- part1 :: Grid -> [Grid]
142 part1 :: StoredGrid -> Integer
143 -- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
144 -- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
145 -- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
146 part1 startingGrid = bioDiversity firstRepeat
148 -- grids = map unGrid $ iterate (step basicRule) startingGrid
149 -- gridCache = scanl' (flip . S.insert) S.empty grids
150 grids = fGrids startingGrid
151 gridCache = fGridCache grids
152 firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
154 fGrids :: StoredGrid -> [Grid]
155 fGrids stG = map unGrid $ iterate (step basicRule) stG
157 fGridCache :: [Grid] -> [S.Set Grid]
158 fGridCache gs = scanl' (flip S.insert) S.empty gs
159 -- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
162 bioDiversity :: Grid -> Integer
163 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
164 where bugs = X.toList g