Haskell中Floyd-Warshall的性能 - 修復空間泄漏

Question

我想用Haskell編寫一個高效的Floyd-Warshall實現方法，使用Vector s來希望獲得良好的性能。

實現非常簡單，但不是使用三維| V |×| V |×| V |矩陣，使用2維向量，因爲我們只讀過以前的k值。

因此，該算法實際上只是傳遞2D矢量並生成新的2D​​矢量的一系列步驟。最終的2D矢量包含所有節點（i，j）之間的最短路徑。

我的直覺告訴我，這將確保之前的2D載體的每一步之前評估是很重要的，所以我就prev參數的fw功能和嚴格foldl'使用BangPatterns：

{-# 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：

這是...有趣的，但我想它表明它是acc模擬了一大堆thunk。不好。

好了，在黑暗中拍了幾張照片後，我在fw增加了deepseq確保prev真的是evaluted：

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

現在事情看起來更好，我可以實際運行的程序以恆定的內存使用完成。顯而易見的是，關於prev的論點是不夠的。

爲了與以前的曲線圖進行比較，這裏是50次迭代的內存使用量添加deepseq後：

好了，這樣的事情是更好，但我仍然有一些問題：

1. 這是這個空間泄漏的正確解決方案嗎？我錯誤地認爲插入deepseq有點難看？
2. 我在這裏的用法是Vector s這裏習慣用語/正確嗎？我爲每次迭代構建了一個全新的向量，並希望垃圾收集器將刪除舊的Vector。
3. 有沒有其他的事情可以做，使這種方法運行更快？

對於引用，這裏是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 

注意，這完全刪除所有需要的突變，而不會損失任何性能。

現在，實際的問題：

1. 根據我的經驗，deepseq是非常有用的，但只是作爲快速修復空間泄漏贊一個。根本問題不是你在製作結果後需要強制結果。相反，使用deepseq意味着您應該首先更嚴格地構建結構。事實上，如果你在你的向量生成的代碼添加一個爆炸的圖案，像這樣：

   let !d = distance g prev i j k 
   

   那麼問題是固定不deepseq。請注意，這不適用於generate代碼，因爲出於某種原因（我可能會爲此創建功能請求），因此vector不提供用於裝箱向量的嚴格功能。但是，當我回答問題3中的非盒裝載體時，這兩種方法都是嚴格的，而且兩種方法都沒有嚴格的註釋。

2. 據我所知，重複生成新向量的模式是慣用的。唯一不慣用的是使用可變性 - 除非它們是嚴格必要的，通常不鼓勵可變向量。

3. 有幾件事情要做：

   • 最簡單的，你可以用IntMap取代Map Int。由於這不是真正的功能慢點，所以這並不重要，但對於繁重的工作負載，IntMap可以快得多。

   • 您可以切換到使用取消裝箱的向量。儘管外部矢量必須保持爲盒狀，因爲矢量矢量不能拆箱，內部矢量可以是。這也解決了你的嚴格問題 - 因爲無盒裝矢量元素嚴格，你不會得到空間泄漏。請注意，在我的機器上，這會將性能從4.1秒提高到1.3秒，因此拆箱非常有幫助。

   • 您可以將矢量平鋪成一個矢量，並使用乘法和除法在二維標記和一維二維標記之間切換。我不推薦這樣做，因爲它有點牽扯，很難看，而且由於這種劃分，實際上減慢了我的機器上的代碼。可以使用repa。這具有自動並行處理代碼的巨大優勢。請注意，由於repa展平了它的數組，並且顯然沒有適當地擺脫填充所需的分割（可以使用嵌套循環，但我認爲它使用單個循環和分割），它具有相同的性能就像我上面提到的那樣，將運行時間從1.3秒增加到1.8秒。但是，如果啓用並行機制並使用多核機器，則會看到一些好處。不幸的是，你目前的測試案例太小，看不到太多的好處，所以，在我的6核心機器上，我發現它降低到1.2秒。如果我將尺寸恢復爲[1..v]而不是[1..50]，則並行性會將其從32秒延長至13分鐘。假設如果您爲此程序提供更大的輸入，則可能會看到更多效果。

     如果您有興趣，我已發佈我的repa通用版本here。

   • 編輯：使用-fllvm。在我的電腦上測試，使用repa，我得到14.7秒沒有並行性，這幾乎和沒有-fllvm並且具有並行性一樣好。一般來說，LLVM可以很好地處理基於數組的代碼。