Question

我希望使用Vector在Haskell中编写Floyd-Warshall所有对最短路径算法的有效实现，以期获得良好的性能。

实现非常简单，但不使用三维| V |×| V |×| V |矩阵，使用二维向量，因为我们只读过前一个k值。

因此，该算法实际上只是传递2D矢量的一系列步骤，并且生成新的2D矢量。最终的2D矢量包含所有节点（i，j）之间的最短路径。

我的直觉告诉我，确保在每个步骤之前评估先前的2D矢量是很重要的，所以我在BangPatterns函数的prev参数上使用了fw和严格的foldl'：

{-# Language BangPatterns #-}

import           Control.DeepSeq
import           Control.Monad       (forM_)
import           Data.List           (foldl')
import qualified Data.Map.Strict     as M
import           Data.Vector         (Vector, (!), (//))
import qualified Data.Vector         as V
import qualified Data.Vector.Mutable as V hiding (length, replicate, take)

type Graph = Vector (M.Map Int Double)
type TwoDVector = Vector (Vector Double)

infinity :: Double
infinity = 1/0

-- calculate shortest path between all pairs in the given graph, if there are
-- negative cycles, return Nothing
allPairsShortestPaths :: Graph -> Int -> Maybe TwoDVector
allPairsShortestPaths g v =
  let initial = fw g v V.empty 0
      results = foldl' (fw g v) initial [1..v]
  in if negCycle results
        then Nothing
        else Just results
  where -- check for negative elements along the diagonal
        negCycle a = any not $ map (\i -> a ! i ! i >= 0) [0..(V.length a-1)]

-- one step of the Floyd-Warshall algorithm
fw :: Graph -> Int -> TwoDVector -> Int -> TwoDVector
fw g v !prev k = V.create $ do                                           -- ← bang
  curr <- V.new v
  forM_ [0..(v-1)] $ \i ->
    V.write curr i $ V.create $ do
      ivec <- V.new v
      forM_ [0..(v-1)] $ \j -> do
        let d = distance g prev i j k
        V.write ivec j d
      return ivec
  return curr

distance :: Graph -> TwoDVector -> Int -> Int -> Int -> Double
distance g _ i j 0 -- base case; 0 if same vertex, edge weight if neighbours
  | i == j    = 0.0
  | otherwise = M.findWithDefault infinity j (g ! i)
distance _ a i j k = let c1 = a ! i ! j
                        c2 = (a ! i ! (k-1))+(a ! (k-1) ! j)
                        in min c1 c2

但是，当运行带有47978边的1000节点图形的程序时，事情看起来并不好看。内存使用率非常高，程序运行时间太长。该程序编译为ghc -O2。

我重建了用于分析的程序，并将迭代次数限制为50：

 results = foldl' (fw g v) initial [1..50]

然后我使用+RTS -p -hc和+RTS -p -hd

运行该程序

这很有意思，但我猜它显示它累积了大量的thunk。不好。

好的，所以在黑暗中拍了几张后，我在deepseq中添加了fw，以确保评估prev ：

let d = prev `deepseq` distance g prev i j k

现在事情看起来更好了，我实际上可以通过持续的内存使用来运行程序。很明显，prev论证的爆炸是不够的。

为了与之前的图表进行比较，以下是添加deepseq后50次迭代的内存使用情况：

好的，事情变得更好，但我还有一些问题：

这是空间泄漏的正确解决方案吗？我错误地认为插入deepseq有点难看？
我对Vector的使用是否惯用/正确？我正在为每次迭代构建一个全新的向量，并希望垃圾收集器将删除旧的Vector。
使用这种方法，还有什么其他方法可以让它运行得更快吗？

对于参考，这里是graph.txt：http://sebsauvage.net/paste/?45147f7caf8c5f29#7tiCiPovPHWRm1XNvrSb/zNl3ujF3xB3yehrxhEdVWw=

以下是main：

main = do
  ls <- fmap lines $ readFile "graph.txt"
  let numVerts = head . map read . words . head $ ls
  let edges = map (map read . words) (tail ls)
  let g = V.create $ do
        g' <- V.new numVerts
        forM_ [0..(numVerts-1)] (\idx -> V.write g' idx M.empty)
        forM_ edges $ \[f,t,w] -> do
          -- subtract one from vertex IDs so we can index directly
          curr <- V.read g' (f-1)
          V.write g' (f-1) $ M.insert (t-1) (fromIntegral w) curr
        return g'
  let a = allPairsShortestPaths g numVerts
  case a of
    Nothing -> putStrLn "Negative cycle detected."
    Just a' -> do
      putStrLn  $ "The shortest, shortest path has length "
              ++ show ((V.minimum . V.map V.minimum) a')

Answer 1

首先，一些通用代码清理：

在fw函数中，您明确分配并填充可变向量。但是，为了这个目的，有一个预制函数，即generate。因此fw可以改写为

V.generate v (\i -> V.generate v (\j -> distance g prev i j k))

同样，图表生成代码可以替换为replicate和accum：

let parsedEdges = map (\[f,t,w] -> (f - 1, (t - 1, fromIntegral w))) edges
let g = V.accum (flip (uncurry M.insert)) (V.replicate numVerts M.empty) parsedEdges

请注意，这完全消除了对变异的所有需求，而不会失去任何性能。

现在，到实际问题：

根据我的经验，deepseq非常有用，但只能快速修复像这样的空间泄漏。根本问题不在于您需要在生成结果后强制执行结果。相反，使用deepseq意味着您应该首先更严格地构建结构。实际上，如果你在矢量创建代码中添加一个爆炸模式，如下所示：
```
let !d = distance g prev i j k
```
然后在没有deepseq的情况下修复问题。请注意，这不适用于generate代码，因为由于某种原因（我可能会为此创建一个功能请求），vector不会为盒装矢量提供严格的功能。但是，当我在回答问题3时得到未装箱的向量时，两个方法都没有严格的注释。
据我所知，重复生成新载体的模式是惯用的。唯一不恰当的是使用可变性 - 除非它们是绝对必要的，否则通常不鼓励使用可变载体。
有几件事要做：
- 最简单的说，您可以将Map Int替换为IntMap。由于这不是函数的慢点，这并不重要，但IntMap对于繁重的工作负载来说可以快得多。
- 您可以切换到使用未装箱的矢量。虽然外部矢量必须保持盒装，但由于矢量矢量不能取消装箱，因此内部矢量可以是。这也解决了你的严格问题 - 因为未装箱的矢量在其元素中是严格的，你不会得到空间泄漏。请注意，在我的机器上，这会将性能从4.1秒提高到1.3秒，因此拆箱非常有用。
- 您可以将矢量展平为单个矢量并使用乘法和除法在二维指标和一个维数指示之间切换。我不建议这样做，因为它有点涉及，非常难看，并且，由于划分，实际上减慢了我的机器上的代码。
- 您可以使用repa。这具有自动并行化代码的巨大优势。请注意，由于repa使其数组变平，并且显然没有正确地去除填充所需的分区（可以使用嵌套循环，但我认为它使用单循环和除法），它具有与上面提到的相同的性能损失，使运行时间从1.3秒增加到1.8。但是，如果启用并行性并使用多核计算机，则会开始看到一些好处。不幸的是，你目前的测试用例太小了，看不出多少好处，所以，在我的6核机器上，我看到它下降到1.2秒。如果我将大小调回[1..v]而不是[1..50]，则并行性会将它从32秒提高到13.大概，如果你给这个程序一个更大的输入，你可能会看到更多的好处。
  
  如果您有兴趣，我已发布我的repa - ified版本here。
- 编辑：使用-fllvm。在我的计算机上进行测试，使用repa，我得到14.7秒没有并行性，这几乎与没有-fllvm和并行性一样好。通常，LLVM可以像这样处理基于数组的代码。

在Haskell中Floyd-Warshall的表现 - 修复空间泄漏

1 个答案: