X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;ds=sidebyside;f=advent04%2FMain.hs;fp=advent04%2FMain.hs;h=0d8b7735b6ce7a0bd7978b77edd47b8d46314b94;hb=144c9843945d8af62fc35f96b5063283a52055d8;hp=0000000000000000000000000000000000000000;hpb=ce97c0bd06b07d7a562d88b7838199d33f442913;p=advent-of-code-23.git

diff --git a/advent04/Main.hs b/advent04/Main.hs
new file mode 100644
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