(!! 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)
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
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) =
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
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
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