在Haskell中使用State monad的广度优先搜索 [英] Breadth-First Search using State monad in Haskell
问题描述
最近，我问了一个关于从Stackoverflow中的Graph构建DFS树的问题，并且已经知道可以通过使用State Monad来简单地实现。
- 从队列中取出队列
- 将该点的所有未访问邻居添加到当前树的子级，队列和已访问列表中
- 为队列中的下一个重复此操作
- 为队列中的下一个重复此操作
因为我们不使用递归遍历来进行BFS搜索，所以我们需要一些其他的遍历方法，比如while循环。我已经在hackage中查找了loop-while包，但似乎有些不赞同。
我假设我需要某种类似的代码：
{-...-}
... = evalState（bfs）（（SetSingleton start），[start ]）
where
neighbors x = Map.findWithDefault [] x adj
bfs = do（vis，x：queue）< -get
map（\\\
eighbor - > ;
if（Set.member neighbor vis）
then put（vis，queue）
else put（（Set.insert neighbor vis），queue ++ [neighbor]）>>（addToTree邻居）
）邻居x
（vis，队列）< -get
while（length queue> 0）
我明白这个实现是非常错误的，但是这应该给我如何实现BFS的最简单的看法。另外，我真的不知道如何避免使用while循环来实现块（即，我应该使用递归算法来克服它，还是应该考虑完全不同的策略）
<考虑到我在前面的问题中找到的答案之一，看起来像这样的答案：
newtype图a =图（Map.Map a [a]）派生（Ord，Eq，Show）
数据树a =树a [Tree a]派生（Ord，Eq，Show）
bfs ::（Ord a）=>图表a - > a - >树a
bfs（图形形式）start = evalState（bfs'）（（SetSingleton start），[start]）
其中
bfs'= { - 其中我没有知道 -
最后，如果由于某种原因使用状态monad的BFS的这种实现是不可能的我认为这不是），请纠正我的错误假设。
我已经在Haskell中看到了一些BFS示例，但没有使用状态monad，但我想了解更多信息关于如何处理state monad，并且找不到使用state monad实现的任何BFS示例。
预先感谢。
编辑：
我想出了一些使用状态monad的算法，但我陷入了无限循环。
bfs ::（Ord a）=>图表a - > a - >树a
bfs（Graph adj）start = evalState（bfs'（Graph adj）start）（Set.singleton start）
bfs'::（Ord a）=>图表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））
编辑2：我已经提出了一个解决方案，使用图返回并排队处理BFS图。尽管它不是生成BFS树/图的最佳解决方案，但它仍然可行。
bfs ::（Ord a）= >图表a - > a - >图a
bfs（图形形式）start = evalState（bfs'（Graph adj）（Graph（Map.empty））[start]）（Set.singleton start）
bfs'::（Ord a）=>图表a - >图表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 = []
|否则=如果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。 （图形调整）（图形（Map.singleton p unVisited）））（points ++ unVisited）
$' c $ c> 编辑3：我已经将图形的转换函数添加到树中。 EDIT2和EDIT3中的运行功能将产生BFS树。它不是计算时间最好的算法，但我相信它对于像我这样的新手来说是直观和容易理解的：）
pre $ graphToTree ::（Ord a）=>图表a - > a - > Tree a
graphToTree（Graph adj）point =树点$ map（graphToTree（Graph adj））$ neighbors point
where neighbors x = Map.findWithDefault [] x adj
将图转换为树宽度优先比简单地搜索图形宽度要困难得多 - 第一。如果你正在搜索图表，你只需要从一个分支返回。将图转换为树时，结果需要包含来自多个分支的结果。
我们可以使用比更通用的类型a图a 为我们可以搜索或转换为树木。我们可以使用函数 a - >搜索或转换树。 [α] 。对于 Graph ，我们使用函数（Map。！）m ，其中 m 是 Map 。使用换位表进行搜索时会有一个签名，如
breadthFirstSearchUnseen :: Ord r => （a→r）→> - 如何比较`a`s
（a - > Bool） - > - 在哪里停止
（a - > [a]） - > - 你可以从`a`
[a] - > - 从哪里开始
可能[a]
将函数转换为包含每个在最早深度的可到达节点都有一个签名，如
shortestPathTree :: Ord r => （a→r）→> - 如何比较`a`s
（a - > l） - 在树中放置什么标签
（a - > [a]） - > - 你可以从`a`
a - > - 从哪里开始
树l
我们可以稍微更一般地从任何数量的节点并建立一个 Forest ，它包含每个可到达节点的最早深度。
shortestPathTrees :: Ord r => （a→r）→> - 如何比较`a`s
（a - > l） - 在树中放置什么标签
（a - > [a]） - > - 你可以从`a`
[a] - > - 从哪里开始
[Tree l]
搜索
执行转换为树并不能真正帮助我们搜索，我们可以在原始图上执行广度优先搜索。
import Data.Sequence（viewl，ViewL（..），（><））
将限定的Data.Sequence导入为Seq
将限定的Data.Set导入为Set
breadthFirstSearchUnseen :: Ord r => （a→r）→> （a - > Bool） - > （a - > [a]） - > [a] - >可能[a]
breadthFirstSearchUnseen repr p expand = combine Set.empty Seq.empty []
其中
合并看到排队的祖先unseen =
go
（看到`Set （（，）祖先）$ unseen））
去看队列= $ b（Set.fromList。map repr $ unseen））
（queued>< $ b案例
的viewl队列EmptyL - >没有
（祖先，a）：<排队 - >
如果p a
则Just。反向$ ancestors'
else结合看到排队的祖先'看不见的
其中
ancestors'= a：ancestors
unseen =过滤器（翻转Set.notMember看到。repr）。展开$ a
在上述搜索算法中维护的状态是 Seq 接下来要访问的节点的队列和 设置 节点已被 。如果我们继续跟踪已经访问过的节点，那么如果我们在相同深度找到到节点的多条路径，则可以多次访问同一个节点。在我写这个广度优先搜索的答案中有一个更完整的解释。
我们可以轻松编写搜索 Graph s用于我们的常规搜索。
导入限定的Data.Map为Map
$ b newtype图a =图（Map.Map a [a]）派生（Ord，Eq，Show）
bfsGraph ::（Ord a）=>图表a - > （a - > Bool） - > [a] - >也许[a]
bfsGraph（Graph adj）test = breadthFirstSearchUnseen id test（（Map。！）adj）
我们还可以编写如何搜索 Tree s本身。
import Data.Tree
bfsTrees ::（Ord a）=> （a - > Bool） - > [树a] - >也许[a]
bfsTrees test = fmap（map rootLabel）。 breadthFirstSearchUnseen rootLabel（test.urlLabel）subForest
构建树
构建宽度优先的树是很多的很多更难。幸运的是 Data.Tree 已经提供了从一元展开的宽度第一次构建 Tree s的方法。广度优先顺序将负责排队，我们只需要跟踪我们已经看到的节点的状态。
unfoldTreeM_BF 的类型为 Monad m => （b→m（a，[b]））→> b - > m（树a）。 m 是 Monad 我们的计算将会在 b 是我们将基于的构建树的数据类型， a 是树标签的类型。为了使用它来构建树，我们需要创建一个函数 b - > m（a，[b]）。我们将标签重命名为 a 为 l ， a ，这就是我们一直在使用的节点。我们需要制作一个 a - > m（l，[a]）。对于 m ，我们将使用 State monad from 变压器来跟踪某些状态;该状态将是> Set 节点，其表示 r 我们已经见过;我们将使用 State（Set.Set r） monad。总的来说，我们需要提供一个函数 a - > State（Set.Set r）（l，[a]）。
expandUnseen :: Ord r => （a→r）→> （a→1）→> （a - > [a]） - > a - > State（Set.Set r）（l，[a]）
expandUnseen repr label expand a = do
seen< - get
let unseen = filter（翻转Set.notMember看过。 ）。 uniqueBy repr。展开$ a
放。 Set.union见过。 Set.fromList。 map repr $ unseen
return（label a，unseen）
为了构建树，我们运行由 unfoldForestM_BF
shortestPathTrees :: Ord r => （a→r）→> （a→1）→> （a - > [a]） - > [a] - > [Tree l]
shortestPathTrees repr label expand = run。 unfoldForestM_BF k。 uniqueBy repr
其中
run = flip evalState Set.empty
k = expandUnseen repr label expand
uniqueBy 是一个利用 Ord 的 nubBy code>实例而不是 Eq 。
uniqueBy :: Ord r => （a→r）→> [a] - > [a]
uniqueBy repr = go Set.empty
其中
可见[] = []
如果Set.member出现（x：xs）=
（repr x）看到
然后看到xs
else x：go（看到Set.insert（repr x））xs
我们可以从 Graph s编写构建最短路径树，就我们的一般最短路径树构建而言， b
shortestPathsGraph :: Ord a =>图表a - > [a] - > [Tree a]
shortestPathsGraph（Graph adj）= shortestPathTrees id id（（Map。！）adj）
我们可以通过将 Forest 过滤为仅通过 Forest 的最短路径来执行相同操作。
shortestPathsTree :: Ord a => [树a] - > [Tree a]
shortestPathsTree = shortestPathTrees rootLabel rootLabel subForest
Recently, I've asked a question for building DFS tree from Graph in Stackoverflow and had learned that it can be simply implemented by using State Monad.
While DFS requires to track only visited nodes, so that we can use 'Set' or 'List' or some sort of linear data structure to track visited nodes, BFS requires 'visited node' and 'queue' data structure to be accomplished.
My pseudocode for BFS is
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)
As can be inferred from pseudocode, we only have to do 3 processes per iteration.
- dequeue point from queue
- add all unvisited neighbors of the point to current tree's child, queue and 'visited' list
- repeat this for next in queue
Since we are not using recursive traversal for BFS search, we need some other traversal method such as while loop. I've looked up loop-while package in hackage, but it seems somewhat deprecated.
What I assume is that I require some sort of code like this :
{-...-}
... = 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)
I understand that this implementation is very erroneous but this should give minimalistic view for how I think BFS should be implemented. Also, I really don't know how to circumvent using while loop for do blocks.(i.e should I use recursive algorithm to overcome it or should I think of completely different strategy)
Considering one of the answer I've found in previous question linked above, it seems like the answer should look like this :
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-}
Finally, if such implementation for BFS using state monad is impossible due to some reason, (which I believe not to be) please correct my false assumption.
I've seen some of the examples for BFS in Haskell without using state monad but I want to learn more about how state monad can be processed and couldn't have found any of examples of BFS implemented using state monad.
Thanks in advance.
EDIT: I came up with some sort of algorithm using state monad but I fall in infinite loop.
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: With some expense of space complexity, I've came out with a solution to get BFS graph using graph to return and queue to process. Despite it is not the optimal solution for generating BFS tree/graph, it will work.
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: I've added convert function for graph to tree. Running function in EDIT2, and EDIT3 will yield BFS Tree. It is not the best algorithm for computation time wise, but I believe it is intuitive and easy to understand for newbies like me :)
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
Converting a graph into a Tree breadth-first is a bit more difficult than simply searching the graph breadth-first. If you are searching the graph, you only ever need to return from a single branch. When converting the graph into a tree, the result needs to include results from multiple branches.
We can use a more general type than Graph a for what we can search or convert to trees. We can search or convert to trees anything with a function a -> [a]. For a Graph we'd use the function (Map.!) m, where m is the Map. Searching with a transposition table has a signature like
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]
Converting the function to a tree that contains each reachable node at the earliest depth has a signature like
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
We can slightly more generally start at any number of nodes and build a Forest that contains each reachable node at the earliest depth.
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]
Searching
Performing the conversion to a tree doesn't really help us search, we can perform breadth first searches on the original graph.
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
The state maintained in the above search algorithm is a Seq queue of what nodes to visit next and a Set of nodes that have already been seen. If we instead kept track of nodes that have already been visited, then we could visit the same node multiple times if we find multiple paths to the node at the same depth. There's a more complete explanation in the answer I wrote this breadth first search for.
We can easily write searching Graphs in terms of our general search.
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)
We can also write how to search Trees themselves.
import Data.Tree
bfsTrees :: (Ord a) => (a -> Bool) -> [Tree a] -> Maybe [a]
bfsTrees test = fmap (map rootLabel) . breadthFirstSearchUnseen rootLabel (test . rootLabel) subForest
Building trees
Building trees breadth-first is a lot more difficult. Fortunately Data.Tree already provides ways to build Trees in breadth first order from a monadic unfold. The breadth first order will take care of the queuing, we will only need to keep track of the state for the nodes we've already seen.
unfoldTreeM_BF has the type Monad m => (b -> m (a, [b])) -> b -> m (Tree a). m is the Monad our computations will be in, b is the type of data we are going to build the tree based on, and a is the type for the labels of the tree. In order to use it to build a tree we need to make a function b -> m (a, [b]). We're going to rename a to l for label, and b to a, which is what we've been using for our nodes. We need to make an a -> m (l, [a]). For m, we'll use the State monad from transformers to keep track of some state; the state will be the Set of nodes whose representation r we've already seen; we'll be using the State (Set.Set r) monad. Overall, we need to provide a function a -> State (Set.Set r) (l, [a]).
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)
To build the trees, we run the state computation built by unfoldForestM_BF
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 is a nubBy that takes advantage of an Ord instance instead of 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
We can write building shortest path trees from Graphs in terms of our general shortest path tree building
shortestPathsGraph :: Ord a => Graph a -> [a] -> [Tree a]
shortestPathsGraph (Graph adj) = shortestPathTrees id id ((Map.!) adj)
We can do the same for filtering a Forest to only the shortest paths through the Forest.
shortestPathsTree :: Ord a => [Tree a] -> [Tree a]
shortestPathsTree = shortestPathTrees rootLabel rootLabel subForest
这篇关于在Haskell中使用State monad的广度优先搜索的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
