advent21/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2021/12/23/advent-of-code-2021-day-20/
   2
   3 import Data.Text ()
   4 import qualified Data.Text.IO as TIO
   5 import Data.Attoparsec.Text hiding (take, takeWhile, dropWhile)
   6 import Control.Applicative
   7
   8 -- import Control.Monad.State.Strict
   9 -- import Control.Monad.Reader
  10 -- import Control.Monad.Writer
  11 -- import Control.Monad.RWS.Strict
  12 -- import Control.Monad.Loops
  13
  14 import qualified Data.Map.Strict as M
  15 import Data.Map.Strict ((!))
  16
  17 data Player = Player1 | Player2 deriving (Eq, Ord, Show)
  18
  19 data PlayerState = PlayerState
  20   { position :: Int
  21   , score :: Int
  22   } deriving (Eq, Show)
  23
  24 data Game = Game
  25   { players :: M.Map Player PlayerState
  26   , current :: Player
  27   , rolls :: Int
  28   } deriving (Eq, Show)
  29
  30
  31 -- type GameState = State Game
  32
  33
  34 main :: IO ()
  35 main =
  36   do  text <- TIO.readFile "data/advent21.txt"
  37       let game = successfulParse text
  38       print game
  39       print $ gameStep game
  40       print $ take 8 $ iterate gameStep game
  41       print $ finished game
  42       print $ part1 game
  43       -- let (enhancement, image) = parse text
  44       -- print $ part1 enhancement image
  45       -- print $ part2 enhancement image
  46
  47 part1 game = scoreGame finalGame
  48   where finalGame = head $ dropWhile (not . finished) $ iterate gameStep game
  49
  50 finished game = any (>= 1000) $ map score $ M.elems (players game)
  51
  52 scoreGame game = (rolls game) * losingScore
  53   where losingScore = minimum $ map score $ M.elems (players game)
  54
  55
  56 gameStep :: Game -> Game
  57 gameStep game = game'
  58   where rs = rolls game + 1
  59         theseRolls = [n `mod1` 100 | n <- [rs..(rs + 2)]] :: [Int]
  60         activePlayer = (players game) ! (current game)
  61         pos = position activePlayer
  62         sc = score activePlayer
  63         pos' = (pos + (sum theseRolls)) `mod1` 10
  64         sc' = sc + pos'
  65         activePlayer' = PlayerState {position = pos', score = sc'}
  66         current' = nextPlayer (current game)
  67         players' = M.insert (current game) activePlayer' (players game)
  68         game' = Game { players = players'
  69                      , current = current'
  70                      , rolls = rolls game + 3
  71                      }
  72
  73
  74
  75
  76
  77 nextPlayer :: Player -> Player
  78 nextPlayer Player1 = Player2
  79 nextPlayer Player2 = Player1
  80
  81 mod1 :: Int -> Int -> Int
  82 mod1 a b = ((a - 1) `mod` b) + 1
  83
  84 -- Parsing
  85
  86 playerP = ("1" *> pure Player1) <|> ("2" *> pure Player2)
  87
  88 playerStateP = playerify <$> ("Player " *> playerP) <*> (" starting position: " *> decimal)
  89   where playerify name pos = (name, PlayerState {position = pos, score = 0})
  90
  91 gameP = gamify <$> playerStateP `sepBy` endOfLine
  92   where gamify ps = Game {rolls = 0, current = Player1, players = M.fromList ps}
  93
  94
  95 -- successfulParse :: Text -> (Integer, [Maybe Integer])
  96 successfulParse input =
  97   case parseOnly gameP input of
  98     Left  _err ->  Game {rolls=0, current=Player1, players=M.empty} -- TIO.putStr $ T.pack $ parseErrorPretty err
  99     Right game -> game
 100