perlのサフィックス配列？

Question

この質問は、another stackoverflow questionと密接に関連しています。質問に非常に効率的な解決策を探して、そこに尋ねた。接尾辞配列はperlで実装されていますか？

ここは私の現在のperlでの解決方法です。

chomp(my $ipstr = <>); 
my @bigstrchars = split(//, $ipstr); 
my $length = (length $ipstr); 
my $sum = 0; 
my $span = 1; 
my $flag = 0; 
while ($span < $length) { 
     for ($j=0; $j+$span<$length; $j++) { 
       if ($bigstrchars[$j] eq $bigstrchars[$j+$span]) { 
         $sum++; 
       } 
       else { 
         last; 
       } 
     } 
     if ($span == 1 && $sum == ($length-1)) { 
      $sum = $length * ($length+1) * 0.5; 
      $flag = 1; 
      last; 
     } 
     $span++; 
} 
unless ($flag) { 
    $sum += $length; 
} 

これをどのように改善できますか？ここでの問題を述べ

EDIT

：二つの文字列AとBのために

は、我々は両方の文字列に共通する最長のプレフィックスの長さであることを文字列の類似性を定義します。例えば、文字列 "abc"と "abd"の類似度は2であり、文字列 "aaa"と "aaab"の類似度は3です。

問題は、類似性の合計を計算するアルゴリズムを与えることです。それぞれに接尾辞が付いた文字列Sです。たとえば、文字列をababaaとします。次に、文字列の接尾辞は、ababaa、babaa、abaa、baa、aaおよびaです。これらの文字列と文字列ababaaの類似点は、それぞれ6,0,3,0,1,1です。したがって、答えは6 + 0 + 3 + 0 + 1 + 1 = 11

Answer 1

約Array::Suffixについては？

Answer 2

アルゴリズムを正しく理解していて、最も長い共通接頭辞の合計を計算したい場合は、昇順の辞書順ソートがないため実装が正しくありません。 @subipstrs

@subipstrs = (
    ['a'], 
    ['a', 'a'], 
    ['a', 'b', 'a', 'a'], 
    ['a', 'b', 'a', 'b', 'a', 'a'], 
    ['b', 'a', 'a'], 
    ['b', 'a', 'b', 'a', 'a'] 
); 

によって表される接尾辞配列

5 | a 
4 | aa 
2 | abaa 
0 | ababaa 
3 | baa 
1 | babaa 

が生成されます、あなたがこれを参照する問題の例文字列ababaaについては

#!/usr/bin/perl 
use strict; 
use warnings; 

chomp(my $ipstr = <>);  
my @subipstrs = map [split//], sort map{substr $ipstr, $_} 0 .. length($ipstr) - 1; 
my $sum = 0; 

for my $i (1 .. $#subipstrs) { 
    my @last = @{$subipstrs[$i-1]}; 
    my @this = @{$subipstrs[$i]}; 
    my $j = 0; 
    $sum++ while $j < @last && $j < @this && $last[$j] eq $this[$j++]; 
} 

：

はここにあなたの問題を解決する一つの方法です

これは、 lcpは、ペアが一致している間に要素ごとに隣接配列refsを比較し、一致の総数を合計します。結果は、の合計ではなく、11で

5 | a  | 0 
4 | aa  | 1 
2 | abaa | 1 
0 | ababaa | 3 
3 | baa | 0 
1 | babaa | 2 

あります。

EDIT：これは、あなたが興味を持っている問題解決：

#!/usr/bin/perl 
use strict; 
use warnings; 

chomp(my $ipstr = <>); 
my $len = my $sum = length($ipstr); 

for my $i (1 .. $len -1) { 
    my $substr = substr $ipstr, $i; 
    chop $substr while $substr ne substr $ipstr, 0, length($substr); 
    $sum += length($substr); 
} 

をそしてあなたの例の文字列と1Mの繰り返しで少し速くあなたのソリューションより：

trinity 80906/s  -- -32% 
flesk 119332/s  47%  -- 

EDIT2 ：これは文字列の最初から動作し、より速くネガティブマッチを破棄することができるため、高速です。

#!/usr/bin/perl 
use strict; 
use warnings; 

chomp(my $ipstr = <>); 
my $len = my $sum = length($ipstr); 

for my $i (1 .. $len - 1) { 
    my $ipstrcopy = reverse $ipstr; 
    my $substr = reverse substr $ipstr, $i; 
    my ($slen, $j) = (length($substr), 0); 
    $sum++ while $j++ <= $slen && chop $ipstrcopy eq chop $substr; 
} 

ababaa及び100K反復：

trinity 81967/s  -- -24% 
flesk 107527/s  31%  -- 

abcdefghijklmnopqrstuvwxyz及び100K反復：

trinity 26178/s  -- -15% 
flesk 30769/s  18%  -- 

aaaaaaaaaaabbbaaaaaaaaaaaaaaaabbbaaaaaaaaa及び100K反復：

trinity 5435/s  -- -30% 
flesk 7800/s  44%  -- 

アルゴリズムは、おそらく逆にすることによってさらに改善することができますループの前に$ipstrを使用するか、chopの代わりにsubstrを使用します。

Answer 3

フレスクのソリューションはかなりエレガントです。あなたは効率を求めた後、改善を求めました。 Perlに関しては、3ヶ月後に改善のために戻ってくるときに理解する時間が少なくて済みます。そこ改善される可能性が明らかに非効率（ループ、正規表現の比較、サブルーチンコールが）ですが、この答えのポイントは、私がきた何かに代わるものです

use Data::Dumper; 
use strict; 

    main(); 

    sub main { 
     my $string = "ababaa";       # input string 
     my $parts;          # hash ref 
     my @suffixes = split '',$string;    # break input into tokens 
     my $running_sum = 0; 
     $"=''; 

     # Build suffix tree 
     for (0..$#suffixes){ 
     $parts->{"@suffixes"}=0; 
     shift @suffixes; 
     } 


     # Compare suffixes to initial string 
     for my $suffix (sort keys %$parts){ 
      $parts->{$suffix} = getMatches($suffix,$string); 
      $running_sum  += $parts->{$suffix}; 
     } 

     # Output 
     $Data::Dumper::Sortkeys++; 
     print Dumper($parts), "\nTotal Matches: $running_sum"; 
    } 

    sub getMatches{ 
     my ($word,$string) = @_; 
     my $part = ''; 
     my $offset = 0; 
     my $matches = 0; 

     for (0..(length($word) - 1)){ 
     $offset++; 
     $part = substr($word,0,$offset); 
     if ($string =~ /^$part/){ $matches++; } 
     } 
     return $matches; 
    } 

：だから考慮にもう少し説明的なものを取ります将来の理解を向上させる唯一の利点としてすでに優れていると認識されています。