advent24/src/advent24zip.hs

   1 {-# language DeriveFunctor #-}
   2 {-# language TypeFamilies #-}
   3 {-# language InstanceSigs #-}
   4
   5
   6 -- import Debug.Trace
   7
   8
   9 import Data.Finite (Finite, modulo, getFinite)
  10 import GHC.TypeNats (KnownNat)
  11
  12
  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(..))
  22
  23 import Data.Maybe
  24 import Data.List
  25 import qualified Data.Set as S
  26 import qualified Data.Map as M
  27
  28 import Control.Concurrent (threadDelay)
  29 import Control.Monad (forM_)
  30
  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
  37
  38
  39 instance Ord Grid where
  40     m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
  41
  42
  43 type Coord = (Int, Int)
  44 type Grid = X.Matrix Bool
  45 type StoredGrid = Store X.Matrix Bool
  46 type Rule = StoredGrid -> Bool
  47
  48 type GridCache = S.Set Grid
  49
  50 -- mGet :: Coord -> Matrix a -> a
  51 -- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
  52 -- mGet rc mtx = mtx ! rc
  53
  54
  55 validCoord :: Coord -> Bool
  56 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
  57
  58
  59 instance Distributive X.Matrix where
  60   distribute = distributeRep
  61
  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
  66
  67 gridSize :: Int
  68 gridSize = 5
  69
  70
  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)]
  74
  75 addCoords :: Coord -> Coord -> Coord
  76 addCoords (x, y) (x', y') = (x + x', y + y')
  77
  78 basicRule :: Rule
  79 basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
  80   where
  81     alive = extract g
  82     neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
  83     numNeighboursAlive = length (filter id neighbours)
  84
  85 step :: Rule -> StoredGrid -> StoredGrid
  86 step = extend
  87
  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
  93
  94 mkGrid :: [Coord] -> StoredGrid
  95 mkGrid xs = store (`elem` xs) (1, 1)
  96
  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]]
 102
 103
 104 at :: [Coord] -> Coord -> [Coord]
 105 coords `at` origin = map (addCoords origin) coords
 106
 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)]
 111
 112
 113 tickTime :: Int
 114 tickTime = 200000
 115
 116 start :: IO StoredGrid
 117 start = do coords <- readGrid
 118            return $ mkGrid coords
 119   --    glider `at` (1, 1)
 120   -- ++ beacon `at` (15, 5)
 121
 122 main :: IO ()
 123 main =
 124     do sG <- start
 125        print $ part1 sG
 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
 131
 132
 133 readGrid =
 134     do  gs <- readFile "data/advent24.txt"
 135         let grid = lines gs
 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]
 139
 140
 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
 147     where
 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)
 153
 154 fGrids :: StoredGrid -> [Grid]
 155 fGrids stG = map unGrid $ iterate (step basicRule) stG
 156
 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
 160
 161
 162 bioDiversity :: Grid -> Integer
 163 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
 164     where bugs = X.toList g