sub lcs {
my($x, $y) = @_;
my(@v, $cx, $cy, $left, $above);
for my $xi (0 .. length($x) - 1) {
$cx = substr $x, $xi, 1;
for my $yi (0 .. length($y) - 1) {
$cy = substr $y, $yi, 1;
if ($cx eq $cy) {
$v[$xi][$yi] = 1 + (($xi && $yi) ? $v[$xi - 1][$yi - 1] : 0);
} else {
$left = ($xi && $v[$xi - 1][$yi]) || 0;
$above = ($xi && $v[$xi][$yi - 1]) || 0;
$v[$xi][$yi] = ($left > $above) ? $left : $above;
}
}
}
return $v[length($x) - 1][length($y) - 1];
}
####
sub matchss {
my($ss, $str) = @_;
my @state = (1, (0) x length($ss));
my %index;
unshift @{ $index{substr $ss, $_ - 1, 1} }, $_ for 1 .. length($ss);
for (split //, $str) {
$state[$_] += $state[$_ - 1] for @{ $index{$_} || [] };
}
pop @state;
}
##
##
sub lcscount {
my($x, $y) = @_;
my $n = lcs($x, $y) or return 1;
my %seen;
my $count = 0;
my @x = split //, $x;
NestedLoops(
[
[ 0 .. $#x ],
( sub { [ $_ + 1 .. $#x ] } ) x ($n - 1),
],
sub {
my $ssx = join '', @x[@_];
return if $seen{$ssx}++;
$count += (matchss($ssx, $y) or return) * matchss($ssx, $x);
},
);
$count;
}
##
##
$count += $seen{$_} * matchss($_, $y) for keys %seen;