File Coverage

blib/lib/Algorithm/LCS/XS.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	4	8	50.0
condition	9	18	50.0
subroutine	11	11	100.0
pod	3	5	60.0
total	76	91	83.5

package Algorithm::LCS::XS;

use 5.008;
use strict;
use warnings;
use version;
our $VERSION = qv(2.0.0);
use base 'Exporter';
our @EXPORT_OK = qw/&ADLCS &LCSidx/;
require XSLoader;
XSLoader::load('Algorithm::LCS::XS', $VERSION);

##############################
# code adapted from Algorithm::Diff

sub line_map {
    my $ctx = shift;
    my %lines;
    push @{ $lines{$_[$_]} }, $_ for 0..$#_; # values MUST be SvIOK
    \%lines;
}

sub callback {
    my ($ctx, @b) = @_;
    my $h = $ctx->line_map(@b);
    sub { @_ ? _core_loop($ctx, $_[0], 0, $#{$_[0]}, $h) : @b }
}

sub LCS {
    my ($ctx, $a, $b) = @_;
    my ($amin, $amax, $bmin, $bmax) = (0, $#$a, 0, $#$b);

    while ($amin <= $amax and $bmin <= $bmax and $a->[$amin] eq $b->[$bmin]) {
        $amin++;
        $bmin++;
    }
    while ($amin <= $amax and $bmin <= $bmax and $a->[$amax] eq $b->[$bmax]) {
        $amax--;
        $bmax--;
    }

    my $h = $ctx->line_map(@$b[$bmin..$bmax]); # line numbers are off by $bmin

    return $amin + _core_loop($ctx, $a, $amin, $amax, $h) + ($#$a - $amax)
        unless wantarray;

    my @lcs = _core_loop($ctx,$a,$amin,$amax,$h);
    if ($bmin > 0) {
        $_->[1] += $bmin for @lcs; # correct line numbers
    }

    map([$_ => $_], 0 .. ($amin-1)),
        @lcs,
            map([$_ => ++$bmax], ($amax+1) .. $#$a);
}


my $alg;

sub LCSidx {
    $alg //= Algorithm::LCS::XS->new;
    my (@l, @r);
    for my $arr ($alg->LCS(@_)) {
       push @l, $$arr[0];
       push @r, $$arr[1];
    }
    return \@l, \@r;
}

sub ADLCS {
    $alg //= Algorithm::LCS::XS->new;
    my @rv;
    for my $arr ($alg->LCS(@_)) {
      $rv[$arr->[0]] = $_[1][$arr->[0]];
    }
    return wantarray ? @rv : \@rv;
}

1;

__END__