Done day 15

diff --git a/advent15/package.yaml b/advent15/package.yaml
new file mode 100644 (file)
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: <https://github.com/sol/hpack>.
+
+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 (file)
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 (file)
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 9a0515dea21c3238bb06a1fddf67443f7d9beed6..007b43813ca09e0c3942a10b7770f58847d0af8b 100644 (file)
--- 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