advent15/src/advent15loop.hs

   1 -- import Debug.Trace
   2
   3 import Prelude hiding (round)
   4 import Control.Monad
   5 import Control.Monad.ST
   6 import Control.Monad.Loops
   7 import Data.STRef
   8 import qualified Data.Vector.Unboxed.Mutable as V
   9
  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
  19 part1 seed = runGame seed 2020
  20 part2 seed = runGame seed 30000000
  21
  22 runGame seed roundsNeeded =
  23   runST $
  24     do (round, word, history) <- seedGame seed roundsNeeded
  25        gameLoop roundsNeeded round word history
  26        readSTRef word
  27
  28 -- gameLoop targetRound round word history =
  29 --     do ( gameStep round word history
  30 --          `untilM_` (do r <- readSTRef round
  31 --                        return $ r == targetRound)
  32 --         )
  33 --        return ()
  34
  35 -- gameLoop targetRound round word history =
  36 --     do untilM_ (gameStep round word history )
  37 --                (do r <- readSTRef round
  38 --                    return $ r == targetRound )
  39 --        return ()
  40
  41 -- gameLoop targetRound round word history =
  42 --     do whileM_ (do r <- readSTRef round
  43 --                    return $ r /= targetRound )
  44 --                (gameStep round word history )
  45 --        return ()
  46
  47 gameLoop targetRound round word history =
  48     do whileM_ (do r <- readSTRef round
  49                    return $ r /= targetRound )
  50                $ gameStep round word history
  51        return ()
  52
  53 seedGame seed historySize =
  54   do round <- newSTRef $ length seed
  55      word <- newSTRef $ last seed
  56      history <- V.replicate historySize 0
  57      forM_ (zip (init seed) [1..]) $ \(t, s) -> V.write history t s
  58      return (round, word, history)
  59
  60 gameStep :: STRef s Int -> STRef s Int -> V.MVector s Int -> ST s ()
  61 gameStep round word history =
  62   do roundVal <- readSTRef round
  63      wordVal <- readSTRef word
  64      wordH <- V.read history wordVal
  65      let word' = speakWord wordH roundVal
  66      V.write history wordVal roundVal
  67      modifySTRef round (+1)
  68      writeSTRef word word'
  69      return ()
  70
  71 speakWord :: Int -> Int -> Int
  72 speakWord 0 _ = 0
  73 speakWord prev now = now - prev
  74
  75