From: Neil Smith <neil.git@njae.me.uk>
Date: Wed, 2 Dec 2020 17:19:23 +0000 (+0000)
Subject: Trying to get part 1 working with a Map, not a Matrix
X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-19.git;a=commitdiff_plain;h=418d5771f9b52ca7d813c1daebc91772a6e74a88

Trying to get part 1 working with a Map, not a Matrix
---

diff --git a/advent24/package.yaml b/advent24/package.yaml
index 05eba4a..5f8e76f 100644
--- a/advent24/package.yaml
+++ b/advent24/package.yaml
@@ -64,6 +64,30 @@ executables:
     - adjunctions
     - distributive
 
+  advent24map:
+    main: advent24map.hs
+    source-dirs: src
+    dependencies:
+    - base >= 2 && < 6
+    - finite-typelits
+    - containers
+    - mtl
+    - comonad
+    - adjunctions
+    - distributive
+
+  # advent24zip:
+  #   main: advent24zip.hs
+  #   source-dirs: src
+  #   dependencies:
+  #   - base >= 2 && < 6
+  #   - finite-typelits
+  #   - containers
+  #   - mtl
+  #   - comonad
+  #   - adjunctions
+  #   - distributive
+
   advent24v:
     main: advent24v.hs
     source-dirs: src
diff --git a/advent24/src/advent24.hs b/advent24/src/advent24.hs
index e784cdc..34cf113 100644
--- a/advent24/src/advent24.hs
+++ b/advent24/src/advent24.hs
@@ -6,7 +6,8 @@ import GHC.TypeNats (KnownNat)
 
 
 -- import Data.Functor.Compose (Compose(..))
-import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
+-- import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
+import qualified Data.Matrix as X
 import Data.Bool (bool)
 import Data.Distributive (Distributive(..))
 import Data.Functor.Rep (Representable(..), distributeRep)
@@ -17,18 +18,19 @@ import Control.Comonad (Comonad(..))
 import Data.Maybe
 import Data.List
 import qualified Data.Set as S
+import qualified Data.Map as M
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (forM_)
 
 
 instance Ord Grid where
-    m1 `compare` m2 = (toList m1) `compare` (toList m2)
+    m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
 
 
 type Coord = (Int, Int)
-type Grid = Matrix Bool
-type StoredGrid = Store Matrix Bool
+type Grid = X.Matrix Bool
+type StoredGrid = Store X.Matrix Bool
 type Rule = StoredGrid -> Bool
 
 type GridCache = S.Set Grid
@@ -42,13 +44,13 @@ validCoord :: Coord -> Bool
 validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
 
 
-instance Distributive Matrix where
+instance Distributive X.Matrix where
   distribute = distributeRep
 
-instance Representable Matrix where
-  type Rep Matrix = Coord
-  index m c = m ! c -- mGet c m
-  tabulate = matrix gridSize gridSize
+instance Representable X.Matrix where
+  type Rep X.Matrix = Coord
+  index m c = (X.!) m c -- mGet c m
+  tabulate = X.matrix gridSize gridSize
 
 gridSize :: Int
 gridSize = 5
@@ -73,7 +75,7 @@ step = extend
 
 render :: StoredGrid -> String
 -- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
-render grid = prettyMatrix $ mapPos (\_ c -> bool "." "#" c) g
+render grid = X.prettyMatrix $ X.mapPos (\_ c -> bool "." "#" c) g
     where g = unGrid grid
 
 
@@ -82,7 +84,7 @@ mkGrid xs = store (`elem` xs) (1, 1)
 
 unGrid :: StoredGrid -> Grid
 -- unGrid (StoreT (Identity g) _) = g
-unGrid grid = fromList gridSize gridSize gridList
+unGrid grid = X.fromList gridSize gridSize gridList
     where (sgf, _sgl) = runStore grid
           gridList = [sgf (r, c) | r <- [1..gridSize], c <- [1..gridSize]]
 
@@ -147,4 +149,4 @@ fGridCache gs = scanl' (flip S.insert) S.empty gs
 
 bioDiversity :: Grid -> Integer
 bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
