使用动态编程的 Haskell 性能答案

【问题标题】：Haskell performance using dynamic programming使用动态编程的 Haskell 性能
【发布时间】：2017-02-09 11:18:03
【问题描述】：

我正在尝试使用动态编程计算两个字符串之间的 Levenshtein 距离。这是通过 Hackerrank 完成的，所以我有时间限制。我使用了我在How are Dynamic Programming algorithms implemented in idiomatic Haskell? 中看到的技术，它似乎正在工作。不幸的是，它在一个测试用例中超时。我无权访问特定的测试用例，所以我不知道输入的确切大小。

import Control.Monad
import Data.Array.IArray
import Data.Array.Unboxed

main = do
  n <- readLn
  replicateM_ n $ do
    s1 <- getLine
    s2 <- getLine
    print $ editDistance s1 s2

editDistance :: String -> String -> Int
editDistance s1 s2 = dynamic editDistance' (length s1, length s2)
  where
    s1' :: UArray Int Char
    s1' = listArray (1,length s1) s1
    s2' :: UArray Int Char
    s2' = listArray (1,length s2) s2
    editDistance' table (i,j)
      | min i j == 0 = max i j
      | otherwise = min' (table!((i-1),j) + 1) (table!(i,(j-1)) + 1) (table!((i-1),(j-1)) + cost)
      where
        cost =  if s1'!i == s2'!j then 0 else 1
        min' a b = min (min a b)

dynamic :: (Array (Int,Int) Int -> (Int,Int) -> Int) -> (Int,Int) -> Int
dynamic compute (xBnd, yBnd) = table!(xBnd,yBnd)
  where
    table = newTable $ map (\coord -> (coord, compute table coord)) [(x,y) | x<-[0..xBnd], y<-[0..yBnd]]
    newTable xs = array ((0,0),fst (last xs)) xs

我已改用数组，但速度不够。我不能使用 Unboxed 数组，因为此代码依赖于惰性。我是否犯过任何明显的性能错误？或者我还能如何加快速度？

【问题讨论】：

字符串效率很低。对于竞赛程序，如果您可以摆脱它，我会将输入作为 ByteString 读取 - 其他使用 Text。

标签： performance haskell dynamic-programming

【解决方案1】：

编辑距离计算的反向方程为：

f(i, j) = minimum [
  1 + f(i + 1, j), -- delete from the 1st string
  1 + f(i, j + 1), -- delete from the 2nd string 
  f(i + 1, j + 1) + if a(i) == b(j) then 0 else 1 -- substitute or match
]

因此，在每个维度中，您只需要 next 索引：+ 1。这是一个顺序访问模式，而不是随机访问需要的数组；并且可以使用列表和嵌套的右折叠来实现：

editDistance :: Eq a => [a] -> [a] -> Int
editDistance a b = head . foldr loop [n, n - 1..0] $ zip a [m, m - 1..]
  where
  (m, n) = (length a, length b)
  loop (s, l) lst = foldr go [l] $ zip3 b lst (tail lst)
    where
    go (t, i, j) acc@(k:_) = inc `seq` inc:acc
      where inc = minimum [i + 1, k + 1, if s == t then j else j + 1]

您可以在Hackerrank Edit Distance Problem 中测试此代码，如下所示：

import Control.Applicative ((<$>))
import Control.Monad (replicateM_)
import Text.Read (readMaybe)

editDistance :: Eq a => [a] -> [a] -> Int
editDistance a b = ... -- as implemented above

main :: IO ()
main = do
  Just n <- readMaybe <$> getLine
  replicateM_ n $ do
    a <- getLine
    b <- getLine
    print $ editDistance a b

它以良好的性能通过了所有测试。

【讨论】：