Done day 4

[advent-of-code-23.git] / advent04 / Main.hs

diff --git a/advent04/Main.hs b/advent04/Main.hs
new file mode 100644 (file)
index 0000000..0d8b773
--- /dev/null
+++ b/advent04/Main.hs
@@ -0,0 +1,75 @@
+-- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Data.List
+
+data Card = Card { cardID :: Int
+                 , winners :: [Int]
+                 , actuals :: [Int]
+                 } deriving (Eq, Show)
+
+data QueuedCard = QueuedCard { numMatches :: Int
+                             , queuedQuantity :: Int
+                             } deriving (Eq, Show)
+type Queue = [QueuedCard]
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let cards = successfulParse text
+      -- print cards
+      print $ part1 cards
+      print $ part2 cards
+
+
+part1, part2 :: [Card] -> Int
+part1 = sum . fmap score
+
+part2  = winCards 0 . mkQueue
+
+score :: Card -> Int
+score Card{..}
+  | matches == 0 = 0
+  | otherwise = 2 ^ (matches - 1)
+  where matches = length $ intersect winners actuals
+
+mkQueue :: [Card] -> Queue
+mkQueue = fmap enqueue
+  where enqueue Card{..} = QueuedCard (length $ intersect winners actuals) 1
+
+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)
+
+winCards :: Int -> Queue -> Int
+winCards n [] = n
+winCards n (QueuedCard{..}:queue) = winCards n' queue'
+  where n' = n + queuedQuantity
+        queue' = duplicateCards numMatches queuedQuantity queue
+  
+
+-- Parse the input file
+
+cardsP :: Parser [Card]
+cardP :: Parser Card
+numbersP :: Parser [Int]
+
+cardsP = cardP `sepBy` endOfLine
+cardP = Card <$> (("Card" *> skipSpace *> decimal) <* ":" <* skipSpace) 
+             <*> (numbersP <* " |" <* skipSpace) 
+             <*> numbersP
+
+numbersP = decimal `sepBy` skipSpace
+
+successfulParse :: Text -> [Card]
+successfulParse input = 
+  case parseOnly cardsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right matches -> matches