Haskell 中的 Floyd-Warshall 算法

Question

我正在研究 Floyd-Warshall 算法。 現在已經設法在 Haskell 中實現它，我實現它的方式類似於它在命令式語言中的實現方式（也就是說，使用列表列表來模擬 2D 數組），但這確實是低效的，因為訪問一個元素在列表中比在數組中慢得多。

在 Haskell 中有更聰明的方法嗎？ 我想我可以通過連接一些列表來做到這一點，但一直失敗。

我的代碼：

floydwarshall :: [[Weight]] -> [[Weight]]
floydwarshall lst = fwAlg 1 $ initMatrix 0 $ list2matrix lst

fwAlg :: Int -> [[Weight]] -> [[Weight]]
fwAlg k m | k < rows m = let n = rows m
                             m' = foldl (\m (i,j) -> updateDist i j k m) m [(i,j) | i <- [0..n-1], j <- [0..n-1]]
                        in fwAlg (k+1) m'
          | otherwise = m

-- a special case where k is 0
initMatrix :: Int -> [[Weight]] -> [[Weight]]
initMatrix n m = if n == rows m then m else initMatrix (n+1) $ updateAtM 0.0 (n,n) m

updateDist :: Int -> Int -> Int -> [[Weight]] -> [[Weight]]
updateDist i j k m =
    let w = min (weight i j m) (weight i k m + weight k j m)
    in updateAtM w (i, j) m

weight :: Vertice -> Vertice -> [[Weight]] -> Weight
weight i j m = let Just w = elemAt (i, j) m in w

Answer 1

該算法具有常規訪問模式，因此我們可以避免大量索引並仍然使用列表編寫它，（我認為）具有與命令式版本相同的漸近性能。

如果您確實想使用 arrays 來提高速度，您可能仍然希望對行和列執行類似的操作，而不是讀取和寫入單個單元格。

-- Let's have a type for weights.  We could use Maybe but the ordering
-- behaviour is wrong - when there's no weight it should be like
-- +infinity.
data Weight = Weight Int | None deriving (Eq, Ord, Show)

addWeights :: Weight -> Weight -> Weight
addWeights (Weight x) (Weight y) = Weight (x + y)
addWeights _ _ = None

-- the main function just steps the matrix a number of times equal to
-- the node count.  Also pass along k at each step.
floydwarshall :: [[Weight]] -> [[Weight]]
floydwarshall m = snd (iterate step (0, m) !! length m)

-- step takes k and the matrix for k, returns k+1 and the matrix for
-- k+1.
step :: (Int, [[Weight]]) -> (Int, [[Weight]])
step (k, m) = (k + 1, zipWith (stepRow ktojs) istok m)
  where
    ktojs = m !! k  -- current k to each j
    istok = transpose m !! k  -- each i to current k

-- Make shortest paths from one i to all j.
-- We need the shortest paths from the current k to all j
-- and the shortest path from this i to the current k
-- and the shortest paths from this i to all j
stepRow :: [Weight] -> Weight -> [Weight] -> [Weight]
stepRow ktojs itok itojs = zipWith stepOne itojs ktojs
  where
    stepOne itoj ktoj = itoj `min` (itok `addWeights` ktoj)

-- example from wikipedia for testing
test :: [[Weight]]
test = [[Weight 0, None, Weight (-2), None],
        [Weight 4, Weight 0, Weight 3, None],
        [None, None, Weight 0, Weight 2],
        [None, Weight (-1), None, Weight 0]]

Answer 2

我不知道如何實現最佳性能，但我可以給你一些讓你的代碼抽象的技巧，這樣你就可以更輕松地進行性能調優。

首先，如果您更改數據類型時不必重寫所有內容，那就太好了。 現在，您已經具體說明了列表列表，所以讓我們看看我們是否可以將其抽象出來。 首先，我們必須弄清楚你的最小矩陣接口是什么。 看一眼您的代碼，您似乎有initMatrix 、 list2matrix 、 rows 、 elemAt和updateAtM 。 這些是查詢或修改矩陣的函數，這些是您需要實現的，以便為不同的 Matrix 類型制作此代碼的新版本。

組織這個接口的一種方法是用它制作一個 class。 例如：

class Matrix m where
  list2matrix :: [[a]] -> m a
  matrix2List :: m a -> [[a]]
  rows :: m a -> Int
  elemAt :: Int -> Int -> m a -> a
  updateAtM :: a -> (Int, Int) -> m a -> m a
  setDiag :: a -> m a -> m a

