advent15/src/advent15slow.hs

   1 -- import Debug.Trace
   2
   3 import Prelude hiding (round)
   4 import qualified Data.IntMap.Strict as M
   5
   6
   7 data Game = Game { round :: Int
   8                  , word :: Int
   9                  , history :: M.IntMap Int
  10                  } deriving (Show, Eq)
  11
  12 main :: IO ()
  13 main =
  14   do  let seed = [20, 0, 1, 11, 6, 3]
  15       -- print seed
  16       print $ part1 seed
  17       print $ part2 seed
  18
  19 part1 = word . (gameRound 2020) . seedGame
  20 -- part2 = word . (gameRound 30000000) . seedGame
  21 part2 g0 = (word gf, maximum $ M.keys $ history gf)
  22   where gf = (gameRound 30000000) $ seedGame g0
  23
  24
  25 seedGame seed = Game {..}
  26   where round = length seed
  27         word = last seed
  28         history = M.fromList $ zip (init seed) [1..]
  29
  30 infiniteGame g = iterate gameStep g
  31
  32 gameRound r game0 = head $ dropWhile notYet $ infiniteGame game0
  33   where notYet game = round game < r
  34
  35 gameStep Game{..} =
  36   Game { round = round + 1
  37        , word = word'
  38        , history = history'
  39        }
  40   where
  41     word' = speakWord (M.lookup word history) round
  42     history' = M.insert word round history
  43
  44 speakWord Nothing _ = 0
  45 speakWord (Just prev) now = now - prev
  46
  47