优化在 Haskell 中实现的 BFS

Question

所以我想写一个图广度优先搜索。该算法跟踪其状态中的一些值。它们是：每个节点的visited 状态和一个队列。 它还需要知道图的边缘以及它的目标是什么，但这不会逐步改变。

这是我想出的（对不起，丑陋）

import Prelude hiding (take, cons, drop)
import Data.Vector

type BFSState = (Vector Bool, Vector [Int], [Int], Int)
bfsStep :: BFSState -> BFSState
bfsStep (nodes, edges, current:queue, target)
    | current == target = (nodes, edges, [], target)
    | nodes ! current = (nodes, edges, queue, target)
    | otherwise = (markedVisited, edges, queue Prelude.++ (edges ! current), target)
    where
        markedVisited = (take current nodes) Data.Vector.++ (cons True (drop (current + 1) nodes))

bfsSteps :: BFSState -> [BFSState]
bfsSteps init = steps
    where steps = init : Prelude.map bfsStep steps 

bfsStep 接受一个状态并产生下一个状态。当状态的队列为[]时，目标节点已经找到。 bfsSteps 只是使用一个自引用列表来制作 BFSStates 的列表。现在，目前没有办法知道到达某个节点需要多少步（给定起始条件），但bfsSteps 函数会产生算法所用的步数。

我担心的是每一步都会复制状态。我意识到与 ++ 的连接效果不佳，但我觉得老实说这并不重要，因为每一步都会复制所有状态。

我知道有些 monad 几乎应该做我在这里所做的事情，但是由于 Haskell 是纯的，这是否意味着 monad 仍然必须复制状态？

难道不应该有办法说“嘿，我在我的代码中只使用了一次这些值，而且我没有将它们存储在任何地方。您可以更改它们而不是创建新值”？

如果 Haskell 自己这样做，它仍然可以让我保持代码纯净，但可以加快执行速度。

Answer 1

您可能有兴趣阅读我的 Monad Reader 文章的第一部分或第二部分：Lloyd Allison’s Corecursive Queues: Why Continuations Matter，它使用自引用来实现高效的队列。 hackage 上也有可用的代码control-monad-queue。事实上，我在实现一个相当有效的广度优先图可达性算法时首先发现了这个技巧，尽管我使用函数数据结构来跟踪算法已经看到的内容。

如果您真的想坚持使用命令式数据结构来跟踪您去过的地方，我建议您使用 ST monad。不幸的是，让 ST 使用我上面提到的队列类型有点 hacky。我不确定我是否可以推荐这种组合，尽管从 FP 的思维方式来看，这种组合并没有什么问题。

使用更命令式的方法，您可能最好使用传统的两个堆栈队列，或者如果您真的想要一些额外的性能，则基于命令式数组块实现一个命令式队列。

Answer 2

您的状态仅在修改时被复制，而不是在使用时。

例如，edges :: Vector [Int] 永远不会被 bfsStep 修改，因此在所有递归调用中都会重复使用相同的值。

另一方面，您的queue :: [Int] 被 bfsStep 以两种方式修改：

• 将其拆分为 current : queue - 但这会重用原始队列的尾部，因此不会进行复制
• 附加到它Prelude.++。这需要O(queue size) 复制。

当您更新 nodes :: Vector Int 以包含新节点时，您也需要进行类似的复制。

有几种方法可以减少对queue 的复制，还有几种方法可以减少对nodes 的复制。

对于nodes，您可以将计算包装在ST s monad 中以使用单个可修改向量。或者，您可以使用具有fairly fast update 的IntMap 之类的函数式数据结构。

对于您的 queue，您可以使用 Data.Sequence 或 a two list implementation。

Answer 3

由于Edges 和target 从未改变，我重写了bfsStep，只返回新的Nodes 和queue。我还使用Data.Vector.modify 对Nodes 进行就地更新，而不是之前使用的笨拙的take/drop/cons 方法。

另外，bfsStep 可以从Prelude 更简洁地写成iterate。

现在，bfs 中的所有内容都是 O(1)，除了 queue 上的 O(n) 附加。但是，(++) 在它的第一个参数的长度上只有O(n)，所以如果每个顶点的边数很少，它会非常有效。

import Data.Vector (Vector)                                      
import qualified Data.Vector         as V
import qualified Data.Vector.Mutable as M                    

type Nodes = Vector Bool            
type Edges = Vector [Int]

bfs :: Nodes -> Edges -> [Int] -> Int -> (Nodes, [Int])
bfs nodes edges (x:xs) target              
    | x == target = (nodes, [])         
    | nodes V.! x = (nodes, xs)         
    | otherwise   = (marked, edges V.! x ++ xs)
    where marked = V.modify (\v -> M.write v x True) nodes 

bfsSteps :: Nodes -> Edges -> [Int] -> Int -> [(Nodes, [Int])]
bfsSteps nodes edges queue target = 
    iterate (\(n, q) -> bfs n edges q target) (nodes, queue)