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;
}

如何改进？

编辑

在这里说明问题：

对于两个字符串 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

Flesk 的解决方案非常优雅。你要求效率，然后你要求改进。当谈到 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;
   }

有明显的低效率可以改进（循环、正则表达式比较、子例程调用），但这个答案的重点是替代我已经确定为更好的东西，唯一的好处是更好的未来理解。

Answer 3

如果我正确理解算法并且您想计算最长公共前缀的总和，那么您的实现是不正确的，因为您缺少升序字典排序。

这是解决问题的一种方法：

#!/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++];
}

对于您提到的问题中的示例字符串ababaa，这将产生后缀数组

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

由@subipstrs代表

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

这使得计算lcps 只需在对匹配时逐个元素地比较相邻数组 refs，然后将匹配的总数相加。结果是

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

总共 7，而不是 11 个。

编辑：这解决了您感兴趣的问题：

#!/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 和 10 万次迭代：

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

abcdefghijklmnopqrstuvwxyz 和 10 万次迭代：

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

aaaaaaaaaaabbbaaaaaaaaaaaaaaaabbbaaaaaaaaa 和 10 万次迭代：

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

可以通过在循环之前反转$ipstr 或仅使用substrs 而不是chop 来进一步改进算法。