X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent20%2FMain.hs;h=c3a9cf3e7bd858f19515eb52e0548dcafe03bbaa;hb=a7b02636b8045a73a4dff090c1b932cfa1afd9bd;hp=09db6a073172104132bdc5cfc78536727b48fccf;hpb=63689f27d5e79a4eee3c3d25d717f0fcd1608d93;p=advent-of-code-23.git

diff --git a/advent20/Main.hs b/advent20/Main.hs
index 09db6a0..c3a9cf3 100644
--- a/advent20/Main.hs
+++ b/advent20/Main.hs
@@ -9,7 +9,7 @@ import Data.Attoparsec.Text hiding (take)
 import Control.Applicative
 import Data.List
 import qualified Data.Map.Strict as M
-import Data.Map ((!))
+import Data.Map.Strict ((!))
 import qualified Data.Sequence as Q
 import Data.Sequence ((|>), (><), Seq( (:|>), (:<|) ) ) 
 import Control.Lens hiding (Level)
@@ -70,11 +70,10 @@ part2 network modules = foldl' lcm 1 cycleLengths
          (!! 10000) $ iterate (pressAndEvaluate network part2Extractor) (state0, [(0, [])])
         state0 = NetworkState modules Q.empty
         lxHighs = filter (not . null . snd) lxPulses
-        cycleLengths = fmap (fst . head) $ 
-                          fmap sort $ 
+        cycleLengths = fmap ((fst . head) . sort) $ 
                           groupBy ((==) `on` (_source . snd)) $ 
                           sortBy (compare `on` (\(_, p) -> p ^. source)) $ 
-                          fmap ((\(n, ps) -> (n, head ps))) lxHighs 
+                          fmap (\(n, ps) -> (n, head ps)) lxHighs 
 
 pressAndEvaluate :: Network -> (a -> [Pulse] -> a) -> (NetworkState, a) -> (NetworkState, a)
 pressAndEvaluate network resultExtractor (state0, result0) = (state1, result1)
@@ -85,7 +84,6 @@ 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
@@ -101,14 +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 pulses of
+        Q.Empty -> return ()
+        (p :<| ps) -> 
+          do modify (\s -> s & queue .~ ps)
+             handlePulse p
+             handlePulses
 
 handlePulse :: Pulse -> NetworkHandler ()
 handlePulse p@(Pulse _ _ destination) = 
@@ -122,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,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
@@ -164,7 +158,10 @@ 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
@@ -182,13 +179,13 @@ moduleP, broadcastP, flipFlopP, conjunctionP :: Parser (Module, Name)
 nameP :: Parser Name
 
 configLinesP = configLineP `sepBy` endOfLine
-configLineP = (,) <$> (moduleP <* " -> ") <*> (nameP `sepBy` ", ")
+configLineP = (,) <$> moduleP <* " -> " <*> nameP `sepBy` ", "
 
 moduleP = broadcastP <|> flipFlopP <|> conjunctionP
 
 broadcastP = (Broadcast, "broadcaster") <$ "broadcaster"
-flipFlopP = (FlipFlop False, ) <$> ("%" *> nameP)
-conjunctionP = (Conjunction M.empty, ) <$> ("&" *> nameP)
+flipFlopP = (FlipFlop False, ) <$ "%" <*> nameP
+conjunctionP = (Conjunction M.empty, ) <$ "&" <*> nameP
   
 -- namesP = nameP `sepBy` ", "
 nameP = many1 letter