2024 5

2024/day_5/Main.hs

@@ -0,0 +1,29 @@
+import Solution
+import Text.Parsec
+import Text.Parsec.String (Parser, parseFromFile)
+
+main :: IO ()
+main = do
+  rules_c <- parseFromFile (sepEndBy1 rule newline) ri 
+  updates_c <- filterEmpty <$> parseFromFile (sepEndBy1 updates newline) ui 
+  case (rules_c, updates_c) of
+    (Right rules_d, Right updates_d) -> print $ logic rules_d updates_d
+    (Left _, Left _) -> error $ "Invalid input formats in " ++ show ri ++ " and " ++ show ui
+    (Left _, _) -> error $ "Invalid input format in " ++ show ri
+    (_, Left _) -> error $ "Invalid input format in " ++ show ui
+  where ri = "rules.txt"; ui = "updates.txt"
+
+filterEmpty :: Either ParseError [[a]] -> Either ParseError [[a]]
+filterEmpty (Right cont) = Right $ filter (not . null) cont
+filterEmpty (Left err) = Left err
+
+-- parsing
+
+updates :: Parser [Integer]
+updates = sepBy digits (char ',')
+
+rule :: Parser (Integer, Integer)
+rule = (,) <$> digits <* char '|' <*> digits
+
+digits :: Parser Integer
+digits = read <$> many1 digit

2024/day_5/Solution.hs

@@ -0,0 +1,36 @@
+module Solution 
+  ( check
+  , middlePage
+  , logic
+  , checkAll
+  ) where
+
+import Data.List
+import qualified Data.Set as Set
+import Text.Parsec
+import Text.Parsec.String (Parser, parseFromFile)
+
+
+logic :: [(Integer, Integer)] -> [[Integer]] -> Integer 
+logic rules updates = sum $ map middlePage (checkAll rules updates)
+
+checkAll :: [(Integer, Integer)] -> [[Integer]] -> [[Integer]]
+checkAll rules = filter (\update -> all (\rule -> uncurry check rule update) rules) 
+
+check :: Integer -> Integer -> [Integer] -> Bool
+check _ _ [] = error "check: cannot check rules of empty list"
+check i j ks =
+  if length ks == Set.size (Set.fromList ks)
+  then case (elemIndex i ks, elemIndex j ks) of
+      (Just x, Just y) -> x < y
+      _ -> True
+  else error $ "check: requires different pages in " ++ show ks
+
+middlePage :: [Integer] -> Integer
+middlePage [] = error "middlePage: cannot find middle of empty list"
+middlePage ks 
+  | even l = error $ "middlePage: updates " ++ show ks ++ " has even length"
+  | otherwise = ks !! div l 2
+    where l = length ks
+
+

2024/day_5/advent-day5.cabal

@@ -0,0 +1,36 @@
+cabal-version: 2.4
+name: advent-day5
+version: 0.1.0.0
+
+library
+  exposed-modules: Solution
+  hs-source-dirs: .
+  build-depends: 
+    base,
+    parsec,
+    containers
+  default-language: Haskell2010
+
+executable solution
+  main-is: Main.hs
+  hs-source-dirs: .
+  other-modules: Solution
+  build-depends:
+    base,
+    advent-day5,
+    parsec,
+    containers
+  default-language: Haskell2010
+
+test-suite tests
+  type: exitcode-stdio-1.0
+  main-is: test.hs
+  hs-source-dirs: .
+  other-modules: Solution
+  build-depends:
+    base,
+    advent-day5,
+    QuickCheck,
+    parsec,
+    containers
+  default-language: Haskell2010

2024/day_5/rules.txt

@@ -0,0 +1,21 @@
+47|53
+97|13
+97|61
+97|47
+75|29
+61|13
+75|53
+29|13
+97|29
+53|29
+61|53
+97|53
+61|29
+47|13
+75|47
+97|75
+47|61
+75|61
+47|29
+75|13
+53|13

2024/day_5/test.hs

@@ -0,0 +1,13 @@
+import Test.QuickCheck
+import Solution (check, middlePage)
+import Data.List (nub)
+
+main :: IO ()
+main = do
+  quickCheck reverseCheck 
+
+reverseCheck :: Integer -> Integer -> [Integer] -> Property
+reverseCheck i j ks = 
+  let uniqueKs = nub ks
+  in length uniqueKs > 1 && i `elem` uniqueKs && j `elem` uniqueKs && i /= j ==> 
+     check i j uniqueKs /= check i j (reverse uniqueKs) 

2024/day_5/updates.txt

@@ -0,0 +1,6 @@
+75,47,61,53,29
+97,61,53,29,13
+75,29,13
+75,97,47,61,53
+61,13,29
+97,13,75,29,47