编辑距离:忽略start/end

Edit distance: Ignore start/end

我正在寻找一种可以编辑距离的算法,但它会忽略一个字符串中的开始+结束和白色 space:

edit("four","foor") = 1
edit("four","noise fo or blur") = 1

有现成的算法吗?甚至是 Perl 或 Python 库?

执行此操作的代码在概念上很简单。您可以自己添加自己想要忽略的内容:

#!perl
use v5.22;
use feature qw(signatures);
no warnings qw(experimental::signatures);

use Text::Levenshtein qw(distance);

say edit( "four", "foor" );
say edit( "four", "noise fo or blur" );

sub edit ( $start, $target ) {
    # transform strings to ignore what you want
    # ...
    distance( $start, $target )
    }

也许您想检查相同长度的所有子串:

use v5.22;
use feature qw(signatures);
no warnings qw(experimental::signatures);

use Text::Levenshtein qw(distance);

say edit( "four", "foar" );
say edit( "four", "noise fo or blur" );

sub edit ( $start, $target ) {
    my $start_length = length $start;
    $target =~ s/\s+//g;
    my @all_n_chars = map {
        substr $target, $_, 4
        } 0 .. ( length($target) - $start_length );

    my $closest;
    my $closest_distance = $start_length + 1;
    foreach ( @all_n_chars ) {
        my $distance = distance( $start, $_ );
        if( $distance < $closest_distance ) {
            $closest = $_;
            $closest_distance = $distance;
            say "closest: $closest Distance: $distance";
            last if $distance == 0;
            }
        }

    return $closest_distance;
    }

这个非常简单的实现找到了你想要的。但是,请注意其他随机字符串可能意外地具有更小的编辑距离。

closest: foar Distance: 1
1
closest: nois Distance: 3
closest: foor Distance: 1
1

您可以扩展它以记住每个字符串的真实起始位置,以便您可以在原始字符串中再次找到它,但这应该足以让您继续前进。如果你想用Python,我觉得这个程序可能看起来很相似。

这是一个 Perl 6 解决方案。我使用的语法知道如何抓住四个有趣的字符,尽管有间隙的东西。更复杂的需求需要不同的语法,但这并不难。

每次匹配时,NString::Actions class 对象都会进行更改以检查匹配。它做的事情和我之前做的一样。这看起来需要做更多的工作,而且是针对这个简单的例子。对于更复杂的示例,情况不会变得更糟。我的 Perl 5 版本必须做很多工具来确定保留或不保留的内容。

use Text::Levenshtein;

my $string = 'The quixotic purple and jasmine butterfly flew over the quick zany dog';

grammar NString {
    regex n-chars      { [<.ignore-chars>* \w]**4 }
    regex ignore-chars { \s }
    }

class NString::Actions {
    # See 
    my subset IntInf where Int:D | Inf;

    has        $.target;
    has Str    $.closest          is rw = '';
    has IntInf $.closest-distance is rw = Inf;

    method n-chars ($/) {
        my $string = $/.subst: /\s+/, '', :g;

        my $distance = distance( $string,  self.target );
        # say "Matched <$/>. Distance for $string is $distance";
        if $distance < self.closest-distance {
            self.closest = $string;
            self.closest-distance = $distance;
            }
        }
    }

my $action =  NString::Actions.new: target => 'Perl';

loop {
    state $from = 0;
    my $match = NString.subparse(
        $string,
        :rule('n-chars'),
        :actions($action),
        :c($from)
        );
    last unless ?$match;

    $from++;
    }

say "Shortest is { $action.closest } with { $action.closest-distance }";

(我从 Perl 5 做了一个直接移植,我将保留在这里)

我在 Perl 6 中尝试过同样的事情,但我确信这有点冗长。我想知道是否有一种聪明的方法来获取 N 个字符组进行比较。也许以后我会有一些进步。

use Text::Levenshtein;

put edit( "four", "foar" );
put edit( "four", "noise fo or blur" );

sub edit ( Str:D $start, Str:D $target --> Int:D ) {
    my $target-modified = $target.subst: rx/\s+/, '',  :g;

    my $last-position-to-check = [-] map { .chars }, $target-modified, $start;

    my $closest = Any;
    my $closest-distance = $start.chars + 1;
    for 0..$last-position-to-check -> $starting-pos {
        my $substr = $target-modified.substr: $starting-pos, $start.chars;
        my $this-distance = distance( $start, $substr );
        put "So far: $substr -> $this-distance";
        if $this-distance < $closest-distance {
            $closest          = $substr;
            $closest-distance = $this-distance;
            }
        last if $this-distance = 0;
        }

    return $closest-distance // -1;
    }