Day 20

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

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 []

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

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

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 []