VPF::Расстояние Левенштейна - как ускорить алгоритм?

Suppir

Дата 29.4.2011, 11:39 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 588
Регистрация: 20.4.2009

Репутация: нет
Всего: нет

Есть две строки: $line1 и $line2

Нужно сделать максимально быстрое сравнение этих строк:
1) разный регистр, буквы ё/е, пробелы - за разницу не считаются (функция simplify());
2) если в строках есть небольшие отличия (расстояние Левенштейна от 0 до 4), то вывести в лог
если же отличия более существенные, то не нужно.

Проблема в том, что этот алгоритм адски медленно работает. Нужно сравнивать несколько десятков тысяч пар строк. Первичный отсев производится с помощью более быстрой функции index, но все равно слишком медленно работает все smile

Как можно ускорить код?

Код



$simp_line1 = simplify($line1);
$simp_line2 = simplify($line2);
if (index ($simp_line1, $simp_line2) < 0){
    $result = levenstein($simp_gname, $simp_kname);
    if ($result > 0 && $result < 4){
        print LOG "$line1\n$line2\n\n"
    }
}


sub levenstein($$){
    my @A=split //, lc shift;
    my @B=split //, lc shift;
    my @W=(0..@B);
    my ($i, $j, $cur, $next);
    for $i (0..$#A){
        $cur=$i+1;
        for $j (0..$#B){
            $next=min(
            $W[$j+1]+1,
            $cur+1,
            ($A[$i] ne $B[$j])+$W[$j]);
            $W[$j]=$cur;
            $cur=$next;
        }
        $W[@B]=$next;
    }
    return $next;
}

sub min($$$){
    if ($_[0] < $_[2]){pop @_} else {shift @_}
    return $_[0] < $_[1]? $_[0]:$_[1];
}


sub simplify{
    local $a = $_[0];
    $a = lc($a);
    $a =~ tr/ё/е/;
    $a =~ s/[  ]+//g;
    return $a;
}

Это сообщение отредактировал(а) Suppir - 29.4.2011, 12:36

KSURi

Дата 29.4.2011, 12:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 887
Регистрация: 8.6.2006
Где: Russia

Репутация: 20
Всего: 27

Text::LevenshteinXS?

PS: у этого модуля с юникодом были проблемы; не знаю, пофиксили-ли.

--------------------

Died at Life.pl line 21

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »