Done day 24
[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.IntMap.Strict as M
14 import qualified Data.Sequence as Q
15 import Data.Sequence (Seq (Empty, (:<|), (:|>)), (<|), (|>))
16
17 import Data.Foldable (toList)
18 import Data.Hashable (hash)
19
20
21 type Deck = Q.Seq Int
22 type Game = (Deck, Deck)
23
24 data Player = P1 | P2 deriving (Show, Eq)
25
26 type Cache = M.IntMap (S.Set Game)
27
28
29 main :: IO ()
30 main =
31 do text <- TIO.readFile "data/advent22.txt"
32 let decks = successfulParse text
33 -- print decks
34 -- print $ play decks
35 print $ part1 decks
36 print $ part2 decks
37
38 part1 game = score $ winningDeck $ play game
39 part2 game = score $ snd $ playRecursive game M.empty
40
41 play = until finished playRound
42
43 finished :: Game -> Bool
44 finished (Empty, _) = True
45 finished (_, Empty) = True
46 finished (_, _) = False
47
48 playRound :: Game -> Game
49 playRound ((x :<| xs), (y :<| ys))
50 | x < y = (xs, ys |> y |> x)
51 | otherwise = (xs |> x |> y, ys)
52
53 winningDeck :: Game -> Deck
54 winningDeck (Empty, ys) = ys
55 winningDeck (xs, _) = xs
56
57 score :: Deck -> Int
58 score = sum . zipWith (*) [1..] . toList . Q.reverse
59
60 playRecursive :: Game -> Cache -> (Player, Deck)
61 playRecursive (Empty, ys) _ = (P2, ys)
62 playRecursive (xs, Empty) _ = (P1, xs)
63 playRecursive g@(x :<| xs, y :<| ys) seen
64 | g `inCache` seen = (P1, x :<| xs)
65 | (lengthAtLeast x xs) && (lengthAtLeast y ys) = playRecursive subG seen'
66 | otherwise = playRecursive compareG seen'
67 where seen' = enCache g seen
68 (subWinner, _) = playRecursive (Q.take x xs, Q.take y ys) seen'
69 subG = updateDecks subWinner g
70 compareTops = if x < y then P2 else P1
71 compareG = updateDecks compareTops g
72
73
74 updateDecks P1 (x :<| xs, y :<| ys) = (xs |> x |> y, ys)
75 updateDecks P2 (x :<| xs, y :<| ys) = (xs, ys |> y |> x)
76
77 lengthAtLeast n s = Q.length s >= n
78
79
80 hashGame (xs, ys) =
81 hash ( toList $ Q.take 2 xs
82 , toList $ Q.take 2 ys
83 -- , Q.length xs
84 -- , Q.length ys
85 )
86
87 inCache :: Game -> Cache -> Bool
88 inCache game cache = case (M.lookup h cache) of
89 Just games -> game `S.member` games
90 Nothing -> False
91 where h = hashGame game
92
93 enCache :: Game -> Cache -> Cache
94 enCache game cache = case (M.lookup h cache) of
95 Just games -> M.insert h (S.insert game games) cache
96 Nothing -> M.insert h (S.singleton game) cache
97 where h = hashGame game
98
99
100 -- Parse the input file
101
102 decksP = (,) <$> deckP <* (many endOfLine) <*> deckP
103
104 headerP = string "Player " *> decimal *> ":" *> endOfLine
105
106 deckP = Q.fromList <$> (headerP *> (decimal `sepBy` endOfLine))
107
108 successfulParse :: Text -> Game
109 successfulParse input =
110 case parseOnly decksP input of
111 Left _err -> (Q.empty, Q.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
112 Right decks -> decks