X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent20%2FMain.hs;h=931c8673e922a0983a992ea81d91167d0bb3605b;hb=0dec9f0cb17b388b5871761b64bf9d9a8f61f478;hp=09db6a073172104132bdc5cfc78536727b48fccf;hpb=63689f27d5e79a4eee3c3d25d717f0fcd1608d93;p=advent-of-code-23.git diff --git a/advent20/Main.hs b/advent20/Main.hs index 09db6a0..931c867 100644 --- a/advent20/Main.hs +++ b/advent20/Main.hs @@ -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