Производительность на Haskell с использованием динамического программирования

Question

Я пытаюсь вычислить расстояние Левенштейна между двумя строками, используя динамическое программирование. Это делается через Hackerrank, поэтому у меня есть временные ограничения. Я использовал метод, который видел в: Как алгоритмы динамического программирования реализованы в идиоматическом 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 массивы, потому что этот код опирается на лень. Есть ли какие-то явные ошибки производительности, которые я сделал? Или как еще я могу ускорить это?

Answer 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
]

Таким образом, в каждом измерении вам не нужно ничего, кроме следующего индекса: + 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

который проходит все тесты с достойной производительностью.