Vectorうまくいけば良いパフォーマンスが得られるように、s を使用して Haskell で Floyd-Warshall の全ペア最短経路アルゴリズムの効率的な実装を書きたかったのです。
実装は非常に簡単ですが、代わりに 3 次元の |V|×|V|×|V| を使用します。前の値のみを読み取るため、2 次元ベクトルが使用されkます。
したがって、このアルゴリズムは実際には、2D ベクトルが渡されて新しい 2D ベクトルが生成される一連のステップにすぎません。最終的な 2D ベクトルには、すべてのノード (i,j) 間の最短パスが含まれます。
私の直感では、各ステップの前に前の 2D ベクトルが評価されていることを確認することが重要であることがわかったので、関数の引数と strictを使用BangPatternsしました。prevfwfoldl'
{-# 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次に、 andを使用してプログラムを実行しました+RTS -p -hd。
これは... 興味深いですが、サンクが大量に蓄積されていることを示していると思います。良くない。
わかりましたので、暗闇で数回撮影した後、実際に評価されることを確認するために を追加deepseqしました。fwprev
let d = prev `deepseq` distance g prev i j k
これで見た目が良くなり、一定のメモリ使用量で実際にプログラムを最後まで実行できます。議論の強打prevが十分でなかったことは明らかです。
前のグラフとの比較のために、以下に を追加した後の 50 回の反復のメモリ使用量を示しますdeepseq。
さて、状況は良くなりましたが、まだいくつか質問があります。
- これは、このスペース リークの正しい解決策ですか?
deepseqa を挿入するのが少し醜いと思うのは間違っていますか? - ここでの s の使用法は
Vector慣用的/正しいですか? 反復ごとにまったく新しいベクトルを構築しており、ガベージ コレクターが古いVectors を削除することを期待しています。 - このアプローチでこれをより速く実行するために他にできることはありますか?
参考までに、httpgraph.txt : //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')