advent22/src/advent22.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 -- import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Attoparsec.Text hiding (take)
   8 -- import Data.Attoparsec.Combinator
   9 import Control.Applicative
  10 -- import Control.Applicative.Combinators
  11
  12 import qualified Data.Set as S
  13 import qualified Data.Sequence as Q
  14 import Data.Sequence (Seq (Empty, (:<|), (:|>)), (<|), (|>))
  15
  16 type Deck = Q.Seq Int
  17 type Game = (Deck, Deck)
  18
  19 data Player = P1 | P2 deriving (Show, Eq)
  20
  21
  22 main :: IO ()
  23 main =
  24   do  text <- TIO.readFile "data/advent22.txt"
  25       let decks = successfulParse text
  26       print decks
  27       print $ play decks
  28       print $ part1 decks
  29       print $ part2 decks
  30
  31 part1 decks = score $ winningDeck $ play decks
  32 part2 decks = score $ snd $ playRecursive decks S.empty
  33
  34 play = until finished playRound
  35
  36 finished :: Game -> Bool
  37 finished (Empty, _)     = True
  38 finished (_,     Empty) = True
  39 finished (_,     _)     = False
  40
  41 playRound :: Game -> Game
  42 playRound ((x :<| xs), (y :<| ys))
  43   | x < y     = (xs,           ys |> y |> x)
  44   | otherwise = (xs |> x |> y, ys)
  45
  46 winningDeck game = case (winner game) of
  47   P1 -> fst game
  48   P2 -> snd game
  49
  50 winner :: Game -> Player
  51 winner (Empty, ys) = P2
  52 winner (xs,    _)  = P1
  53
  54 score :: Deck -> Int
  55 score = Q.foldrWithIndex (\i c s -> s + (i + 1) * c) 0 . Q.reverse
  56
  57
  58 playRecursive :: Game -> (S.Set Game) -> (Player, Deck)
  59 playRecursive (Empty, ys) _ = (P2, ys)
  60 playRecursive (xs, Empty) _ = (P1, xs)
  61 playRecursive g@(x :<| xs, y :<| ys) seen
  62   | g `S.member` seen = (P1, x :<| xs)
  63   | (lengthAtLeast x xs) && (lengthAtLeast y ys) = playRecursive subG seen'
  64   | otherwise = playRecursive compareG seen'
  65   where seen' = S.insert g seen
  66         (subWinner, _) = playRecursive (Q.take x xs, Q.take y ys) seen'
  67         subG = updateDecks subWinner g
  68         compareWinner = if x < y then P2 else P1
  69         compareG = updateDecks compareWinner g
  70
  71
  72 updateDecks P1 (x :<| xs, y :<| ys) = (xs |> x |> y, ys)
  73 updateDecks P2 (x :<| xs, y :<| ys) = (xs, ys |> y |> x)
  74
  75 lengthAtLeast n s = Q.length s >= n
  76
  77
  78
  79
  80 -- Parse the input file
  81
  82 decksP = (,) <$> deckP <* (many endOfLine) <*> deckP
  83
  84 headerP = string "Player " *> decimal *> ":" *> endOfLine
  85
  86 deckP = Q.fromList <$> (headerP *> (decimal `sepBy` endOfLine))
  87
  88 successfulParse :: Text -> Game
  89 successfulParse input =
  90   case parseOnly decksP input of
  91     Left  _err -> (Q.empty, Q.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
  92     Right decks -> decks