X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent20%2FMain.hs;h=931c8673e922a0983a992ea81d91167d0bb3605b;hb=0dec9f0cb17b388b5871761b64bf9d9a8f61f478;hp=5f772783b30bfd8d40624a8685a99aab146e571a;hpb=ab15eef15936a685030126a725088371eb475c60;p=advent-of-code-23.git

diff --git a/advent20/Main.hs b/advent20/Main.hs
index 5f77278..931c867 100644
--- a/advent20/Main.hs
+++ b/advent20/Main.hs
@@ -1,4 +1,4 @@
--- Writeup at https://work.njae.me.uk/2022/12/14/advent-of-code-2022-day-11/
+-- Writeup at https://work.njae.me.uk/2023/12/25/advent-of-code-2023-day-20/
 
 import Debug.Trace
 
@@ -12,12 +12,12 @@ import qualified Data.Map.Strict as M
 import Data.Map ((!))
 import qualified Data.Sequence as Q
 import Data.Sequence ((|>), (><), Seq( (:|>), (:<|) ) ) 
--- import Data.Sequence ((|>), (><)) 
 import Control.Lens hiding (Level)
 import Control.Monad.State.Strict
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.RWS.Strict
+import Data.Function (on)
 
 type Name = String
 
@@ -54,46 +54,41 @@ main =
       text <- TIO.readFile dataFileName
       let config = successfulParse text
       let (network, modules) = assembleNetwork config
-      -- print config
-      -- print $ assembleNetwork config
-      -- let pulse0 = Q.singleton $ Pulse "button" Low "broadcaster"
-      -- let (state1, out1) = 
-      --         execRWS handlePulses
-      --           network 
-      --           (NetworkState modules pulse0)
-      -- print (out1, state1)
-      -- let (state2, out2) = 
-      --         execRWS handlePulses
-      --           network 
-      --           (state1 & queue .~ pulse0)
-      -- print (out2, state2)
-      -- let (state3, out3) = 
-      --         execRWS handlePulses
-      --           network 
-      --           (state2 & queue .~ pulse0)
-      -- print (out3, state3)
-      -- let (state4, out4) = 
-      --         execRWS handlePulses
-      --           network 
-      --           (state3 & queue .~ pulse0)
-      -- print (out4, state4)
       print $ part1 network modules
-      putStrLn $ showDot network
+      print $ part2 network modules
 
 
 
 
-part1 :: Network -> Modules -> Int
-part1 network modules = highs * lows
-  where (highs, lows) = manyButtonPress 1000 (0, 0) network state0
+part1, part2 :: Network -> Modules -> Int
+part1 network modules = highs * lows 
+  where (_, (highs, lows)) = 
+         (!! 1000) $ iterate (pressAndEvaluate network part1Extractor) (state0, (0, 0))
         state0 = NetworkState modules Q.empty