-    where bugs = toList g
+    where bugs = X.toList g
diff --git a/advent24/src/advent24map.hs b/advent24/src/advent24map.hs
new file mode 100644
index 0000000..596bdb2
--- /dev/null
+++ b/advent24/src/advent24map.hs
@@ -0,0 +1,168 @@
+-- import Debug.Trace
+
+
+import Data.Finite (Finite, modulo, getFinite)
+import GHC.TypeNats (KnownNat)
+
+
+-- import Data.Functor.Compose (Compose(..))
+-- import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
+-- import qualified Data.Matrix as X
+import Data.Bool (bool)
+import Data.Distributive (Distributive(..))
+import Data.Functor.Rep (Representable(..), distributeRep)
+import Data.Functor.Identity (Identity(..))
+import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
+import Control.Comonad (Comonad(..))
+
+import Data.Maybe
+import Data.List
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (forM_)
+
+
+data Coord = Ongrid Int Int | Offgrid deriving (Show, Eq, Ord)
+data Grid a = Grid a (M.Map Coord a) deriving (Show, Eq, Ord)
+type StoredGrid = Store Grid Bool 
+type Rule = StoredGrid -> Bool
+
+type GridCache = S.Set (Grid Bool)
+
+
+instance Functor Grid where
+  fmap f (Grid a m) = Grid (f a) (fmap f m)
+
+instance Distributive Grid where
+  distribute = distributeRep
+
+instance Representable Grid where
+  type Rep Grid = Coord
+  index (Grid a m) Offgrid = a
+  index (Grid a m) here = M.findWithDefault a here m
+  tabulate f = 
+    Grid (f Offgrid)
+      (M.union (M.singleton c (f c))
+                (M.unions (fmap (mapOfGrid . tabulate) 
+                               (fmap (f . ) (fmap addCoords neighbourCoords)))
+                               -- (fmap (f . addCoords . ) neighbourCoords))
+                )
+      )
+    where
+      c = (Ongrid 1 1)
+      mapOfGrid (Grid _ m) = m
+
+gridSize :: Int
+gridSize = 5
+
+-- validCoord :: Coord -> Bool
+-- validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
+
+boundCoord :: Coord -> Coord
+boundCoord Offgrid = Offgrid
+boundCoord (Ongrid r c)
+  | r >= 1 && r <= gridSize && c >= 1 && c <= gridSize = Ongrid r c
+  | otherwise = Offgrid
+
+neighbourCoords :: [Coord]
+-- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
+neighbourCoords = [(Ongrid -1 0), (Ongrid 1 0), (Ongrid 0 -1), (Ongrid 0 1)]
+
+addCoords :: Coord -> Coord -> Coord
+addCoords Offgrid _ = Offgrid
+addCoords _ Offgrid = Offgrid
+addCoords (Ongrid x y) (Ongrid x' y') = boundCoord $ Ongrid (x + x') (y + y')
+
+basicRule :: Rule
+basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
+  where
+    alive = extract g
+    neighbours = experiment ((map boundCoord) . (at neighbourCoords)) g
+    numNeighboursAlive = length (filter id neighbours)
+
+step :: Rule -> StoredGrid -> StoredGrid
+step = extend
+
+render :: StoredGrid -> String
+-- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
+-- render grid = X.prettyMatrix $ X.mapPos (\_ c -> bool "." "#" c) g
+--     where g = unGrid grid
+render grid = show $ unGrid grid
+
+
+mkGrid :: [Coord] -> StoredGrid
+mkGrid xs = store (`elem` xs) (Ongrid 1 1)
+
+unGrid :: StoredGrid -> Grid Bool
+-- unGrid (StoreT (Identity g) _) = g
+unGrid grid = Grid False $ M.fromList gridList
+    where (sgf, _sgl) = runStore grid
+          gridList = [((Ongrid r c), sgf (Ongrid r c)) | c <- [1..gridSize], r <- [1..gridSize]]
+
+
+at :: [Coord] -> Coord -> [Coord]
+coords `at` origin = map (addCoords origin) coords
+
+-- glider, blinker, beacon :: [Coord]
+-- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
+-- blinker = [(0, 0), (1, 0), (2, 0)]
+-- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
+
+
+tickTime :: Int
+tickTime = 200000
+
+start :: IO StoredGrid
+start = do coords <- readGrid
+           return $ mkGrid coords
+  --    glider `at` (1, 1)
+  -- ++ beacon `at` (15, 5)
+
+main :: IO ()
+main = 
+    do sG <- start
+       -- print $ part1 sG
+       let grids = map unGrid $ iterate (step basicRule) sG
+       forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
+            putStr "\ESC[2J" -- Clear terminal screen
+            putStrLn (render grid)
+            threadDelay tickTime
+
+
+readGrid = 
+    do  gs <- readFile "data/advent24.txt"
+        let grid = lines gs
+        let isBug r c = (grid!!r)!!c == '#'
+        let ng = gridSize - 1
+        return [Ongrid (r + 1) (c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
+
+
+-- part1 :: Grid -> [Grid]
+part1 :: StoredGrid -> Integer
+-- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
+-- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
+-- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
+part1 startingGrid = bioDiversity firstRepeat
+    where 
+          -- grids = map unGrid $ iterate (step basicRule) startingGrid
+          -- gridCache = scanl' (flip . S.insert) S.empty grids
+          grids = fGrids startingGrid
+          gridCache = fGridCache grids
+          firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
+
+fGrids :: StoredGrid -> [Grid Bool]
+fGrids stG = map unGrid $ iterate (step basicRule) stG
+
+fGridCache :: [Grid Bool] -> [S.Set (Grid Bool)]
+fGridCache gs = scanl' (flip S.insert) S.empty gs
+-- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
+
+
+bioDiversity :: (Grid Bool) -> Integer
+bioDiversity (Grid _ g) = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
+    where bugs = [ M.findWithDefault False (Ongrid r c) g 
+                 | c <- [1..gridSize]
+                 , r <- [1..gridSize] 
+                 ]
diff --git a/advent24/src/advent24zip.hs b/advent24/src/advent24zip.hs
new file mode 100644
index 0000000..36f272a
--- /dev/null
+++ b/advent24/src/advent24zip.hs
@@ -0,0 +1,164 @@
+{-# language DeriveFunctor #-}
+{-# language TypeFamilies #-}
+{-# language InstanceSigs #-}
+
+
+-- import Debug.Trace
+
+
+import Data.Finite (Finite, modulo, getFinite)
+import GHC.TypeNats (KnownNat)
+
+
+-- import Data.Functor.Compose (Compose(..))
+-- import Data.Matrix (Matrix, matrix, safeGet, (!), prettyMatrix, mapPos, fromList, toList)
+import qualified Data.Matrix as X
+import Data.Bool (bool)
+import Data.Distributive (Distributive(..))
+import Data.Functor.Rep (Representable(..), distributeRep)
+import Data.Functor.Identity (Identity(..))
+import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
+import Control.Comonad (Comonad(..))
+
+import Data.Maybe
+import Data.List
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (forM_)
+
+import Control.Comonad
+import Control.Comonad.Cofree
+import Data.Distributive
+import Data.Functor.Rep
+import qualified Data.Sequence as S
+import qualified Data.List.NonEmpty as NE
+
+
+instance Ord Grid where
+    m1 `compare` m2 = (X.toList m1) `compare` (X.toList m2)
+
+
+type Coord = (Int, Int)
+type Grid = X.Matrix Bool
+type StoredGrid = Store X.Matrix Bool
+type Rule = StoredGrid -> Bool
+
+type GridCache = S.Set Grid
+
+-- mGet :: Coord -> Matrix a -> a
+-- mGet (r, c) mtx = fromMaybe False $ safeGet r c mtx
+-- mGet rc mtx = mtx ! rc
+
+
+validCoord :: Coord -> Bool
+validCoord (r, c) = r >= 1 && r <= gridSize && c >= 1 && c <= gridSize
+
+
+instance Distributive X.Matrix where
+  distribute = distributeRep
+
+instance Representable X.Matrix where
+  type Rep X.Matrix = Coord
+  index m c = (X.!) m c -- mGet c m
+  tabulate = X.matrix gridSize gridSize
+
+gridSize :: Int
+gridSize = 5
+
+
+neighbourCoords :: [Coord]
+-- neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)]
+neighbourCoords = [(-1, 0), (1, 0), (0, -1), (0, 1)]
+
+addCoords :: Coord -> Coord -> Coord
+addCoords (x, y) (x', y') = (x + x', y + y')
+
+basicRule :: Rule
+basicRule g = (alive && numNeighboursAlive == 1) || ((not alive) && (numNeighboursAlive == 1 || numNeighboursAlive == 2))
+  where
+    alive = extract g
+    neighbours = experiment ((filter validCoord) . (at neighbourCoords)) g
+    numNeighboursAlive = length (filter id neighbours)
+
+step :: Rule -> StoredGrid -> StoredGrid
+step = extend
+
+render :: StoredGrid -> String
+-- render (StoreT (Identity g) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g
+render grid = X.prettyMatrix $ X.mapPos (\_ c -> bool "." "#" c) g
+    where g = unGrid grid
+
+
+mkGrid :: [Coord] -> StoredGrid
+mkGrid xs = store (`elem` xs) (1, 1)
+
+unGrid :: StoredGrid -> Grid
+-- unGrid (StoreT (Identity g) _) = g
+unGrid grid = X.fromList gridSize gridSize gridList
+    where (sgf, _sgl) = runStore grid
+          gridList = [sgf (r, c) | r <- [1..gridSize], c <- [1..gridSize]]
+
+
+at :: [Coord] -> Coord -> [Coord]
+coords `at` origin = map (addCoords origin) coords
+
+-- glider, blinker, beacon :: [Coord]
+-- glider = [(1, 0), (2, 1), (0, 2), (1, 2), (2, 2)]
+-- blinker = [(0, 0), (1, 0), (2, 0)]
+-- beacon = [(0, 0), (1, 0), (0, 1), (3, 2), (2, 3), (3, 3)]
+
+
+tickTime :: Int
+tickTime = 200000
+
+start :: IO StoredGrid
+start = do coords <- readGrid
+           return $ mkGrid coords
+  --    glider `at` (1, 1)
+  -- ++ beacon `at` (15, 5)
+
+main :: IO ()
+main = 
+    do sG <- start
+       print $ part1 sG
+       -- let grids = map unGrid $ iterate (step basicRule) sG
+       -- forM_ (take 5 $ iterate (step basicRule) sG) $ \grid -> do
+       --      -- putStr "\ESC[2J" -- Clear terminal screen
+       --      putStrLn (render grid)
+       --      -- threadDelay tickTime
+
+
+readGrid = 
+    do  gs <- readFile "data/advent24.txt"
+        let grid = lines gs
+        let isBug r c = (grid!!r)!!c == '#'
+        let ng = gridSize - 1
+        return [(r + 1, c + 1) | r <- [0..ng], c <- [0..ng], isBug r c]
+
+
+-- part1 :: Grid -> [Grid]
+part1 :: StoredGrid -> Integer
+-- part1 startingGrid = map fst $ takeWhile (uncurry . S.notMember) (zip grids gridCache)
+-- part1 startingGrid = map fst $ takeWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
+-- part1 startingGrid = fst $ head $ dropWhile (\(g, c) -> S.notMember g c) (zip grids gridCache)
+part1 startingGrid = bioDiversity firstRepeat
+    where 
+          -- grids = map unGrid $ iterate (step basicRule) startingGrid
+          -- gridCache = scanl' (flip . S.insert) S.empty grids
+          grids = fGrids startingGrid
+          gridCache = fGridCache grids
+          firstRepeat = fst $ head $ dropWhile (uncurry S.notMember) (zip grids gridCache)
+
+fGrids :: StoredGrid -> [Grid]
+fGrids stG = map unGrid $ iterate (step basicRule) stG
+
+fGridCache :: [Grid] -> [S.Set Grid]
+fGridCache gs = scanl' (flip S.insert) S.empty gs
+-- fGridCache gs = scanl' (\s g -> S.insert g s) S.empty gs
+
+
+bioDiversity :: Grid -> Integer
+bioDiversity g = sum $ map snd $ filter (id . fst) $ zip bugs $ iterate ( * 2) 1
+    where bugs = X.toList g