From ec2b691e3bce2e0b6d7706f64812545baffeef47 Mon Sep 17 00:00:00 2001 From: RhiobeT Date: Tue, 19 Dec 2023 13:35:45 +0100 Subject: [PATCH] Day 19 --- advent-of-code-2023.cabal | 7 +++++ day19/Commons.hs | 63 +++++++++++++++++++++++++++++++++++++++ day19/Main.hs | 12 ++++++++ day19/Part1.hs | 21 +++++++++++++ day19/Part2.hs | 44 +++++++++++++++++++++++++++ 5 files changed, 147 insertions(+) create mode 100644 day19/Commons.hs create mode 100644 day19/Main.hs create mode 100644 day19/Part1.hs create mode 100644 day19/Part2.hs diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index 6273c04..8e78775 100644 --- a/advent-of-code-2023.cabal +++ b/advent-of-code-2023.cabal @@ -130,3 +130,10 @@ executable day18 build-depends: base ^>=4.15.1.0, containers, MissingH hs-source-dirs: day18 default-language: Haskell2010 + +executable day19 + main-is: Main.hs + other-modules: Commons Part1 Part2 + build-depends: base ^>=4.15.1.0, containers, MissingH + hs-source-dirs: day19 + default-language: Haskell2010 diff --git a/day19/Commons.hs b/day19/Commons.hs new file mode 100644 index 0000000..8d076c6 --- /dev/null +++ b/day19/Commons.hs @@ -0,0 +1,63 @@ +module Commons where + +import Data.List.Utils (split) +import GHC.IO.Handle (isEOF) +import Data.Map (Map, assocs, member, (!), fromList, empty, insert) + + +data Part = Part { xr :: Int, mr :: Int, ar :: Int, sr :: Int } deriving (Eq, Show) +data Rule = Rule { apply :: Part -> Bool, destination :: String, r :: Char, v :: Int, s :: Char } +type Workflows = Map String [Rule] + + +parsePart :: String -> Part +parsePart line = let (x: m: a: s: _) = split "," line + in Part {xr = read $ tail $ tail x, mr = read $ tail $ tail m, ar = read $ tail $ tail a, + sr = read $ tail $ tail s} + +parseParts :: [Part] -> IO [Part] +parseParts otherParts = do done <- isEOF + if done then return otherParts + else do line <- getLine + let part = parsePart $ tail $ init line + parseParts $ otherParts ++ [part] + +parseRules :: [String] -> [Rule] +parseRules = map (\ rule -> if length rule < 2 || head (tail rule) /= '<' && head (tail rule) /= '>' + then Rule {apply = const True, destination = rule, r = '*', v = 0, s = '>'} + else let (condition: destination: _) = split ":" rule + (r: s: vRaw) = condition + v = read vRaw + in case (r, s) of + ('x', '>') -> Rule {apply = \ p -> xr p > v, destination = destination, + r = r, v = v, s = s} + ('m', '>') -> Rule {apply = \ p -> mr p > v, destination = destination, + r = r, v = v, s = s} + ('a', '>') -> Rule {apply = \ p -> ar p > v, destination = destination, + r = r, v = v, s = s} + ('s', '>') -> Rule {apply = \ p -> sr p > v, destination = destination, + r = r, v = v, s = s} + ('x', '<') -> Rule {apply = \ p -> xr p < v, destination = destination, + r = r, v = v, s = s} + ('m', '<') -> Rule {apply = \ p -> mr p < v, destination = destination, + r = r, v = v, s = s} + ('a', '<') -> Rule {apply = \ p -> ar p < v, destination = destination, + r = r, v = v, s = s} + ('s', '<') -> Rule {apply = \ p -> sr p < v, destination = destination, + r = r, v = v, s = s}) + +parseWorkflow :: String -> (String, [Rule]) +parseWorkflow line = let (name: rulesRaw: _) = split "{" line + in (name, parseRules $ split "," $ init rulesRaw) + +parseWorkflows :: Workflows -> IO Workflows +parseWorkflows otherWorkflows = do line <- getLine + if null line + then return otherWorkflows + else do let (name, rules) = parseWorkflow line + parseWorkflows $ insert name rules otherWorkflows + +parse :: IO (Workflows, [Part]) +parse = do workflows <- parseWorkflows empty + ratings <- parseParts [] + return (workflows, ratings) diff --git a/day19/Main.hs b/day19/Main.hs new file mode 100644 index 0000000..e991bce --- /dev/null +++ b/day19/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import Commons +import qualified Part1 +import qualified Part2 + + +main = do (workflows, parts) <- parse + let part1Res = Part1.getAcceptedSum workflows parts + print $ sum part1Res + let part2Res = Part2.getNCombinations workflows + print part2Res diff --git a/day19/Part1.hs b/day19/Part1.hs new file mode 100644 index 0000000..79bd0dd --- /dev/null +++ b/day19/Part1.hs @@ -0,0 +1,21 @@ +module Part1 where + +import Data.Map ((!)) +import Commons + + +applyRules :: [Rule] -> Part -> String +applyRules (h: t) p = if apply h p then destination h else applyRules t p + +applyWorkflow :: Workflows -> String -> Part -> Bool +applyWorkflow workflows wName part = let destination = applyRules (workflows ! wName) part + in case destination of + "A" -> True + "R" -> False + _ -> applyWorkflow workflows destination part + +getAccepted :: Workflows -> [Part] -> [Part] +getAccepted workflows = filter $ applyWorkflow workflows "in" + +getAcceptedSum :: Workflows -> [Part] -> [Int] +getAcceptedSum workflows = map (\ p -> xr p + mr p + ar p + sr p) . getAccepted workflows diff --git a/day19/Part2.hs b/day19/Part2.hs new file mode 100644 index 0000000..4f77206 --- /dev/null +++ b/day19/Part2.hs @@ -0,0 +1,44 @@ +module Part2 where + +import Data.Map ((!), Map, foldl, empty, filterWithKey, insert, member, fromList) +import Commons + + +type Intervals = Map Char (Int, Int) + +applyRule :: Rule -> Intervals -> (String, Intervals, Intervals) +applyRule rule i + | r rule == '*' = (destination rule, i, empty) + | member (r rule) i = let (start, end) = i ! r rule + in case s rule of + '>' -> if start > v rule + then (destination rule, i, empty) + else if end <= v rule + then (destination rule, empty, i) + else (destination rule, insert (r rule) (v rule + 1, end) i, + insert (r rule) (start, v rule) i) + '<' -> if end < v rule + then (destination rule, i, empty) + else if start >= v rule + then (destination rule, empty, i) + else (destination rule, insert (r rule) (start, v rule - 1) i, + insert (r rule) (v rule, end) i) + | otherwise = (destination rule, empty, i) + +applyRules :: [Rule] -> Intervals -> [(String, Intervals)] +applyRules [] _ = [] +applyRules (h: t) i = let (destination, accepted, left) = applyRule h i + in if destination == "R" then applyRules t left + else (destination, accepted): applyRules t left + +applyWorkflow :: Workflows -> [(String, Intervals)] -> Int +applyWorkflow _ [] = 0 +applyWorkflow workflows ((wName, i): t) | wName == "A" = Data.Map.foldl (\ a (start, end) -> a * (end - start + 1)) 1 i + + applyWorkflow workflows t + | otherwise = let afterRules = applyRules (workflows ! wName) i + in applyWorkflow workflows afterRules + + applyWorkflow workflows t + +getNCombinations :: Workflows -> Int +getNCombinations w = applyWorkflow w [("in", fromList [('x', (1, 4000)), ('m', (1, 4000)), ('a', (1, 4000)), + ('s', (1, 4000))])]