Done day 5

diff --git a/advent05/Main.hs b/advent05/Main.hs
new file mode 100644 (file)
index 0000000..1067c63
--- /dev/null
+++ b/advent05/Main.hs
@@ -0,0 +1,98 @@
+-- Writeup at https://work.njae.me.uk/2024/12/05/advent-of-code-2024-day-5/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text 
+-- import Control.Applicative
+import qualified Data.IntMap.Strict as M
+import Data.IntMap.Strict ((!))
+import qualified Data.Set as S
+-- import Data.List
+
+type Page = Int
+type Rules = M.IntMap (S.Set Page)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let (rulesPairs, books) = successfulParse text
+      let rules = mkRules rulesPairs
+      -- print rules
+      -- print books
+      -- print $ fmap (inValid rules) books
+      print $ part1 rules books
+      print $ part2 rules books
+
+
+part1, part2 :: Rules -> [[Page]] -> Int
+part1 rules books = sum $ fmap middlePage validBooks
+  where validBooks = filter (not . (invalid rules)) books
+
+part2 rules books = sum $ fmap middlePage reorderedBooks
+  where invalidBooks = filter (invalid rules) books
+        pageSets = fmap S.fromList invalidBooks
+        reorderedBooks = fmap (reorder rules []) pageSets
+
+middlePage :: [Page] -> Page
+middlePage b = b !! (length b `div` 2)
+
+invalid :: Rules -> [Page] -> Bool
+invalid rules book = fst $ foldr (pageInvalid rules) (False, S.empty) book
+
+pageInvalid :: Rules -> Page -> (Bool, S.Set Page) -> (Bool, S.Set Page)
+pageInvalid _rules _page (True, pages) = (True, pages)
+pageInvalid rules page (False, pages) 
+  | page `M.notMember` rules = (False, S.insert page pages)
+  | otherwise = (violates, S.insert page pages)
+  where preceders = rules ! page
+        violates = not $ S.null $ S.intersection preceders pages
+
+reorder :: Rules -> [Page] -> S.Set Page -> [Page]
+reorder rules printed unprinted 
+  | S.null unprinted = printed
+  | otherwise = reorder rules printed' rest
+  where candidates = printCandidates rules unprinted
+        next = S.findMin candidates
+        rest = S.delete next unprinted
+        printed' = printed ++ [next]
+
+printCandidates :: Rules -> S.Set Page -> S.Set Page
+printCandidates rules unprinted = 
+  S.filter (printable rules unprinted) unprinted
+
+printable :: Rules -> S.Set Page -> Page -> Bool
+printable rules unprinted page
+  | page `M.notMember` rules = True
+  | otherwise = S.null $ S.intersection preceders unprinted
+  where preceders = rules ! page
+
+
+mkRules :: [(Int, Int)] -> Rules
+mkRules = foldr go M.empty 
+  where go (a, b) m = M.insertWith S.union b (S.singleton a) m
+
+
+-- parse the input file
+
+rulesBooksP :: Parser ([(Page, Page)], [[Page]])
+rulesP :: Parser [(Page, Page)]
+ruleP :: Parser (Page, Page)
+booksP :: Parser [[Page]]
+bookP :: Parser [Page]
+
+rulesBooksP = (,) <$> rulesP <* endOfLine <* endOfLine <*> booksP
+
+rulesP = ruleP `sepBy` endOfLine
+ruleP = (,) <$> decimal <* "|" <*> decimal
+
+booksP = bookP `sepBy` endOfLine
+bookP = decimal `sepBy` ","
+
+successfulParse :: Text -> ([(Page, Page)], [[Page]])
+successfulParse input = 
+  case parseOnly rulesBooksP input of
+    Left  _err -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right rulesBooks -> rulesBooks
+

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 29d55f2c40c67fe7e28614bd897b87dd8e0a3852..b11f3070851bf9b35492b6231ba05c720e86f062 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -90,3 +90,8 @@ executable advent04
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent04/Main.hs  
   build-depends: array, linear
+
+executable advent05
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent05/Main.hs  
+  build-depends: attoparsec, text, containers