Levenshtein 距离的 Haskell 尾递归性能问题

Question

我正在玩在 Haskell 中计算 Levenshtein distances，并且对以下性能问题感到有点沮丧。如果您为 Haskell 实现它最“正常”的方式，如下所示 (dist)，一切正常：

dist :: (Ord a) => [a] -> [a] -> Int
dist s1 s2 = ldist s1 s2 (L.length s1, L.length s2)

ldist :: (Ord a) => [a] -> [a] -> (Int, Int) -> Int
ldist _ _ (0, 0) = 0
ldist _ _ (i, 0) = i
ldist _ _ (0, j) = j
ldist s1 s2 (i+1, j+1) = output
  where output | (s1!!(i)) == (s2!!(j)) = ldist s1 s2 (i, j)
               | otherwise = 1 + L.minimum [ldist s1 s2 (i, j)
                                          , ldist s1 s2 (i+1, j)
                                          , ldist s1 s2 (i, j+1)]

但是，如果你稍微弯曲一下并将其实现为 dist'，它的执行速度大大（大约 10 倍）。

dist' :: (Ord a) => [a] -> [a] -> Int
dist' o1 o2 = (levenDist o1 o2 [[]])!!0!!0 

levenDist :: (Ord a) => [a] -> [a] -> [[Int]] -> [[Int]]
levenDist s1 s2 arr@([[]]) = levenDist s1 s2 [[0]]
levenDist s1 s2 arr@([]:xs) = levenDist s1 s2 ([(L.length arr) -1]:xs)
levenDist s1 s2 arr@(x:xs) = let
    n1 = L.length s1
    n2 = L.length s2
    n_i = L.length arr
    n_j = L.length x
    match | (s2!!(n_j-1) == s1!!(n_i-2)) = True | otherwise = False
    minCost = if match      then (xs!!0)!!(n2 - n_j + 1) 
                            else L.minimum [(1 + (xs!!0)!!(n2 - n_j + 1))
                                          , (1 + (xs!!0)!!(n2 - n_j + 0))
                                          , (1 + (x!!0))
                                          ]
    dist | (n_i > n1) && (n_j > n2)  = arr 
         | n_j > n2  = []:arr `seq` levenDist s1 s2 $ []:arr
         | n_i == 1 = (n_j:x):xs `seq` levenDist s1 s2 $ (n_j:x):xs
         | otherwise = (minCost:x):xs `seq` levenDist s1 s2 $ (minCost:x):xs
    in dist 

我在第一个版本中尝试了所有常见的seq 技巧，但似乎没有什么可以加快速度。这对我来说有点不满意，因为我希望第一个版本更快，因为它不需要评估整个矩阵，只需要评估它需要的部分。

有谁知道是否有可能让这两种实现具有相似的性能，或者我只是在后者中获得尾递归优化的好处，因此如果我想要性能，就需要忍受它的不可读性？

谢谢， 猎户座

Answer 1

过去我使用过这个非常简洁的版本，带有来自Wikibooks 的foldl 和scanl：

distScan :: (Ord a) => [a] -> [a] -> Int
distScan sa sb = last $ foldl transform [0 .. length sa] sb
  where
    transform xs@(x:xs') c = scanl compute (x + 1) (zip3 sa xs xs')
       where
         compute z (c', x, y) = minimum [y + 1, z + 1, x + fromEnum (c' /= c)]

我刚刚使用Criterion 运行了这个简单的基准测试：

test :: ([Int] -> [Int] -> Int) -> Int -> Int
test f n = f up up + f up down + f up half + f down half
  where
    up = [1..n]
    half = [1..div n 2]
    down = reverse up

