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

前端之家收集整理的这篇文章主要介绍了perl – 如何确定几个字符串中最长的相似部分?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
根据标题,我试图找到一种方法来以编程方式确定几个字符串之间最长的相似性部分.

例:

> file:///home/gms8994/Music/t.A.T.u./
> file:/// home / gms8994 / Music / nina sky /
> file:/// home / gms8994 / Music / A Perfect Circle /

理想情况下,我会回复文件:/// home / gms8994 / Music /,因为这是所有3个字符串中最常见的部分.

具体来说,我正在寻找一个Perl解决方案,但任何语言(甚至伪语言)的解决方案都足够了.

评论:是的,仅在开头;但是有可能在列表中有一些其他条目,这个问题将被忽略.

解决方法

编辑:对不起,我很抱歉.我很遗憾,我监督在countit(x,q {})中使用我的变量是一个很大的错误.此字符串在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,$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),'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.

原文链接:https://www.f2er.com/Perl/172420.html

猜你在找的Perl相关文章