-- | breadth first search
--
bfs :: Vertex -> Graph k a -> [Vertex]
bfs x = go [x] (Q.Queue [x][])
where go vs (Q.Queue [] []) _ = vs
go vs q g = go vs' q' g
where (vs', q') = runState (bfsSearchChildren siftChildren vs g) q
-- | breadth first search helper
--
bfsSearchChildren :: ([Vertex] -> [Vertex] -> State (Q.Queue Vertex) [Vertex])
-> [Vertex]
-> Graph k a
-> State (Q.Queue Vertex) [Vertex]
bfsSearchChildren f vs g = state Q.deq >>= \x -> case x of
Just y -> f (adjToList y g) vs
Nothing -> return []
-- | Returns a new list of visited nodes, while having enqueued all
-- unvisited nodes.
--
siftChildren :: Eq a =>
[a] -- children
-> [a] -- visited nodes
-> State (Q.Queue a) [a] -- queue in state monad
siftChildren [] vs = return vs
siftChildren xs vs = do
let unvisited = xs L.\\ vs
mapM_ statefulEnq unvisited
return $ vs `L.union` unvisited
where statefulEnq x = void $ state (\q -> ((), Q.enq x q))