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_` ((== targetRound) <$> readSTRef round)
  31 --        return ()
  32
  33 -- gameLoop targetRound round word history =
  34 --     do ( gameStep round word history
  35 --          `untilM_` (do r <- readSTRef round
  36 --                        return $ r == targetRound)
  37 --         )
  38 --        return ()
  39
  40 -- gameLoop targetRound round word history =
  41 --     do untilM_ (gameStep round word history )
  42 --                (do r <- readSTRef round
  43 --                    return $ r == targetRound )
  44 --        return ()
  45
  46 -- gameLoop targetRound round word history =
  47 --     do whileM_ (do r <- readSTRef round
  48 --                    return $ r /= targetRound )
  49 --                (gameStep round word history )
  50 --        return ()
  51
  52 -- gameLoop targetRound round word history =
  53 --     do whileM_ (do r <- readSTRef round
  54 --                    return $ r /= targetRound )
  55 --                $ gameStep round word history
  56 --        return ()
  57
  58 gameLoop targetRound round word history =
  59     do whileM_ ((/= targetRound) <$> readSTRef round)
  60                $ gameStep round word history
  61        return ()
  62
  63 seedGame seed historySize =
  64   do round <- newSTRef $ length seed
  65      word <- newSTRef $ last seed
  66      history <- V.replicate historySize 0
  67      forM_ (zip (init seed) [1..]) $ \(t, s) -> V.write history t s
  68      return (round, word, history)
  69
  70 gameStep :: STRef s Int -> STRef s Int -> V.MVector s Int -> ST s ()
  71 gameStep round word history =
  72   do roundVal <- readSTRef round
  73      wordVal <- readSTRef word
  74      wordH <- V.read history wordVal
  75      let word' = speakWord wordH roundVal
  76      V.write history wordVal roundVal
  77      modifySTRef round (+1)
  78      writeSTRef word word'
  79      return ()
  80
  81 speakWord :: Int -> Int -> Int
  82 speakWord 0 _ = 0
  83 speakWord prev now = now - prev
  84
  85