Suffix arrays in perl? - string

Question

This question is closely related to another stackoverflow question. Looking for a very efficient solution to the question asked there. Have suffix arrays been implemented in perl ?
Here is my current solution in 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;
}
How can this be improved ?
EDIT
Stating the problem here :
For two strings A and B, we define the similarity of the strings to be the length of the longest prefix common to both strings. For example, the similarity of strings "abc" and "abd" is 2, while the similarity of strings "aaa" and "aaab" is 3.
The problem is to give an algorithm to calculate the sum of similarities of a string S with each of it's suffixes. For example, let the string be : ababaa. Then, the suffixes of the string are ababaa, babaa, abaa, baa, aa and a. The similarities of each of these strings with the string ababaa are 6,0,3,0,1,1, respectively. Thus the answer is 6 + 0 + 3 + 0 + 1 + 1 = 11

Answer 1

What about Array::Suffix?

Answer 2

Flesk's solution is pretty elegant. You asked for efficiency, then you asked for improvement. When it comes to perl, I find whatever takes the less time to understand when coming back to it after 3 months to be the best improvement. So take into consideration something a little more descriptive:
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;
}
There are obvious inefficiencies that could be improved (loops, regex comparison, subroutine call), but the point of this answer is an alternative to something that I've already identified as better for the only benefit of better future comprehension.

Answer 3

If I understand the algorithm correctly and you want to calculate the sum of longest common prefixes, your implementation is incorrect, since you're lacking the ascending lexicographic sort.
Here's one way to solve your problem:
#!/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++];
}
For the example string ababaa in the question you refer to this will produce the suffix array
5 | a
4 | aa
2 | abaa
0 | ababaa
3 | baa
1 | babaa
represented by #subipstrs
#subipstrs = (
['a'],
['a', 'a'],
['a', 'b', 'a', 'a'],
['a', 'b', 'a', 'b', 'a', 'a'],
['b', 'a', 'a'],
['b', 'a', 'b', 'a', 'a']
);
This makes calculating lcps a matter of comparing neighboring array refs element by element while pairs match, and adding up the total number of matches. The result is
5 | a | 0
4 | aa | 1
2 | abaa | 1
0 | ababaa | 3
3 | baa | 0
1 | babaa | 2
With a total of 7, not 11.
EDIT: This solves the problem you're interested in:
#!/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);
}
And is a bit faster than your solution with your example string and 1M iterations:
trinity 80906/s -- -32%
flesk 119332/s 47% --
EDIT2: This one's faster because it works from the start of the strings and are able to discard negative matches faster:
#!/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 and 100K iterations:
trinity 81967/s -- -24%
flesk 107527/s 31% --
abcdefghijklmnopqrstuvwxyz and 100K iterations:
trinity 26178/s -- -15%
flesk 30769/s 18% --
aaaaaaaaaaabbbaaaaaaaaaaaaaaaabbbaaaaaaaaa and 100K iterations:
trinity 5435/s -- -30%
flesk 7800/s 44% --
The algorithm can probably be improved further by reversing $ipstr before the loop or just using substrs instead of chop.