Now we're past the weekend, Monday's puzzle is back to the level I'd expect from the early days of Advent of Code. (Eric has said he schedules more involved puzzles on the weekend, as people have a bit more time then.)

Part 1 was essentially checking you can read the data. Part 2 required a moment to consider what's actually important in the puzzle.

Part 1

I defined a record to hold a card, following the description in the problem.

data Card = Card { cardID :: Int
                 , winners :: [Int]
                 , actuals :: [Int]
                 } deriving (Eq, Show)

Reading the data was simple enough parsing, except I had to fiddle around with varying numbers of spaces in different places. (This could be a time when Megaparsec would be better, with its default of silently consuming whitespace.) But apart from using skipSpace instead of space, it wasn't too bad and Attoparsec did well.

cardsP = cardP `sepBy` endOfLine
cardP = Card <$> (("Card" *> skipSpace *> decimal) <* ":" <* skipSpace) 
             <*> (numbersP <* " |" <* skipSpace) 
             <*> numbersP

numbersP = decimal `sepBy` skipSpace

After that, I define the score of a card, and the solution comes from applying that function to all the cards.

part1 :: [Card] -> Int
part1 = sum . fmap score

score :: Card -> Int
score Card{..}
  | matches == 0 = 0
  | otherwise = 2 ^ (matches - 1)
  where matches = length $ intersect winners actuals

Part 2

A little thought about part 2 led me to two conclusions.

  1. All I need to know about a card are how many matches it has, and how many copies of that card I currently have.
  2. If I process the cards in order, I will never revisit an earlier card.

That means I have a queue of cards, but they're simpler than what's parsed. When building the initial queue, I record I have one of each card to start with.

data QueuedCard = QueuedCard { numMatches :: Int
                             , queuedQuantity :: Int
                             } deriving (Eq, Show)
type Queue = [QueuedCard]

mkQueue :: [Card] -> Queue
mkQueue = fmap enqueue
  where enqueue Card{..} = QueuedCard (length $ intersect winners actuals) 1

When I process a card, I duplicate the next few cards; the number of extra cards depends on how many of this card I have.

duplicateCards :: Int -> Int -> Queue -> Queue
duplicateCards n scale queue = duplicatedPrefix ++ (drop n queue)
  where duplicatedPrefix = fmap go $ take n queue
        go (QueuedCard w q) = QueuedCard w (q + scale)

Working out all the winners is easiest done by explicit recursion, as the queue keeps changing as cards are added to it. I keep a running total of the cards won so far.

part2 :: [Card] -> Int
part2  = winCards 0 . mkQueue

winCards :: Int -> Queue -> Int
winCards n [] = n
winCards n (QueuedCard{..}:queue) = winCards n' queue'
  where n' = n + queuedQuantity
        queue' = duplicateCards numMatches queuedQuantity queue

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.