（我繼續添加了一個matrix2List function 用於提取您的結果並將setDiag initMatrix這感覺更籠統。）

然后我們可以更新您的代碼以使用這個新的 class：

floydwarshall :: Matrix m => [[Weight]] -> m Weight
floydwarshall lst = fwAlg 1 $ initMatrix $ list2matrix lst

fwAlg :: Matrix m => Int -> m Weight -> m Weight
fwAlg k m | k < rows m = let n = rows m
                             m' = foldl (\m (i,j) -> updateDist i j k m) m [(i,j) | i <- [0..n-1], j <- [0..n-1]]
                        in fwAlg (k+1) m'
          | otherwise = m

initMatrix :: Matrix m => m Weight -> m Weight
initMatrix = setDiag 0

updateDist :: Matrix m => Int -> Int -> Int -> m Weight -> m Weight
updateDist i j k m =
    let w = min (elemAt i j m) (elemAt i k m + elemAt k j m)
    in updateAtM w (i, j) m

dist :: Matrix m => Int -> Int -> Int -> m Weight -> Weight
dist i j 0 m = elemAt i j m
dist i j k m = min (dist i j (k-1) m) (dist i k (k-1) m + dist k j (k-1) m)

現在我們需要做的就是開始定義一些Matrix類型，看看性能如何！

讓我們從列表開始，因為您已經完成了這項工作。 我們將不得不使用新類型的包裝器來讓 GHC 滿意，但忽略包裝和展開，這在道德上與您編寫的代碼相同：

newtype ListMatrix a = ListMatrix { getListMatrix :: [[a]] }

instance Matrix ListMatrix where
  list2matrix = ListMatrix
  matrix2List = getListMatrix
  rows = length . getListMatrix
  elemAt i j (ListMatrix m) = m !! i !! j
  updateAtM a (i,j) (ListMatrix m) =
    let (firstRows, row:laterRows) = splitAt i m
        (firstCols, _:laterCols) = splitAt j row
    in ListMatrix $ firstRows <> ((firstCols <> (a:laterCols)):laterRows)
  setDiag x = go 0
    where go n m = if n == rows m then m else go (n+1) $ updateAtM x (n,n) m

（另外，我填寫了elemAt和updateAtM 。）你應該可以運行

matrix2List @ListMatrix $ floydwarshall myList

並獲得與當前相同的結果（和性能）。

現在，開始實驗！ 我們所要做的就是定義Matrix的新實例並看看會發生什么。 也許我們應該嘗試純函數：

data FunMatrix a = FunMatrix { size :: Int, getFunMatrix :: Int -> Int -> a }

instance Matrix FunMatrix where
  list2matrix l = FunMatrix (length l) (\i j -> l !! i !! j)
  matrix2List (FunMatrix s f) = (\i -> f i <$> [0..s-1]) <$> [0..s-1]
  rows = size
  elemAt i j m = getFunMatrix m i j
  updateAtM a (i,j) (FunMatrix s f) = FunMatrix s (\i' j' -> if i==i' && j==j' then a else f i' j')
  setDiag x (FunMatrix s f) = FunMatrix s (\i j -> if i==j then x else f i j)

那表現如何？ 一個問題是開始查找 function 仍然只是索引到列表列表中，這很慢。 一種解決方法是先轉換為數組或向量，然后再進行索引。 因為我們已經很好地抽象了所有內容，所以需要更改的只是這里list2matrix的定義，您可能會獲得不錯的性能提升！

---

關於性能的話題，我可以指出另一點。 dist的定義做了一些嚴肅的“動態規划”。 如果您直接在數組中寫入和讀取，這可能會很好，但是在這種遞歸形式中，您最終可能會做很多重復的工作。 一種解決方法是memoize 。 我的 goto memoization package 是MemoTrie ，這使得記憶事情變得非常容易。 在這種情況下，您可以將dist更改為：

dist :: Matrix m => m Weight -> Int -> Int -> Int -> Weight
dist m = go'
  where
    go' = memo3 go
    go i j 0 = elemAt i j m
    go i j k = min (go' i j (k-1)) (go' i k (k-1) + go' k j (k-1))

這可能會給你一點動力！

---

您可能會考慮接受@Chi 的建議並使用STUArray ，但您會遇到一個問題： STUArray接口要求數組查找位於 monad 中。 仍然可以使用我在上面展示的抽象方法，但是您必須更改函數的類型。 而且，因為您更改了接口中的類型，您需要將您的算法代碼更新為單子。 這可能有點痛苦，但可能需要獲得最佳性能。