main = let n = 20 in defaultMain
  [ bench "Scan" $ nf (test distScan) n
  , bench "Fast" $ nf (test dist') n
  , bench "Slow" $ nf (test dist) n
  ]

而且 Wikibooks 版本大大击败了你们两个：

benchmarking Scan
collecting 100 samples, 51 iterations each, in estimated 683.7163 ms...
mean: 137.1582 us, lb 136.9858 us, ub 137.3391 us, ci 0.950

benchmarking Fast
collecting 100 samples, 11 iterations each, in estimated 732.5262 ms...
mean: 660.6217 us, lb 659.3847 us, ub 661.8530 us, ci 0.950...

Slow 在几分钟后仍在运行。

Answer 2

要计算length，您需要评估整个列表。这是一个昂贵的 O(n) 操作。更重要的是，之后列表将保留在内存中，直到您停止引用列表（=> 更大的内存占用）。如果预计列表很长，则经验法则是不要在列表上使用length。同样是(!!)，每次都从列表的最前面开始，所以也是O(n)。列表并非设计为随机访问数据结构。

使用 Haskell 列表的更好方法是部分使用它们。 Folds 通常是解决类似问题的方法。并且 Levenshtein 距离可以这样计算（见下面的链接）。不知道有没有更好的算法。

另一种方法是使用不同的数据结构，而不是列表。例如，如果您需要随机访问、已知长度等，请查看Data.Sequence.Seq。

现有实现

第二种方法已在 Haskell 中的 Levenschtein 距离的this implementation 中使用（使用数组）。您可以在第一条评论中找到基于foldl 的实现。顺便说一句，foldl' 通常比foldl 好。

Answer 3

我还没有完全遵循您的第二次尝试，但据我所知，Levenshtein 算法背后的想法是通过使用矩阵来节省重复计算。在第一段代码中，您没有共享任何计算，因此您将重复大量计算。例如，在计算ldist s1 s2 (5,5) 时，您将至少分别计算三次ldist s1 s2 (4,4)（一次直接计算，一次通过ldist s1 s2 (4,5)，一次通过ldist s1 s2 (5,4)）。

您应该做的是定义一个生成矩阵的算法（如果您愿意，可以作为列表的列表）。我认为这是您的第二段代码正在做的事情，但它似乎专注于以自上而下的方式计算矩阵，而不是以归纳方式干净地构建矩阵（基本案例中的递归调用非常不寻常在我看来）。不幸的是我没有时间写出整个事情，但幸运的是其他人有：看这个地址的第一个版本：http://en.wikibooks.org/wiki/Algorithm_implementation/Strings/Levenshtein_distance#Haskell

还有两件事：第一，我不确定 Levenshtein 算法是否只能使用矩阵的一部分，因为每个条目都依赖于对角线、垂直和水平邻居。当您需要一个角的值时，您将不可避免地必须一直评估矩阵到另一个角。其次，match | foo = True | otherwise = False 行可以简单地替换为 match = foo。

Answer 4

可能有一个 O(N*d) 算法，其中 d 是 Levenshtein 距离。这是 Lloyd Allison 在 Lazy ML 中的 implementation，它利用惰性来提高复杂性。这仅通过计算矩阵的一部分来实现，即主对角线周围的区域，其宽度与 Levenshtein 距离成正比。

编辑：我刚刚注意到这是 translated 到 haskell 的一个很好的图像，显​​示了计算矩阵的哪些元素。当序列非常相似时，这应该比上述实现快得多。使用上述基准：

benchmarking Scan
collecting 100 samples, 100 iterations each, in estimated 1.410004 s
mean: 141.8836 us, lb 141.4112 us, ub 142.5126 us, ci 0.950

benchmarking LAllison.d
collecting 100 samples, 169 iterations each, in estimated 1.399984 s
mean: 82.93505 us, lb 82.75058 us, ub 83.19535 us, ci 0.950

Answer 5

使用data-memocombinators 包的更直观的解决方案。归功于this answer。欢迎使用基准测试，因为这里提供的所有解决方案似乎都比python-Levenshtein 慢得多，python-Levenshtein 大概是用 C 编写的。请注意，我尝试用字符数组代替字符串，但没有效果。

import Data.MemoCombinators (memo2, integral)

levenshtein :: String -> String -> Int
levenshtein a b = levenshtein' (length a) (length b) where
  levenshtein' = memo2 integral integral levenshtein'' where
    levenshtein'' x y -- take x characters from a and y characters from b
      | x==0 = y
      | y==0 = x
      | a !! (x-1) == b !! (y-1) = levenshtein' (x-1) (y-1)
      | otherwise = 1 + minimum [ levenshtein' (x-1) y, 
        levenshtein' x (y-1), levenshtein' (x-1) (y-1) ]