最近，我已经从Stackoverflow中的Graph中提出了构建DFS树的问题，并且已经了解到可以使用State Monad简单地实现它。
虽然DFS要求仅跟踪被访问节点，因此我们可以使用“Set”或“List”或某种线性数据结构来跟踪被访问节点，BFS要求“被访问节点”和“队列”数据结构为来完成的。
我的BFS伪代码是
Q = empty queue
T = empty Tree
mark all nodes except u as unvisited
while Q is nonempty do
u = deq(Q)
for each vertex v ∈ Adj(u)
if v is not visited
then add edge (u,v) to T
Mark v as visited and enq(v)
从伪代码可以推断，我们每次迭代只需要做3个进程。
- 队列中的队列
- 将该点的所有未访问邻居添加到当前树的子节点，队列和“已访问”列表
- 在队列
中重复此操作
由于我们没有使用递归遍历进行BFS搜索，我们需要一些其他的遍历方法，例如while循环。我在hackage中查找了loop-while包，但似乎有点弃用。
我假设我需要某种类似的代码：
{-...-}
... = evalState (bfs) ((Set.singleton start),[start])
where
neighbors x = Map.findWithDefault [] x adj
bfs =do (vis,x:queue)<-get
map (\neighbor ->
if (Set.member neighbor vis)
then put(vis,queue)
else put ((Set.insert neighbor vis), queue++[neighbor]) >> (addToTree neighbor)
) neighbors x
(vis,queue)<-get
while (length queue > 0)
我知道这个实现是非常错误的，但是这应该给出我认为BFS应该如何实现的简约观点。另外，我真的不知道如何规避使用while循环for do blocks。（即我应该使用递归算法来克服它，还是应该考虑完全不同的策略）
考虑到我在上面提到的上一个问题中找到的答案之一，似乎答案应该是这样的：
newtype Graph a = Graph (Map.Map a [a]) deriving (Ord, Eq, Show)
data Tree a = Tree a [Tree a] deriving (Ord, Eq, Show)
bfs :: (Ord a) => Graph a -> a -> Tree a
bfs (Graph adj) start = evalState (bfs') ((Set.singleton start),[start])
where
bfs' = {-part where I don't know-}
最后，如果由于某种原因（我相信不是），使用状态monad的BFS的这种实现是不可能的，请纠正我的错误假设。
我在没有使用状态monad的情况下看到了Haskell中BFS的一些示例，但我想了解更多关于如何处理状态monad并且无法找到任何使用状态monad实现BFS的示例。
提前致谢。
编辑： 我想出了一些使用状态monad的算法，但是我陷入了无限循环。
bfs :: (Ord a) => Graph a -> a -> Tree a
bfs (Graph adj) start = evalState (bfs' (Graph adj) start) (Set.singleton start)
bfs' :: (Ord a) => Graph a -> a -> State (Set.Set a) (Tree a)
bfs' (Graph adj) point= do
vis <- get
let neighbors x = Map.findWithDefault [] x adj
let addableNeighbors (x:xs) = if Set.member x vis
then addableNeighbors(xs)
else x:addableNeighbors(xs)
let addVisited (vis) (ns) = Set.union (vis) $ Set.fromList ns
let newVisited = addVisited vis $ addableNeighbors $ neighbors point
put newVisited
return (Tree point $ map (flip evalState newVisited) (map (bfs' (Graph adj)) $ addableNeighbors $ neighbors point))
EDIT2：由于空间复杂性的一些代价，我已经提出了一个解决方案，使用图表返回并排队处理BFS图。尽管它不是生成BFS树/图的最佳解决方案，但它仍然有效。
bfs :: (Ord a) => Graph a -> a -> Graph a
bfs (Graph adj) start = evalState (bfs' (Graph adj) (Graph(Map.empty)) [start]) (Set.singleton start)
bfs':: (Ord a) => Graph a -> Graph a -> [a] -> State (Set.Set a) (Graph a)
bfs' _ (Graph ret) [] = return (Graph ret)
bfs' (Graph adj) (Graph ret) (p:points)= do
vis <- get
let neighbors x = Map.findWithDefault [] x adj
let addableNeighbors ns
| null ns = []
| otherwise = if Set.member (head ns) vis
then addableNeighbors(tail ns)
else (head ns):addableNeighbors(tail ns)
let addVisited (v) (ns) = Set.union (v) $ Set.fromList ns
let unVisited = addableNeighbors $ neighbors p
let newVisited = addVisited vis unVisited
let unionGraph (Graph g1) (Graph g2) = Graph (Map.union g1 g2)
put newVisited
bfs' (Graph adj) (unionGraph (Graph ret) (Graph (Map.singleton p unVisited))) (points ++ unVisited)
EDIT3：我已经为图形添加了转换功能。 EDIT2中的运行功能和EDIT3将产生BFS树。它不是计算时间最好的算法，但我相信对于像我这样的新手来说它是直观且容易理解的：）
graphToTree :: (Ord a) => Graph a -> a -> Tree a
graphToTree (Graph adj) point = Tree point $ map (graphToTree (Graph adj)) $ neighbors point
where neighbors x = Map.findWithDefault [] x adj
答案 0 :(得分：8)
将图表转换为Tree广度优先比简单searching the graph breadth-first要困难一些。如果您正在搜索图表，则只需要从单个分支返回。将图形转换为树时，结果需要包含多个分支的结果。
我们可以使用比Graph a更通用的类型来搜索或转换为树。我们可以使用函数a -> [a]搜索或转换为树。对于Graph，我们使用(Map.!) m函数，其中m是Map。使用转置表进行搜索具有类似
breadthFirstSearchUnseen:: Ord r => (a -> r) -> -- how to compare `a`s
(a -> Bool) -> -- where to stop
(a -> [a]) -> -- where you can go from an `a`
[a] -> -- where to start
Maybe [a]
将函数转换为包含最早深度的每个可到达节点的树具有类似
的签名shortestPathTree :: Ord r => (a -> r) -> -- how to compare `a`s
(a -> l) -- what label to put in the tree
(a -> [a]) -> -- where you can go from an `a`
a -> -- where to start
Tree l
我们可以稍微更一般地从任意数量的节点开始，并构建一个Forest，其中包含最早深度的每个可达节点。
shortestPathTrees :: Ord r => (a -> r) -> -- how to compare `a`s
(a -> l) -- what label to put in the tree
(a -> [a]) -> -- where you can go from an `a`
[a] -> -- where to start
[Tree l]
执行转换为树并不能帮助我们进行搜索，我们可以在原始图表上执行广度优先搜索。
import Data.Sequence (viewl, ViewL (..), (><))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
breadthFirstSearchUnseen:: Ord r => (a -> r) -> (a -> Bool) -> (a -> [a]) -> [a] -> Maybe [a]
breadthFirstSearchUnseen repr p expand = combine Set.empty Seq.empty []
where
combine seen queued ancestors unseen =
go
(seen `Set.union` (Set.fromList . map repr $ unseen))
(queued >< (Seq.fromList . map ((,) ancestors) $ unseen))
go seen queue =
case viewl queue of
EmptyL -> Nothing
(ancestors, a) :< queued ->
if p a
then Just . reverse $ ancestors'
else combine seen queued ancestors' unseen
where
ancestors' = a:ancestors
unseen = filter (flip Set.notMember seen . repr) . expand $ a
上述搜索算法中维护的状态是下一个要访问的节点的Seq队列以及已经看到的Set个节点。如果我们改为跟踪已经访问的节点，那么如果我们找到到同一深度的节点的多条路径，我们可以多次访问同一节点。在我写这个广度优先搜索的答案中有一个more complete explanation。
我们可以根据常规搜索轻松编写搜索Graph。
import qualified Data.Map as Map
newtype Graph a = Graph (Map.Map a [a]) deriving (Ord, Eq, Show)
bfsGraph :: (Ord a) => Graph a -> (a -> Bool) -> [a] -> Maybe [a]
bfsGraph (Graph adj) test = breadthFirstSearchUnseen id test ((Map.!) adj)
我们还可以编写如何自己搜索Tree。
import Data.Tree
bfsTrees :: (Ord a) => (a -> Bool) -> [Tree a] -> Maybe [a]
bfsTrees test = fmap (map rootLabel) . breadthFirstSearchUnseen rootLabel (test . rootLabel) subForest
建立广度优先的树a lot more difficult。幸运的是，Data.Tree已经提供了从monadic展开以广度优先顺序构建Tree的方法。广泛的第一顺序将负责排队，我们只需要跟踪我们已经看到的节点的状态。
unfoldTreeM_BF的类型为Monad m => (b -> m (a, [b])) -> b -> m (Tree a)。 m是我们的计算所在的Monad，b是我们要基于的构建树的数据类型，a是标签的类型这棵树为了使用它来构建树，我们需要创建一个函数b -> m (a, [b])。我们要将a重命名为l以获取标签，将b重命名为a，这是我们用于节点的内容。我们需要制作一个a -> m (l, [a])。对于m，我们会使用State中的transformers monad来跟踪某个州;状态将是我们已经看到的代表Set的{{1}}个节点;我们将使用r monad。总的来说，我们需要提供一个函数State (Set.Set r)。
a -> State (Set.Set r) (l, [a])为了构建树，我们运行由unfoldForestM_BF
expandUnseen :: Ord r => (a -> r) -> (a -> l) -> (a -> [a]) -> a -> State (Set.Set r) (l, [a])
expandUnseen repr label expand a = do
seen <- get
let unseen = filter (flip Set.notMember seen . repr) . uniqueBy repr . expand $ a
put . Set.union seen . Set.fromList . map repr $ unseen
return (label a, unseen)
shortestPathTrees :: Ord r => (a -> r) -> (a -> l) -> (a -> [a]) -> [a] -> [Tree l]
shortestPathTrees repr label expand = run . unfoldForestM_BF k . uniqueBy repr
where
run = flip evalState Set.empty
k = expandUnseen repr label expand
是一个uniqueBy，它利用nubBy个实例代替Ord。
Eq我们可以根据我们的一般最短路径树构建来编写uniqueBy :: Ord r => (a -> r) -> [a] -> [a]
uniqueBy repr = go Set.empty
where
go seen [] = []
go seen (x:xs) =
if Set.member (repr x) seen
then go seen xs
else x:go (Set.insert (repr x) seen) xs
s中的构建最短路径树
Graph我们也可以将shortestPathsGraph :: Ord a => Graph a -> [a] -> [Tree a]
shortestPathsGraph (Graph adj) = shortestPathTrees id id ((Map.!) adj)
过滤到Forest中的最短路径。
Forest答案 1 :(得分：0)
我的解决方案基于逐级工作（与BFS相比），另请参阅this question and answer。
一般的想法是：假设我们已经知道我们BFS的每个级别之前的访问元素集作为集合列表。然后我们可以逐层遍历图形，更新集合列表，在路上构造输出Tree。
诀窍在于，经过这种逐级遍历后，我们将在每个级别之后拥有已访问元素集。这与之前的列表相同，只是换了一个。因此，通过tying the knot，我们可以使用移位的输出作为过程的输入。
import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe (fromMaybe, catMaybes)
import qualified Data.Set as S
import Data.Tree
newtype Graph a = Graph (M.Map a [a])
deriving (Ord, Eq, Show)
tagBfs :: (Ord a) => Graph a -> a -> Maybe (Tree a)
tagBfs (Graph g) s = let (t, sets) = runState (thread s) (S.empty : sets)
in t
where
thread x = do
sets@(s : subsets) <- get
case M.lookup x g of
Just vs | not (S.member x s) -> do
-- recursively create sub-nodes and update the subsets list
let (nodes, subsets') = runState
(catMaybes `liftM` mapM thread vs) subsets
-- put the new combined list of sets
put (S.insert x s : subsets')
-- .. and return the node
return . Just $ Node x nodes
_ -> return Nothing -- node not in the graph, or already visited
在以下示例中运行tagBfs example2 'b'
example2 :: Graph Char
example2 = Graph $ M.fromList
[ ('a', ['b', 'c', 'd'])
, ('b', ['a'])
, ('c', [])
, ('d', [])
]
产量
Just (Node {rootLabel = 'b',
subForest = [Node {rootLabel = 'a',
subForest = [Node {rootLabel = 'c',
subForest = []},
Node {rootLabel = 'd',
subForest = []}
]}
]}
)