From 887e4c9e5607a078269338087bac136c0a143d28 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sat, 1 Feb 2020 15:09:21 +0000 Subject: [PATCH] Done part 1 --- advent24/package.yaml | 77 +++++++++++++++++++ advent24/src/advent24.hs | 150 ++++++++++++++++++++++++++++++++++++++ advent24/src/advent24v.hs | 78 ++++++++++++++++++++ data/advent24.txt | 5 ++ data/advent24a.txt | 5 ++ stack.yaml | 1 + 6 files changed, 316 insertions(+) create mode 100644 advent24/package.yaml create mode 100644 advent24/src/advent24.hs create mode 100644 advent24/src/advent24v.hs create mode 100644 data/advent24.txt create mode 100644 data/advent24a.txt diff --git a/advent24/package.yaml b/advent24/package.yaml new file mode 100644 index 0000000..05eba4a --- /dev/null +++ b/advent24/package.yaml @@ -0,0 +1,77 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent24 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +# - OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeFamilies +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent24: + main: advent24.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - finite-typelits + - containers + - mtl + - matrix + - comonad + - adjunctions + - distributive + + advent24v: + main: advent24v.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - finite-typelits + - mtl + - vector + - comonad + - adjunctions + - distributive \ No newline at end of file diff --git a/advent24/src/advent24.hs b/advent24/src/advent24.hs new file mode 100644 index 0000000..e784cdc --- /dev/null +++ b/advent24/src/advent24.hs @@ -0,0 +1,150 @@ +-- 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 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 Control.Concurrent (threadDelay) +import Control.Monad (forM_) + + +instance Ord Grid where + m1 `compare` m2 = (toList m1) `compare` (toList m2) + + +type Coord = (Int, Int) +type Grid = Matrix Bool +type StoredGrid = Store 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 Matrix where + distribute = distributeRep + +instance Representable Matrix where + type Rep Matrix = Coord + index m c = m ! c -- mGet c m + tabulate = 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 = prettyMatrix $ 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 = 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 = toList g diff --git a/advent24/src/advent24v.hs b/advent24/src/advent24v.hs new file mode 100644 index 0000000..7707dee --- /dev/null +++ b/advent24/src/advent24v.hs @@ -0,0 +1,78 @@ + + +import Control.Concurrent (threadDelay) + + +import Data.Functor.Compose (Compose(..)) +import Data.Vector (Vector, (!), generate) +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) +import Control.Comonad (Comonad(..)) +import Control.Monad (forM_) + +type Coord = (Int, Int) +type Grid = Store (Compose Vector Vector) Bool +type Rule = Grid -> Bool + +instance Distributive Vector where + distribute = distributeRep + +instance Representable Vector where + type Rep Vector = Int + index v i = v ! (i `mod` gridSize) + tabulate = generate gridSize + +gridSize :: Int +gridSize = 20 + +neighbourCoords :: [Coord] +neighbourCoords = [(x, y) | x <- [-1, 0, 1], y <- [-1, 0, 1], (x, y) /= (0, 0)] + +addCoords :: Coord -> Coord -> Coord +addCoords (x, y) (x', y') = (x + x', y + y') + +basicRule :: Rule +basicRule g = numNeighboursAlive == 3 || (alive && numNeighboursAlive == 2) + where + alive = extract g + neighbours = experiment (at neighbourCoords) g + numNeighboursAlive = length (filter id neighbours) + +step :: Rule -> Grid -> Grid +step = extend + +render :: Grid -> String +render (StoreT (Identity (Compose g)) _) = foldMap ((++ "\n") . foldMap (bool "." "#")) g + +mkGrid :: [Coord] -> Grid +mkGrid xs = store (`elem` xs) (0, 0) + +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 :: Grid +start = mkGrid $ + glider `at` (0, 0) + ++ beacon `at` (15, 5) + +main :: IO () +main = forM_ (iterate (step basicRule) start) $ \grid -> do + putStr "\ESC[2J" -- Clear terminal screen + putStrLn (render grid) + threadDelay tickTime \ No newline at end of file diff --git a/data/advent24.txt b/data/advent24.txt new file mode 100644 index 0000000..64a2f64 --- /dev/null +++ b/data/advent24.txt @@ -0,0 +1,5 @@ +...#. +#.##. +#..## +#.### +##... diff --git a/data/advent24a.txt b/data/advent24a.txt new file mode 100644 index 0000000..704a112 --- /dev/null +++ b/data/advent24a.txt @@ -0,0 +1,5 @@ +....# +#..#. +#..## +..#.. +#.... diff --git a/stack.yaml b/stack.yaml index afb8d2e..50f56d8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -61,6 +61,7 @@ packages: - advent21 - advent22 - advent23 +- advent24 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1