-
-manyButtonPress :: Int -> (Int, Int) -> Network -> NetworkState -> (Int, Int)
-manyButtonPress 0 (highs, lows) _ _ = (highs, lows)
-manyButtonPress n (highs, lows) network state = 
-  manyButtonPress (n - 1) (highs + length hs, lows + length ls) network state'
-  where (state', pulses) = buttonPress network state
-        (hs, ls) = partition ((== High) . _level) pulses
+part2 network modules = foldl' lcm 1 cycleLengths
+  where (_, lxPulses) = 
+         (!! 10000) $ iterate (pressAndEvaluate network part2Extractor) (state0, [(0, [])])
+        state0 = NetworkState modules Q.empty
+        lxHighs = filter (not . null . snd) lxPulses
+        cycleLengths = fmap ((fst . head) . sort) $ 
+                          groupBy ((==) `on` (_source . snd)) $ 
+                          sortBy (compare `on` (\(_, p) -> p ^. source)) $ 
+                          fmap (\(n, ps) -> (n, head ps)) lxHighs 
+
+pressAndEvaluate :: Network -> (a -> [Pulse] -> a) -> (NetworkState, a) -> (NetworkState, a)
+pressAndEvaluate network resultExtractor (state0, result0) = (state1, result1)
+  where (state1, pulses) = buttonPress network state0
+        result1 = resultExtractor result0 pulses
+
+part1Extractor :: (Int, Int) -> [Pulse] -> (Int, Int)
+part1Extractor (highs, lows) pulses = (highs + length hs, lows + length ls)
+  where (hs, ls) = partition ((== High) . _level) pulses
+
+part2Extractor :: [(Int, [Pulse])] -> [Pulse] -> [(Int, [Pulse])]
+part2Extractor allRs@((i, _):rs) pulses = (i + 1, lxPulses) : allRs
+  where lxPulses = filter catchLx pulses
+        catchLx (Pulse _ High "lx") = True
+        catchLx _ = False
 
 buttonPress :: Network -> NetworkState -> (NetworkState, [Pulse])
 buttonPress network state = 
@@ -104,19 +99,12 @@ buttonPress network state =
 handlePulses :: NetworkHandler ()
 handlePulses = 
   do  pulses <- gets _queue
-      if Q.null pulses
-        then return ()
-        else 
-          do  let p :<| _ = pulses
-              handlePulse p
-              modify (\s -> s & queue %~ (Q.drop 1))
-              handlePulses
-      -- case Q.viewl pulses of
-      --   Q.EmptyL -> return ()
-      --   p :< _ -> 
-      --     do  modify (\s -> s & queue %~ (Q.drop 1))
-      --         handlePulse p
-      --         handlePulses
+      case pulses of
+        Q.Empty -> return ()
+        (p :<| ps) -> 
+          do modify (\s -> s & queue .~ ps)
+             handlePulse p
+             handlePulses
 
 handlePulse :: Pulse -> NetworkHandler ()
 handlePulse p@(Pulse _ _ destination) = 
@@ -130,8 +118,6 @@ handlePulse p@(Pulse _ _ destination) =
         Just level' -> 
           do let newPulses = fmap (Pulse destination level') outGoings
              modify (\s -> s & queue %~ (>< (Q.fromList newPulses)))
-            --  tell newPulses
-             return ()
 
 processPulse :: Pulse -> Module -> (Module, Maybe Level)
 -- processPulse p m | trace ((show p) ++ " " ++ (show m) ) False = undefined
@@ -145,7 +131,7 @@ processPulse (Pulse s l _) (Conjunction memory) =
         outLevel = if all (== High) $ M.elems memory' then Low else High
 processPulse _ Untyped = (Untyped, Nothing)
 
-
+-- Assemble the network
 
 assembleNetwork :: [((Module, Name), [Name])] -> (Network, Modules)
 assembleNetwork config = (network, modules)
@@ -153,14 +139,14 @@ assembleNetwork config = (network, modules)
         modules1 = M.union (mkModules config) modules0
         modules = addConjunctionMemory network modules1
 
-mkModules :: [((Module, Name), [Name])] -> Modules
-mkModules = M.fromList . fmap (\((m, n), _) -> (n, m))
-
 mkNetwork :: [((Module, Name), [Name])] -> (Network, Modules)
 mkNetwork config = (net, mods) 
   where net = M.fromList $ fmap (\((_, n), ds) -> (n, ds)) config
         mods = M.fromList $ concatMap (\(_, ds) -> fmap (\d -> (d, Untyped)) ds) config
 
+mkModules :: [((Module, Name), [Name])] -> Modules
+mkModules = M.fromList . fmap (\((m, n), _) -> (n, m))
+
 addConjunctionMemory :: Network -> Modules -> Modules
 addConjunctionMemory network modules = 
   M.foldlWithKey addMemory modules network
@@ -172,17 +158,18 @@ addMemory modules source connections =
 addOneMemory :: Name -> Modules -> Name -> Modules
 addOneMemory source modules destination =
   case modules ! destination of
-    Conjunction memory -> M.insert destination (Conjunction $ M.insert source Low memory) modules
+    Conjunction memory -> 
+      M.insert destination 
+               (Conjunction $ M.insert source Low memory) 
+               modules
     _ -> modules
 
-
 showDot :: Network -> String
 showDot network = 
   "digraph {\n" ++ (concatMap showDotLine $ M.toList network) ++ "\n}"
   where showDotLine (source, destinations) = 
           concatMap (\d -> source ++ " -> " ++ d ++ ";\n") destinations
 
-
 -- Parse the input file
 
 configLinesP :: Parser [((Module, Name), [Name])]