Подтвердить что ты не робот

Алгоритм редактирования расстояния в Haskell - настройка производительности

Я пытаюсь реализовать levenshtein distance (или редактировать расстояние) в Haskell, но его производительность быстро уменьшается при увеличении длины строки.

Я все еще довольно новичок в Haskell, так что было бы неплохо, если бы вы могли дать мне несколько советов о том, как я мог бы улучшить алгоритм. Я уже пытался "прекомпилировать" значения (inits), но поскольку он ничего не менял, я вернул это изменение.

Я знаю, что в Hackage уже реализована editDistance, но мне нужно, чтобы она работала над списками произвольных токенов, а не строк. Кроме того, я считаю это немного сложным, по крайней мере, по сравнению с моей версией.

Итак, вот код:

-- standard levenshtein distance between two lists
editDistance      :: Eq a => [a] -> [a] -> Int
editDistance s1 s2 = editDistance' 1 1 1 s1 s2 

-- weighted levenshtein distance
-- ins, sub and del are the costs for the various operations
editDistance'      :: Eq a => Int -> Int -> Int -> [a] -> [a] -> Int
editDistance' _ _ ins s1 [] = ins * length s1 
editDistance' _ _ ins [] s2 = ins * length s2 
editDistance' del sub ins s1 s2  
    | last s1 == last s2 = editDistance' del sub ins (init s1) (init s2)
    | otherwise          = minimum [ editDistance' del sub ins s1 (init s2)        + del -- deletion 
                                   , editDistance' del sub ins (init s1) (init s2) + sub -- substitution
                                   , editDistance' del sub ins (init s1) s2        + ins -- insertion
                                   ]

Кажется, это правильная реализация, по крайней мере, она дает те же результаты, что и этот онлайн-инструмент.

Заранее благодарим за помощь! Если вам нужна дополнительная информация, сообщите мне.

Привет, BZN

4b9b3361

ОТВЕТЫ

Ответ 1

Игнорируя, что это плохой алгоритм (должен быть memoizing, я добираюсь до этой секунды)...

Использовать O (1) Примитивы, а не O (n)

Одна из проблем заключается в том, что вы используете целые вызовы связью, которые являются O (n) для списков (списки haskell - это списки, связанные по отдельности). Лучшая структура данных даст вам O (1) операции, я использовал Vector:

import qualified Data.Vector as V

-- standard levenshtein distance between two lists
editDistance      :: Eq a => [a] -> [a] -> Int
editDistance s1 s2 = editDistance' 1 1 1 (V.fromList s1) (V.fromList s2)

-- weighted levenshtein distance
-- ins, sub and del are the costs for the various operations
editDistance'      :: Eq a => Int -> Int -> Int -> V.Vector a -> V.Vector a -> Int
editDistance' del sub ins s1 s2
  | V.null s2 = ins * V.length s1
  | V.null s1 = ins * V.length s2
  | V.last s1 == V.last s2 = editDistance' del sub ins (V.init s1) (V.init s2)
  | otherwise            = minimum [ editDistance' del sub ins s1 (V.init s2)        + del -- deletion 
                                   , editDistance' del sub ins (V.init s1) (V.init s2) + sub -- substitution
                                   , editDistance' del sub ins (V.init s1) s2        + ins -- insertion
                                   ]

Операции O (n) для списков включают init, length и last (хотя init может быть ленивым, по крайней мере). Все эти операции - O (1) с использованием Vector.

В то время как настоящий бенчмаркинг должен использовать Criterion, быстрый и грязный тест:

str2 = replicate 15 'a' ++ replicate 25 'b'
str1 = replicate 20 'a' ++ replicate 20 'b'
main = print $ editDistance str1 str2

показывает, что векторная версия занимает 0,09 секунды, а строки - 1,6 секунды, поэтому мы спасли примерно на порядок, даже не глядя на ваш алгоритм editDistance.

А как насчет мемуаризации результатов?

Большей проблемой, очевидно, является необходимость в memoization. Я воспринял это как возможность изучить пакет monad-memo - мой бог - это здорово! За одно дополнительное ограничение (вам нужно Ord a), вы получаете мемонирование в основном без усилий. Код:

import qualified Data.Vector as V
import Control.Monad.Memo

