Вопрос о производительности хвостовой рекурсии в Haskell для расстояний Левенштейна

Question

Я играю с расчетом Левенштейновских расстояний в Хаскеле, и немного разочарован следующей проблемой производительности.Если вы реализуете это наиболее «нормальным» способом для 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

В прошлом я использовал эту очень лаконичную версию с foldl и scanl из Wikibooks :

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

Я только что выполнил этот простой тест, используя Критерий :

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 необходимо оценить весь список. Это дорогостоящая операция. И что более важно, после этого список будет храниться в памяти, пока вы не прекратите ссылаться на список (=> больший объем памяти). Основное правило - не использовать length в списках, если ожидается, что списки будут длинными. То же самое относится к (!!), оно каждый раз идет от самого начала списка, так что это тоже O (n). Списки не предназначены для структуры данных с произвольным доступом.

Лучше всего использовать списки на Haskell - использовать их частично. Складки - это, как правило, аналогичные проблемы. И расстояние Левенштейна можно рассчитать таким образом (см. Ссылку ниже). Я не знаю, есть ли лучшие алгоритмы.

Другой подход заключается в использовании другой структуры данных, а не списков. Например, если вам нужен произвольный доступ, известная длина и т. Д., Посмотрите на Data.Sequence.Seq.

Существующие реализации

Второй подход был использован в этой реализации расстояния Левенштейна в Хаскеле (с использованием массивов). Вы можете найти реализацию на основе foldl в первом комментарии. Кстати, foldl' обычно лучше, чем foldl.

Answer 3

Возможно иметь алгоритм O (N * d), где d - расстояние Левенштейна.Вот реализация в Lazy ML от Lloyd Allison, которая использует лень для достижения повышенной сложности.Это работает только путем вычисления части матрицы, то есть области вокруг главной диагонали, которая пропорциональна по ширине расстоянию Левенштейна.

Редактировать: Я только что заметил, что это было переведено в 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 4

Я пока не отслеживаю всю вашу вторую попытку, но насколько я помню, идея алгоритма Левенштейна состоит в том, чтобы сохранить повторяющиеся вычисления с использованием матрицы. В первом фрагменте кода вы не разделяете какие-либо вычисления, и, таким образом, вы будете повторять множество вычислений. Например, при расчете 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

Еще две вещи: во-первых, я не уверен, что алгоритм Левенштейна может когда-либо использовать только часть матрицы, так как каждая запись зависит от диагонального, вертикального и горизонтального соседа. Когда вам нужно значение для одного угла, вам неизбежно придется оценивать матрицу вплоть до другого угла. Во-вторых, эту строку match | foo = True | otherwise = False можно заменить просто match = foo.

Answer 5

Более интуитивное решение с использованием пакета data-memocombinators .Кредит идет на этот ответ .Тесты приветствуются, так как все представленные здесь решения выглядят намного, намного медленнее, чем 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) ]