Add solution to day 5.

2024/haskell/app/day5/Day5.hs

@@ -0,0 +1,74 @@
+module Main (main) where
+
+import Data.List (elemIndex)
+import Data.Maybe (fromJust)
+import Lib.Parser (Parser (parse), char, many1, number, separated)
+
+-- | Part 1
+newtype Rule = Rule (Int, Int) deriving (Show)
+
+newtype Update = Update [Int] deriving (Show)
+
+rule :: Parser Rule
+rule = (\a _ b -> Rule (a, b)) <$> number <*> char '|' <*> number
+
+update :: Parser Update
+update = Update <$> char ',' `separated` number
+
+safetyManual :: Parser ([Rule], [Update])
+safetyManual = filterParsed <$> many1 rule' <*> char '\n' <*> many1 update'
+  where
+    filterParsed :: [Rule] -> Char -> [Update] -> ([Rule], [Update])
+    filterParsed r _ u = (r, u)
+
+    rule' :: Parser Rule
+    rule' = const <$> rule <*> char '\n'
+
+    update' :: Parser Update
+    update' = const <$> update <*> char '\n'
+
+validateRule :: Update -> Rule -> Bool
+validateRule (Update u) (Rule (a, b)) = validateRule' $ (<) <$> elemIndex a u <*> elemIndex b u
+  where
+    validateRule' :: Maybe Bool -> Bool
+    validateRule' Nothing = True
+    validateRule' (Just result) = result
+
+validateRules :: [Rule] -> Update -> Bool
+validateRules rules upd = all (validateRule upd) rules
+
+middle :: Update -> Int
+middle (Update u) = u !! (length u `div` 2)
+
+validUpdates :: ([Rule], [Update]) -> [Update]
+validUpdates (r, u) = filter (validateRules r) u
+
+part1 :: String -> IO ()
+part1 s = print $ sum $ map middle $ validUpdates $ fst $ fromJust $ parse safetyManual s
+
+-- | Part 2
+invalidUpdates :: ([Rule], [Update]) -> [Update]
+invalidUpdates (r, u) = filter (not . validateRules r) u
+
+insertPage :: [Rule] -> Int -> Update -> Update
+insertPage rules page (Update pages) = insertPage' rules pages page 0
+  where
+    insertPage' :: [Rule] -> [Int] -> Int -> Int -> Update
+    insertPage' [] pages' page' minViable = let (ps,ps') = splitAt minViable pages' in Update $ ps ++ [page'] ++ ps'
+    insertPage' _ [] page' _ = Update [page']
+    insertPage' ((Rule (a, b)):rs) pages' page' minViable
+      | page' == b && a `elem` pages' = insertPage' rs pages' page' (max minViable (((+1) . fromJust . elemIndex a) pages'))
+      | otherwise = insertPage' rs pages page minViable
+
+fixUpdate :: [Rule] -> Update -> Update
+fixUpdate rules (Update pages) = foldr (insertPage rules) (Update []) pages
+
+part2 :: String -> IO ()
+part2 s =
+  let (rules, updates) = (fst . fromJust . parse safetyManual) s
+      invUpd = invalidUpdates (rules, updates)
+  in print $ sum $ map (middle . fixUpdate rules) invUpd
+
+-- | Main
+main :: IO ()
+main = readFile "resources/day5.txt" >>= part2

2024/haskell/haskell.cabal

@@ -94,6 +94,20 @@ executable day4
     , haskell
   default-language: Haskell2010
 
+executable day5
+  main-is: Day5.hs
+  other-modules:
+      Paths_haskell
+  autogen-modules:
+      Paths_haskell
+  hs-source-dirs:
+      app/day5
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , haskell
+  default-language: Haskell2010
+
 test-suite haskell-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs

2024/haskell/package.yaml

@@ -77,6 +77,16 @@ executables:
     dependencies:
     - haskell
 
+  day5:
+    main:                Day5.hs
+    source-dirs:         app/day5
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - haskell
+
 tests:
   haskell-test:
     main:                Spec.hs

2024/haskell/resources/day5_example.txt

@@ -0,0 +1,28 @@
+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
+
+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

2024/haskell/src/Lib/Parser.hs

@@ -13,12 +13,13 @@ module Lib.Parser
     surrounded,
     parens,
     separated,
+    whitespace,
   )
 where
 
 import Control.Applicative (Alternative (..))
 import Control.Monad (void)
-import Data.Char (isDigit)
+import Data.Char (isDigit, isSpace)
 
 newtype Parser a = Parser
   { parse :: String -> Maybe (a, String)
@@ -63,6 +64,9 @@ satisfy predicate = Parser $ \case
     | predicate x -> Just (x, xs)
     | otherwise -> Nothing
 
+whitespace :: Parser Char
+whitespace = satisfy isSpace
+
 char :: Char -> Parser Char
 char c = satisfy (== c)