-- standard levenshtein distance between two lists
editDistance      :: (Eq a, Ord a) => [a] -> [a] -> Int
editDistance s1 s2 = startEvalMemo $ editDistance' (1, 1, 1, (V.fromList s1), (V.fromList s2))

-- weighted levenshtein distance
-- ins, sub and del are the costs for the various operations
editDistance' :: (MonadMemo (Int, Int, Int, V.Vector a, V.Vector a) Int m, Eq a) => (Int, Int, Int, V.Vector a, V.Vector a) -> m Int
editDistance' (del, sub, ins, s1, s2)
  | V.null s2 = return $ ins * V.length s1
  | V.null s1 = return $ ins * V.length s2
  | V.last s1 == V.last s2 = memo editDistance' (del, sub, ins, (V.init s1), (V.init s2))
  | otherwise = do
        r1 <- memo editDistance' (del, sub, ins, s1, (V.init s2))
        r2 <- memo editDistance' (del, sub, ins, (V.init s1), (V.init s2))
        r3 <- memo editDistance' (del, sub, ins, (V.init s1), s2)
        return $ minimum [ r1 + del -- deletion 
                         , r2 + sub -- substitution
                         , r3 + ins -- insertion
                                   ]

Вы видите, как для memoization нужен один "ключ" (см. класс MonadMemo)? Я упаковал все аргументы как большой уродливый кортеж. Он также нуждается в одном "значении", которое является вашим результатом Int. Затем он просто подключи и играй, используя функцию "memo" для значений, которые вы хотите сохранить в память.

Для бенчмаркинга я использовал более короткую, но большую длину, строку:

$ time ./so  # the memoized vector version
12

real    0m0.003s

$ time ./so3  # the non-memoized vector version
12

real    1m33.122s

Даже не думайте о том, чтобы запустить версию, не напоминающую memoized, я полагаю, что это займет около 15 минут. Что касается меня, я теперь люблю монад-памятку - спасибо за пакет Эдуарда!

EDIT: разница между String и Vector не так много в мемуаризованной версии, но все же растет до коэффициента 2, когда расстояние доходит до 200, поэтому все равно стоит.

EDIT: Возможно, я должен объяснить, почему большая проблема - это "очевидно" мемуаризирующие результаты. Ну, если вы посмотрите на сердце оригинального алгоритма:

 [ editDistance' ... s1          (V.init s2)  + del 
 , editDistance' ... (V.init s1) (V.init s2) + sub
 , editDistance' ... (V.init s1) s2          + ins]

Совершенно ясно, что вызов editDistance' s1 s2 приводит к 3 вызовам editDistance'... каждый из которых вызывает editDistance' еще три раза... и еще три раза... и AHHH! Экспоненциальный взрыв! К счастью, большинство звонков одинаковы! например (используя --> для "вызовов" и eD для editDistance'):

eD s1 s2  --> eD s1 (init s2)             -- The parent
            , eD (init s1) s2
            , eD (init s1) (init s2)
eD (init s1) s2 --> eD (init s1) (init s2)         -- The first "child"
                  , eD (init (init s1)) s2
                  , eD (init (init s1)) (init s2) 
eD s1 (init s2) --> eD s1 (init (init s2))
                  , eD (init s1) (init s2)
                  , eD (init s1) (init (init s2))

Просто рассмотрев родительский и двух непосредственных детей, мы видим, что вызов ed (init s1) (init s2) выполняется три раза. Другой дочерний ресурс вызывает с родителем тоже, и все дети делятся многими вызовами друг с другом (и их детьми, кий на песню Monty Python).

Было бы забавным, возможно, поучительным упражнением сделать функцию runMemo, которая возвращает количество используемых кешированных результатов.

Ответ 2

Вам нужно memoize editDistance '. Существует много способов сделать это, например, рекурсивно определенный массив.

Ответ 3

Как уже упоминалось, memoization - это то, что вам нужно. Кроме того, вы смотрите на расстояние редактирования справа налево, которое не очень эффективно со строками, а расстояние редактирования равно независимо от направления. То есть: editDistance (reverse a) (reverse b) == editDistance a b

Для решения части memoization существует очень много библиотек, которые могут вам помочь. В моем примере ниже я выбрал MemoTrie, так как он очень прост в использовании и хорошо работает здесь.

import Data.MemoTrie(memo2)

