advent24/src/advent24.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 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(..))
  16
  17 import Data.Maybe
  18 import Data.List
  19 import qualified Data.Set as S
  20
  21 import Control.Concurrent (threadDelay)
  22 import Control.Monad (forM_)
  23
  24
  25 instance Ord Grid where
  26     m1 `compare` m2 = (toList m1) `compare` (toList m2)
  27
  28
  29 type Coord = (Int, Int)
  30 type Grid = Matrix Bool
  31 type StoredGrid = Store Matrix Bool
  32 type Rule = StoredGrid -> Bool
  33
  34 type GridCache = S.Set Grid
  35
  36 -- mGet :: Coord -> Matrix a -> a
  37 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
  38 -- mGet rc mtx = mtx ! rc
  39
  40
  41 validCoord :: Coord -> Bool
  42 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
  43
  44
  45 instance Distributive Matrix where
  46   distribute = distributeRep
  47
  48 instance Representable Matrix where
  49   type Rep Matrix = Coord
  50   index m c = m ! c -- mGet c m
  51   tabulate = matrix gridSize gridSize
  52
  53 gridSize :: Int
  54 gridSize = 5
  55
  56
  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)]
  60
  61 addCoords :: Coord -> Coord -> Coord
  62 addCoords (x, y) (x', y') = (x + x', y + y')
  63
  64 basicRule :: Rule
  65 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
  66   where
  67     alive = extract g
  68     neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
  69     numNeighboursAlive = length (filter id neighbours)
  70
  71 step :: Rule -> StoredGrid -> StoredGrid
  72 step = extend
  73
  74 render :: StoredGrid -> String
  75 -- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
  76 render grid = prettyMatrix $ mapPos (\_ c -> bool "." "#" c) g
  77     where g = unGrid grid
  78
  79
  80 mkGrid :: [Coord] -> StoredGrid
  81 mkGrid xs = store (`elem` xs) (1, 1)
  82
  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]]
  88
  89
  90 at :: [Coord] -> Coord -> [Coord]
  91 coords `at` origin = map (addCoords origin) coords
  92
  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)]
  97
  98
  99 tickTime :: Int
 100 tickTime = 200000
 101
 102 start :: IO StoredGrid
 103 start = do coords <- readGrid
 104            return $ mkGrid coords
 105   --    glider `at` (1, 1)
 106   -- ++ beacon `at` (15, 5)
 107
 108 main :: IO ()
 109 main =
 110     do sG <- start
 111        print $ part1 sG
 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
 117
 118
 119 readGrid =
 120     do  gs <- readFile "data/advent24.txt"
 121         let grid = lines gs
 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]
 125
 126
 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
 133     where
 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)
 139
 140 fGrids :: StoredGrid -> [Grid]
 141 fGrids stG = map unGrid $ iterate (step basicRule) stG
 142
 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
 146
 147
 148 bioDiversity :: Grid -> Integer
 149 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
 150     where bugs = toList g