advent15/src/advent15slow.hs

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