From 418d5771f9b52ca7d813c1daebc91772a6e74a88 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Wed, 2 Dec 2020 17:19:23 +0000 Subject: [PATCH] Trying to get part 1 working with a Map, not a Matrix --- advent24/package.yaml | 24 ++++++ advent24/src/advent24.hs | 26 +++--- advent24/src/advent24map.hs | 168 ++++++++++++++++++++++++++++++++++++ advent24/src/advent24zip.hs | 164 +++++++++++++++++++++++++++++++++++ 4 files changed, 370 insertions(+), 12 deletions(-) create mode 100644 advent24/src/advent24map.hs create mode 100644 advent24/src/advent24zip.hs 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 -- 2.34.1