advent01/src/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