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