我该如何确定多个字符串中最长的相似部分？

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解决方案，但任何语言（甚至伪代码）的解决方案都可以。

从评论中可以得知：是只有在开头才有相似部分；但也有可能在列表中有其他条目，这些条目对于此问题将被忽略。

- gms8994

---

相似性是否必须从字符串的开头开始？如果是，那么很容易解决。如果不是，那么就有点复杂了。 - cletus

同样的查询 -- 我还要补充一点 -- 你所说的“相似”，是指“完全相同”吗？ - Scott Evernden

你提出的问题存在歧义。首先，类似是否意味着完全相同。另外，例如，如果有10个字符串在前15个字符中是共同的，其中又有5个字符串在另外7个字符中也是共同的，你想要哪个前缀？ - Tall Jeff

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 的解决方案快约20％，每个前缀查找大约需要50微秒。除非您的数据或性能期望更大，否则不必使用 XS。

- Hynek -Pichi- Vychodil

---

+1 表示添加一个测试套件，包括空字符串等情况；-1 表示关注在脚本语言中实现算法的性能调优。净得分为 0。 - j_random_hacker

并且-999用于表示困惑和沮丧；-( - Hynek -Pichi- Vychodil

这是一份很好的分析，但我会谨慎地鼓励过早进行优化。特别是对于新手编码者来说，代码清晰度更为重要。而且在这个问题中隐含的小规模使用可能不会从任何优化中获益。 - rivy

只是出于好奇，我制作了Erlang解决方案，发现它在BEAM解释下快了13倍，在HiPE编译下快了28倍。他们曾经说Erlang不适合字符串处理;-) - Hynek -Pichi- Vychodil

Answer 2

给出的Brett Daniel对于“最长公共子串问题”的维基百科条目已经是一个非常好的通用参考（带有伪代码），适用于你提出的问题。然而，该算法可能是指数级的。看起来你实际上可能需要一个更简单的算法，用于最长公共前缀。

这里是我用于最长公共前缀的算法（以及原始URL的参考）：

use strict; use warnings;
sub longest_common_prefix {
    # longest_common_prefix( $|@ ): returns $
    # URLref: http://linux.seindal.dk/2005/09/09/longest-common-prefix-in-perl
    # find longest common prefix of scalar list
    my $prefix = shift;
    for (@_) {
        chop $prefix while (! /^\Q$prefix\E/);
        }
    return $prefix;
}

my @str = map {chomp; $_} <DATA>;
print longest_common_prefix(@ARGV), "\n";
__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/

如果您真正想要实现LCSS，请参考PerlMonks.org上的这些讨论（最长公共子串和最长公共子序列）。对于您来说，Tree::Suffix可能是最好的通用解决方案，并且在我所知道的范围内实现了最佳算法。不幸的是，最近的构建已经崩溃了。但是，在PerlMonks中引用的这个Limbic~Region的帖子（在此处使用您的数据重复）中存在一个可工作的子例程。

#URLref: http://www.perlmonks.org/?node_id=549876
#by Limbic~Region
use Algorithm::Loops 'NestedLoops';
use List::Util 'reduce';

use strict; use warnings;

sub LCS{
    my @str = @_;
    my @pos;
    for my $i (0 .. $#str) {
        my $line = $str[$i];
        for (0 .. length($line) - 1) {
            my $char= substr($line, $_, 1);
            push @{$pos[$i]{$char}}, $_;
        }
    }
    my $sh_str = reduce {length($a) < length($b) ? $a : $b} @str;
    my %map;
    CHAR:
    for my $char (split //, $sh_str) {
        my @loop;
        for (0 .. $#pos) {
            next CHAR if ! $pos[$_]{$char};
            push @loop, $pos[$_]{$char};
        }
        my $next = NestedLoops([@loop]);
        while (my @char_map = $next->()) {
            my $key = join '-', @char_map;
            $map{$key} = $char;
        }
    }
    my @pile;
    for my $seq (keys %map) {
        push @pile, $map{$seq};
        for (1 .. 2) {
            my $dir = $_ % 2 ? 1 : -1;
            my @offset = split /-/, $seq;
            $_ += $dir for @offset;
            my $next = join '-', @offset;
            while (exists $map{$next}) {
                $pile[-1] = $dir > 0 ?
                    $pile[-1] . $map{$next} : $map{$next} . $pile[-1];
                $_ += $dir for @offset;
                $next = join '-', @offset;
            }
        }
    }
    return reduce {length($a) > length($b) ? $a : $b} @pile;
}