editDistance' del sub ins = memf
  where
   memf = memo2 f
   f s1     []     = ins * length s1
   f []     s2     = ins * length s2
   f (x:xs) (y:ys)
     | x == y  = memf xs ys
     | otherwise = minimum [ del + memf xs (y:ys),
                             sub + memf (x:xs) ys,
                             ins + memf xs ys]

Как вы можете видеть все, что вам нужно, это добавить memoization. Остальное одно и то же, за исключением того, что мы начинаем с начала списка в конце.

Ответ 4

Я знаю, что в Hackage уже реализована editDistance, но мне нужно, чтобы она работала над списками произвольных токенов, не обязательно строк

Есть ли конечное число токенов? Я предлагаю вам попробовать просто создать сопоставление от токена к символу. В вашем распоряжении 10 646 символов.

Ответ 5

Эта версия намного быстрее, чем эти запомненные версии, но все же я бы хотел, чтобы она была еще быстрее. Прекрасно работает со строками длиной 100 символов. Я был написан с учетом других расстояний (изменение функции init и стоимости) и использование классического трюка массива динамического программирования. Длинная строка может быть преобразована в отдельную функцию с верхним "do", но мне это нравится.

import Data.Array.IO
import System.IO.Unsafe

editDistance = dist ini med

dist :: (Int -> Int -> Int) -> (a -> a -> Int ) -> [a] -> [a] -> Int
dist i f a b  = unsafePerformIO $ distM i f a b

-- easy to create other distances 
ini i 0 = i
ini 0 j = j
ini _ _ = 0
med a b = if a == b then 0 else 2


distM :: (Int -> Int -> Int) -> (a -> a -> Int) -> [a] -> [a] -> IO Int
distM ini f a b = do
        let la = length a
        let lb = length b

        arr <- newListArray ((0,0),(la,lb)) [ini i j | i<- [0..la], j<-[0..lb]] :: IO (IOArray (Int,Int) Int)

-- all on one line
        mapM_ (\(i,j) -> readArray arr (i-1,j-1) >>= \ld -> readArray arr (i-1,j) >>= \l -> readArray arr (i,j-1) >>= \d-> writeArray arr (i,j) $ minimum [l+1,d+1, ld + (f (a !! (i-1) ) (b !! (j-1))) ] ) [(i,j)| i<-[1..la], j<-[1..lb]]

        readArray arr (la,lb)

Ответ 6

Люди рекомендуют вам использовать общие библиотеки memoization, но для простой задачи определения горизонтального динамического программирования Levenshtein более чем достаточно. Очень простая реализация на основе полиморфного списка:

distance s t = 
    d !!(length s)!!(length t) 
    where d = [ [ dist m n | n <- [0..length t] ] | m <- [0..length s] ]
          dist i 0 = i
          dist 0 j = j
          dist i j = minimum [ d!!(i-1)!!j+1
                             , d!!i!!(j-1)+1
                             , d!!(i-1)!!(j-1) + (if s!!(i-1)==t!!(j-1) 
                                                  then 0 else 1) 
                             ]

Или, если вам нужна реальная скорость в длинных последовательностях, вы можете использовать изменяемый массив:

import Data.Array
import qualified Data.Array.Unboxed as UA
import Data.Array.ST
import Control.Monad.ST


-- Mutable unboxed and immutable boxed arrays
distance :: Eq a => [a] -> [a] -> Int
distance s t = d UA.! (ls , lt)
    where s' = array (0,ls) [ (i,x) | (i,x) <- zip [0..] s ]
          t' = array (0,lt) [ (i,x) | (i,x) <- zip [0..] t ]
          ls = length s
          lt = length t
          (l,h) = ((0,0),(length s,length t))
          d = runSTUArray $ do
                m <- newArray (l,h) 0 
                for_ [0..ls] $ \i -> writeArray m (i,0) i
                for_ [0..lt] $ \j -> writeArray m (0,j) j
                for_ [1..lt] $ \j -> do
                              for_ [1..ls] $ \i -> do
                                  let c = if s'!(i-1)==t'! (j-1) 
                                          then 0 else 1
                                  x <- readArray m (i-1,j)
                                  y <- readArray m (i,j-1)
                                  z <- readArray m (i-1,j-1)
                                  writeArray m (i,j) $ minimum [x+1, y+1, z+c ]
                return m

for_ xs f =  mapM_ f xs