9

タイトルのとおり、いくつかの文字列間の類似性の最長部分をプログラムで判断する方法を見つけようとしています。

例：

  • 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 ソリューションを探していますが、任意の言語 (または擬似言語) でのソリューションで十分です。

コメントから: はい、最初だけです。ただし、この質問では無視されるリストに他のエントリが含まれている可能性があります。

4

7 に答える 7

8

編集：間違いをお詫びします。my内部で変数を使用すること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, 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)

これは、使用する純粋な Perl ソリューションが、テスト ケースでRoy のソリューションsubstrよりも約 20% 高速であり、1 つのプレフィックスの検出に約 50us かかることを意味します。データやパフォーマンスに対する期待が大きくない限り、XS を使用する必要はありません。

于 2009-02-01T09:56:21.890 に答える
3

私の最初の本能は、文字が等しくなくなるまで、各文字列から次の文字を取得してループを実行することです。文字列のどの位置にいるのかを数えてから、(3 つの文字列のいずれかから) 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 は少し錆びています。

于 2009-02-01T01:48:22.937 に答える
1

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";
于 2009-02-01T12:00:58.503 に答える
1

上記よりも高速で、perlmongers ソリューションから適応した perl のネイティブ バイナリ xor 関数を使用します ($+[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;
}
于 2012-02-28T21:15:45.823 に答える