未测试
sub cm
{
my @a = shift;
my @b = shift;
# First match prefix of string:
my $n = 0;
while ($n < $#a && $n < $#b && $a[$n] eq $b[$n]) {
++$n;
}
# Then skip one char on either side, and recurse.
if ($n < $#a && $n < $#b) {
# Match rest by skipping one place:
my $n2best = 0;
my $n2a = cm(splice(@a, $n), splice(@b, $n + 1));
$n2best = $n2a;
my $n2b = cm(splice(@a, $n + 1), splice(@b, $n));
$n2best = $n2b if $n2b > $n2best;
my $n2c = cm(splice(@a, $n + 1), splice(@b, $n + 1));
$n2best = $n2c if $n2c > $n2best;
$n += $n2best;
}
return $n;
}
sub count_matches
{
my $a = shift;
my $b = shift;
my @a_chars = split //, $a;
my @b_chars = split //, $b;
return cm(@a_chars, @b_chars);
}
print count_matches('stranger', 'strangem')