34cf1138bf1574b60b7bf5f2b3980dc2658361b8
[advent-of-code-20.git] / advent01.hs
1 -- import Debug.Trace
2
3
4 import Data.Finite (Finite, modulo, getFinite)
5 import GHC.TypeNats (KnownNat)
6
7
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(..))
17
18 import Data.Maybe
19 import Data.List
20 import qualified Data.Set as S
21 import qualified Data.Map as M
22
23 import Control.Concurrent (threadDelay)
24 import Control.Monad (forM_)
25
26
27 instance Ord Grid where
28 m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
29
30
31 type Coord = (Int, Int)
32 type Grid = X.Matrix Bool
33 type StoredGrid = Store X.Matrix Bool
34 type Rule = StoredGrid -> Bool
35
36 type GridCache = S.Set Grid
37
38 -- mGet :: Coord -> Matrix a -> a
39 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
40 -- mGet rc mtx = mtx ! rc
41
42
43 validCoord :: Coord -> Bool
44 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
45
46
47 instance Distributive X.Matrix where
48 distribute = distributeRep
49
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
54
55 gridSize :: Int
56 gridSize = 5
57
58
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)]
62
63 addCoords :: Coord -> Coord -> Coord
64 addCoords (x, y) (x', y') = (x + x', y + y')
65
66 basicRule :: Rule
67 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
68 where
69 alive = extract g
70 neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
71 numNeighboursAlive = length (filter id neighbours)
72
73 step :: Rule -> StoredGrid -> StoredGrid
74 step = extend
75
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
79 where g = unGrid grid
80
81
82 mkGrid :: [Coord] -> StoredGrid
83 mkGrid xs = store (`elem` xs) (1, 1)
84
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]]
90
91
92 at :: [Coord] -> Coord -> [Coord]
93 coords `at` origin = map (addCoords origin) coords
94
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)]
99
100
101 tickTime :: Int
102 tickTime = 200000
103
104 start :: IO StoredGrid
105 start = do coords <- readGrid
106 return $ mkGrid coords
107 -- glider `at` (1, 1)
108 -- ++ beacon `at` (15, 5)
109
110 main :: IO ()
111 main =
112 do sG <- start
113 print $ part1 sG
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
119
120
121 readGrid =
122 do gs <- readFile "data/advent24.txt"
123 let grid = lines gs
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]
127
128
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
135 where
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)
141
142 fGrids :: StoredGrid -> [Grid]
143 fGrids stG = map unGrid $ iterate (step basicRule) stG
144
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
148
149
150 bioDiversity :: Grid -> Integer
151 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
152 where bugs = X.toList g