diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index 8e78775..32143a7 100644 --- a/advent-of-code-2023.cabal +++ b/advent-of-code-2023.cabal @@ -137,3 +137,10 @@ executable day19 build-depends: base ^>=4.15.1.0, containers, MissingH hs-source-dirs: day19 default-language: Haskell2010 + +executable day20 + main-is: Main.hs + other-modules: Commons Part1 Part2 + build-depends: base ^>=4.15.1.0, containers, MissingH + hs-source-dirs: day20 + default-language: Haskell2010 diff --git a/day20/Commons.hs b/day20/Commons.hs new file mode 100644 index 0000000..8ae872c --- /dev/null +++ b/day20/Commons.hs @@ -0,0 +1,49 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Use tuple-section" #-} +module Commons where + +import Data.List.Utils (split) +import GHC.IO.Handle (isEOF) +import Data.Map (Map, assocs, member, (!), fromList, empty, insert, toList, notMember) + + +data Module = Broadcaster { outputs :: [String] } | + FlipFlop { state :: Bool, outputs :: [String] } | + Conjonction { inputs :: Map String Bool, outputs :: [String] } deriving (Show) +type Modules = Map String Module + + +parseModule :: String -> [String] -> (String, Module) +parseModule "broadcaster" outputs = ("broadcaster", Broadcaster {outputs = outputs}) +parseModule ('%': name) outputs = (name, FlipFlop {state = False, outputs = outputs}) +parseModule ('&': name) outputs = + (name, Conjonction {inputs = empty, outputs = outputs}) + +computeInputs'' :: String -> [String] -> Modules -> Modules +computeInputs'' _ [] modules = modules +computeInputs'' name (h: t) modules + | notMember h modules = computeInputs'' name t modules + | otherwise = + let output = modules ! h + in case output of + Conjonction i o -> computeInputs'' name t $ insert h Conjonction {inputs = insert name False i, outputs = o} + modules + _ -> computeInputs'' name t modules + +computeInputs' :: [(String, Module)] -> Modules -> Modules +computeInputs' [] modules = modules +computeInputs' ((name, m): t) modules = computeInputs' t $ computeInputs'' name (outputs m) modules + +computeInputs :: Modules -> Modules +computeInputs modules = computeInputs' (toList modules) modules + +parseModules :: [(String, Module)] -> IO Modules +parseModules otherModules = do done <- isEOF + if done then return $ computeInputs $ fromList otherModules + else do line <- getLine + let (rawName: rawOutputs: _) = split " -> " line + let cmodule = parseModule rawName $ split ", " rawOutputs + parseModules $ otherModules ++ [cmodule] + +parse :: IO Modules +parse = parseModules [] diff --git a/day20/Main.hs b/day20/Main.hs new file mode 100644 index 0000000..ddec449 --- /dev/null +++ b/day20/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import Commons +import qualified Part1 +import qualified Part2 + + +main = do modules <- parse + let (part1Low, part1High) = Part1.pressButtonNTimes modules 1000 + print (part1Low * part1High) + let part2Res = Part2.pressButtonUntilDone modules + print $ foldl lcm 1 part2Res diff --git a/day20/Part1.hs b/day20/Part1.hs new file mode 100644 index 0000000..7d9663d --- /dev/null +++ b/day20/Part1.hs @@ -0,0 +1,48 @@ +module Part1 where + +import Commons +import Data.Map (insert, foldr, (!), notMember) + + +applyModule :: Modules -> Int -> Int -> String -> Bool -> String -> (String, [String], Bool, Modules, Int, Int) +applyModule modules low high source p n + | notMember n modules = (n, [], True, modules, low, high) + | otherwise = + let m = modules ! n + in case m of + Broadcaster o -> (n, o, p, modules, if not p then low + length o else low, + if p then high + length o else high) + FlipFlop s o -> if not p then let newFF = FlipFlop {state = not s, outputs = o} + in (n, o, not s, insert n newFF modules, + if s then low + length o else low, + if not s then high + length o else high) + else (n, [], s, modules, low, high) + Conjonction i o -> let newC = Conjonction {inputs = insert source p i, outputs = o} + state = Data.Map.foldr (&&) True $ inputs newC + in if state then (n, o, False, insert n newC modules, low + length o, high) + else (n, o, True, insert n newC modules, low, high + length o) + +applyModules :: Modules -> Int -> Int -> String -> Bool -> [String] -> ([(String, [String], Bool)], Modules, Int, Int) +applyModules modules low high _ _ [] = ([], modules, low, high) +applyModules modules low high source p (h: t) = + let (newS, outputs, newP, newModules, newLow, newHigh) = applyModule modules low high source p h + (result, newNewModules, newNewLow, newNewHigh) = applyModules newModules newLow newHigh source p t + in ((newS, outputs, newP): result, newNewModules, newNewLow, newNewHigh) + +applySteps :: Modules -> Int -> Int -> [(String, [String], Bool)] -> (Modules, Int, Int) +applySteps modules low high [] = (modules, low, high) +applySteps modules low high ((source, names, pulse): t) = + let (result, newModules, newLow, newHigh) = applyModules modules low high source pulse names + in applySteps newModules newLow newHigh (t ++ result) + +pressButton :: Modules -> (Modules, Int, Int) +pressButton modules = applySteps modules 1 0 [("button", ["broadcaster"], False)] + +pressButtonNTimes' :: Modules -> Int -> Int -> Int -> Int -> (Int, Int) +pressButtonNTimes' modules low high i n + | i == n = (low, high) + | otherwise = let (newModules, newLow, newHigh) = pressButton modules + in pressButtonNTimes' newModules (low + newLow) (high + newHigh) (i + 1) n + +pressButtonNTimes :: Modules -> Int -> (Int, Int) +pressButtonNTimes modules = pressButtonNTimes' modules 0 0 0 diff --git a/day20/Part2.hs b/day20/Part2.hs new file mode 100644 index 0000000..f107f19 --- /dev/null +++ b/day20/Part2.hs @@ -0,0 +1,51 @@ +module Part2 where + +import Commons +import Data.Map (insert, foldr, (!), notMember, toList, keys) + + +applyModule :: Modules -> String -> String -> Bool -> String -> (String, [String], Bool, Modules, Bool) +applyModule modules final source p n + | notMember n modules = (n, [], True, modules, False) + | otherwise = + let m = modules ! n + partFinal = n == final && p + in case m of + Broadcaster o -> (n, o, p, modules, partFinal) + FlipFlop s o -> if not p then let newFF = FlipFlop {state = not s, outputs = o} + in (n, o, not s, insert n newFF modules, partFinal) + else (n, [], s, modules, partFinal) + Conjonction i o -> let newC = Conjonction {inputs = insert source p i, outputs = o} + state = Data.Map.foldr (&&) True $ inputs newC + in if state then (n, o, False, insert n newC modules, n == final) + else (n, o, True, insert n newC modules, partFinal) + +applyModules :: Modules -> String -> String -> Bool -> [String] -> ([(String, [String], Bool)], Modules, Bool) +applyModules modules _ _ _ [] = ([], modules, False) +applyModules modules final source p (h: t) = + let (newS, outputs, newP, newModules, done) = applyModule modules final source p h + (result, newNewModules, newDone) = applyModules newModules final source p t + in ((newS, outputs, newP): result, newNewModules, done || newDone) + +applySteps :: Modules -> String -> [(String, [String], Bool)] -> (Modules, Bool) +applySteps modules _ [] = (modules, False) +applySteps modules final ((source, names, pulse): t) = + let (result, newModules, done) = applyModules modules final source pulse names + (newNewModules, newDone) = applySteps newModules final (t ++ result) + in (newNewModules, done || newDone) + +pressButton :: Modules -> String -> (Modules, Bool) +pressButton modules final = applySteps modules final [("button", ["broadcaster"], False)] + +getFinalConjonction :: Modules -> String +getFinalConjonction = fst . head . filter (\ (_, v) -> "rx" `elem` outputs v) . toList + +pressButtonUntilDone' :: Modules -> String -> Int -> [Int] -> [Int] +pressButtonUntilDone' modules final i nPresses + | length nPresses == length (inputs (modules ! final)) = nPresses + | otherwise = + let (newModules, done) = pressButton modules final + in pressButtonUntilDone' newModules final (i + 1) (if done then (i + 1): nPresses else nPresses) + +pressButtonUntilDone :: Modules -> [Int] +pressButtonUntilDone modules = pressButtonUntilDone' modules (getFinalConjonction modules) 0 []