From 4ecf3b3b78c6ae46bb41526085d69572ba1e9204 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Thu, 24 Dec 2020 10:08:08 +0000 Subject: [PATCH] Done day 15 --- advent15/package.yaml | 69 ++++++++++++++++++++++++++++++++++++ advent15/src/advent15.hs | 56 +++++++++++++++++++++++++++++ advent15/src/advent15slow.hs | 47 ++++++++++++++++++++++++ stack.yaml | 1 + 4 files changed, 173 insertions(+) create mode 100644 advent15/package.yaml create mode 100644 advent15/src/advent15.hs create mode 100644 advent15/src/advent15slow.hs diff --git a/advent15/package.yaml b/advent15/package.yaml new file mode 100644 index 0000000..cd2c591 --- /dev/null +++ b/advent15/package.yaml @@ -0,0 +1,69 @@ +# 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: advent15 +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 +- NamedFieldPuns +- NegativeLiterals +- NumDecimals +# - OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeFamilies +- TypeInType +- TypeOperators +- ViewPatterns + +executables: + advent15: + main: advent15.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - vector + + advent15slow: + main: advent15slow.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - containers + diff --git a/advent15/src/advent15.hs b/advent15/src/advent15.hs new file mode 100644 index 0000000..87cbf3d --- /dev/null +++ b/advent15/src/advent15.hs @@ -0,0 +1,56 @@ +-- import Debug.Trace + +import Prelude hiding (round) +import Control.Monad +import Control.Monad.ST +import Data.STRef +import qualified Data.Vector.Unboxed.Mutable as V + + +main :: IO () +main = + do let seed = [20, 0, 1, 11, 6, 3] + -- print seed + print $ part1 seed + print $ part2 seed + + +part1 seed = runGame seed 2020 +part2 seed = runGame seed 30000000 + +zeroInt :: Int +zeroInt = 0 + +seedGame seed historySize = + do round <- newSTRef $ length seed + word <- newSTRef $ last seed + history <- V.replicate historySize zeroInt + forM_ (zip (init seed) [1..]) $ \(t, s) -> V.write history t s + return (round, word, history) + +runGame seed roundsNeeded = + runST $ + do (round, word, history) <- seedGame seed roundsNeeded + gameStep roundsNeeded round word history + readSTRef word + +gameStep :: Int -> STRef s Int -> STRef s Int -> V.MVector s Int -> ST s () +gameStep targetRound round word history = + do roundVal <- readSTRef round + if roundVal == targetRound + then return () + else do + wordVal <- readSTRef word + wordH <- V.read history wordVal + let word' = speakWord wordH roundVal + V.write history wordVal roundVal + modifySTRef round (+1) + writeSTRef word word' + gameStep targetRound round word history + + +speakWord :: Int -> Int -> Int +speakWord 0 _ = 0 +speakWord prev now = now - prev + + diff --git a/advent15/src/advent15slow.hs b/advent15/src/advent15slow.hs new file mode 100644 index 0000000..508fedd --- /dev/null +++ b/advent15/src/advent15slow.hs @@ -0,0 +1,47 @@ +-- import Debug.Trace + +import Prelude hiding (round) +import qualified Data.IntMap.Strict as M + + +data Game = Game { round :: Int + , word :: Int + , history :: M.IntMap Int + } deriving (Show, Eq) + +main :: IO () +main = + do let seed = [20, 0, 1, 11, 6, 3] + -- print seed + print $ part1 seed + print $ part2 seed + +part1 = word . (gameRound 2020) . seedGame +-- part2 = word . (gameRound 30000000) . seedGame +part2 g0 = (word gf, maximum $ M.keys $ history gf) + where gf = (gameRound 30000000) $ seedGame g0 + + +seedGame seed = Game {..} + where round = length seed + word = last seed + history = M.fromList $ zip (init seed) [1..] + +infiniteGame g = iterate gameStep g + +gameRound r game0 = head $ dropWhile notYet $ infiniteGame game0 + where notYet game = round game < r + +gameStep Game{..} = + Game { round = round + 1 + , word = word' + , history = history' + } + where + word' = speakWord (M.lookup word history) round + history' = M.insert word round history + +speakWord Nothing _ = 0 +speakWord (Just prev) now = now - prev + + diff --git a/stack.yaml b/stack.yaml index 9a0515d..007b438 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,6 +49,7 @@ packages: - advent12 - advent13 - advent14 +- advent15 # Dependency packages to be pulled from upstream that are not in the resolver. # These entries can reference officially published versions as well as -- 2.34.1