96ec70b78d56345d9ca6180086ad9c4fc85a381e
[advent-of-code-20.git] / 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