Updated link to blog post
[advent-of-code-23.git] / advent04 / Main.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/
2
3 import AoC
4 import Data.Text (Text)
5 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text hiding (take)
7 -- import Control.Applicative
8 import Data.List
9
10 data Card = Card { cardID :: Int
11 , winners :: [Int]
12 , actuals :: [Int]
13 } deriving (Eq, Show)
14
15 data QueuedCard = QueuedCard { numMatches :: Int
16 , queuedQuantity :: Int
17 } deriving (Eq, Show)
18 type Queue = [QueuedCard]
19
20
21 main :: IO ()
22 main =
23 do dataFileName <- getDataFileName
24 text <- TIO.readFile dataFileName
25 let cards = successfulParse text
26 -- print cards
27 print $ part1 cards
28 print $ part2 cards
29
30
31 part1, part2 :: [Card] -> Int
32 part1 = sum . fmap score
33
34 part2 = winCards 0 . mkQueue
35
36 score :: Card -> Int
37 score Card{..}
38 | matches == 0 = 0
39 | otherwise = 2 ^ (matches - 1)
40 where matches = length $ intersect winners actuals
41
42 mkQueue :: [Card] -> Queue
43 mkQueue = fmap enqueue
44 where enqueue Card{..} = QueuedCard (length $ intersect winners actuals) 1
45
46 duplicateCards :: Int -> Int -> Queue -> Queue
47 duplicateCards n scale queue = duplicatedPrefix ++ (drop n queue)
48 where duplicatedPrefix = fmap go $ take n queue
49 go (QueuedCard w q) = QueuedCard w (q + scale)
50
51 winCards :: Int -> Queue -> Int
52 winCards n [] = n
53 winCards n (QueuedCard{..}:queue) = winCards n' queue'
54 where n' = n + queuedQuantity
55 queue' = duplicateCards numMatches queuedQuantity queue
56
57
58 -- Parse the input file
59
60 cardsP :: Parser [Card]
61 cardP :: Parser Card
62 numbersP :: Parser [Int]
63
64 cardsP = cardP `sepBy` endOfLine
65 cardP = Card <$> (("Card" *> skipSpace *> decimal) <* ":" <* skipSpace)
66 <*> (numbersP <* " |" <* skipSpace)
67 <*> numbersP
68
69 numbersP = decimal `sepBy` skipSpace
70
71 successfulParse :: Text -> [Card]
72 successfulParse input =
73 case parseOnly cardsP input of
74 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
75 Right matches -> matches