perl - 如何确定几个字符串中最长的相似部分？

Question

根据标题，我试图找到一种方法来以编程方式确定几个字符串之间相似性的最长部分。

例子:

• file:///home/gms8994/Music/t.A.T.u./
• file:///home/gms8994/Music/nina%20sky/
• file:///home/gms8994/Music/A%20Perfect%20Circle/

理想情况下，我会返回 file:///home/gms8994/Music/，因为这是所有 3 个字符串共有的最长部分。

具体来说，我正在寻找 Perl 解决方案，但任何语言(甚至伪语言)的解决方案就足够了。

来自评论:是的，只是在开始；但是有可能在列表中有一些其他条目，对于这个问题将被忽略。

Answer 1

编辑:很抱歉弄错了。遗憾的是，我发现在 countit(x, q{}) 中使用 my 变量是一个大错误。该字符串在 Benchmark 模块中进行评估，@str 在那里是空的。这个解决方案没有我介绍的那么快。请参阅下面的更正。再次抱歉。

Perl 可以很快:

use strict;
use warnings;

package LCP;

sub LCP {
    return '' unless @_;
    return $_[0] if @_ == 1;
    my $i          = 0;
    my $first      = shift;
    my $min_length = length($first);
    foreach (@_) {
        $min_length = length($_) if length($_) < $min_length;
    }
INDEX: foreach my $ch ( split //, $first ) {
        last INDEX unless $i < $min_length;
        foreach my $string (@_) {
            last INDEX if substr($string, $i, 1) ne $ch;
        }
    }
    continue { $i++ }
    return substr $first, 0, $i;
}

# Roy's implementation
sub LCP2 {
    return '' unless @_;
    my $prefix = shift;
    for (@_) {
        chop $prefix while (! /^\Q$prefix\E/);
        }
    return $prefix;
}

1;

测试套件:

#!/usr/bin/env perl

use strict;
use warnings;

Test::LCP->runtests;

package Test::LCP;

use base 'Test::Class';
use Test::More;
use Benchmark qw(:all :hireswallclock);

sub test_use : Test(startup => 1) {
    use_ok('LCP');
}

sub test_lcp : Test(6) {
    is( LCP::LCP(),      '',    'Without parameters' );
    is( LCP::LCP('abc'), 'abc', 'One parameter' );
    is( LCP::LCP( 'abc', 'xyz' ), '', 'None of common prefix' );
    is( LCP::LCP( 'abcdefgh', ('abcdefgh') x 15, 'abcdxyz' ),
        'abcd', 'Some common prefix' );
    my @str = map { chomp; $_ } <DATA>;
    is( LCP::LCP(@str),
        'file:///home/gms8994/Music/', 'Test data prefix' );
    is( LCP::LCP2(@str),
        'file:///home/gms8994/Music/', 'Test data prefix by LCP2' );
    my $t = countit( 1, sub{LCP::LCP(@str)} );
    diag("LCP: ${\($t->iters)} iterations took ${\(timestr($t))}");
    $t = countit( 1, sub{LCP::LCP2(@str)} );
    diag("LCP2: ${\($t->iters)} iterations took ${\(timestr($t))}");
}

__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/

测试套件结果:

1..7
ok 1 - use LCP;
ok 2 - Without parameters
ok 3 - One parameter
ok 4 - None of common prefix
ok 5 - Some common prefix
ok 6 - Test data prefix
ok 7 - Test data prefix by LCP2
# LCP: 22635 iterations took 1.09948 wallclock secs ( 1.09 usr +  0.00 sys =  1.09 CPU) @ 20766.06/s (n=22635)
# LCP2: 17919 iterations took 1.06787 wallclock secs ( 1.07 usr +  0.00 sys =  1.07 CPU) @ 16746.73/s (n=17919)

这意味着使用 substr 的纯 Perl 解决方案比 Roy's solution 快大约 20%在您的测试用例中，查找一个前缀大约需要 50us。除非您的数据或性能期望更大，否则没有必要使用 XS。