my @str = map {chomp; $_} <DATA>;
print LCS(@str), "\n";
__DATA__
file:///home/gms8994/Music/t.A.T.u./
file:///home/gms8994/Music/nina%20sky/
file:///home/gms8994/Music/A%20Perfect%20Circle/

- Roy

Answer 3

听起来你需要的是k-最长公共子串算法。这个算法非常易于编程，并且是动态规划的一个很好的例子。请参考维基百科了解更多信息。

- Brett Daniel

---

问题不是关于子字符串，而是前缀。对于所请求的问题，子字符串查找算法更加复杂和低效。 - Hynek -Pichi- Vychodil

Answer 4

我的第一反应是运行一个循环，从每个字符串中取下一个字符，直到字符不相等为止。保持计数器记录当前所在的位置，然后从任何一个字符串中取一个子字符串（三个字符串中的任意一个），从0到字符不相等之前的位置。

在Perl中，您需要先将字符串拆分为字符，例如使用以下语句：

@array = split(//, $string);

（在空字符上拆分会将每个字符设置为数组的单独元素）

然后进行循环，可能如下：

$n =0;
@array1 = split(//, $string1);
@array2 = split(//, $string2);
@array3 = split(//, $string3);

while($array1[$n] == $array2[$n] && $array2[$n] == $array3[$n]){
 $n++; 
}

$sameString = substr($string1, 0, $n); #n might have to be n-1

或者至少是类似的东西。如果这不奏效，请原谅，我的Perl有点生疏。

- Perchik

Answer 5

如果你搜索“最长公共子串”，你会得到一些关于一般情况的好指针，其中序列不必从字符串的开头开始。例如：http://en.wikipedia.org/wiki/Longest_common_substring_problem。

Mathematica恰好内置了此功能： http://reference.wolfram.com/mathematica/ref/LongestCommonSubsequence.html（请注意，它们的意思是连续子序列，即子字符串，这正是你想要的。）

如果你只关心最长公共前缀，那么只需要循环i从0到第i个字符不全匹配，然后返回substr(s, 0, i-1)就可以更快地完成。

- dreeves

---

问题不是关于子字符串，而是前缀。对于所请求的问题，子字符串查找算法更加复杂和低效。 - Hynek -Pichi- Vychodil

没错，我只是觉得对于那些以后搜索此类问题的人来说，给出最通用的答案是很好的。如果你只需要最长公共前缀，那么使用该方法会更快。我会编辑我的答案并指出这一点。 - dreeves

Answer 6

比上面更快，使用Perl的本地二进制XOR函数，改编自perlmongers的解决方案（$ + [0] 对我不起作用）：

sub common_suffix {
    my $comm = shift @_;
    while ($_ = shift @_) {
        $_ = substr($_,-length($comm)) if (length($_) > length($comm));
        $comm = substr($comm,-length($_)) if (length($_) < length($comm));
        if (( $_ ^ $comm ) =~ /(\0*)$/) {
            $comm = substr($comm, -length($1));
        } else {
            return undef;
        }
    }
    return $comm;
}


sub common_prefix {
    my $comm = shift @_;
    while ($_ = shift @_) {
        $_ = substr($_,0,length($comm)) if (length($_) > length($comm));
        $comm = substr($comm,0,length($_)) if (length($_) < length($comm));
        if (( $_ ^ $comm ) =~ /^(\0*)/) {
            $comm = substr($comm,0,length($1));
        } else {
            return undef;
        }
    }
    return $comm;
}

- Erik Aronesty

Answer 7

来自 http://forums.macosxhints.com/showthread.php?t=33780

my @strings =
    (
      'file:///home/gms8994/Music/t.A.T.u./',
      'file:///home/gms8994/Music/nina%20sky/',
      'file:///home/gms8994/Music/A%20Perfect%20Circle/',
    );

my $common_part = undef;
my $sep = chr(0);  # assuming it's not used legitimately
foreach my $str ( @strings ) {

    # First time through loop -- set common
    # to whole
    if ( !defined $common_part ) {
        $common_part = $str;
        next;
    }

    if ("$common_part$sep$str" =~ /^(.*).*$sep\1.*$/)
    {
        $common_part = $1;
    }
}

print "Common part = $common_part\n";

- Hissohathair

---

对于您正在处理的字符串长度可能并不重要，但对于较长的字符串来说，这将非常缓慢。即使Perl可以优化正则表达式中最终的“.$”，每次循环迭代都需要O(n^2)时间才能找到正确的匹配方式以匹配初始的“..*”。 - j_random_hacker

使用 .*$ 对我来说看起来毫无用处。这个解决方案很好地工作，并且几乎和我的一样快。 - Hynek -Pichi- Vychodil