File Coverage

blib/lib/LCS/Similar.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	16	16	100.0
condition	19	20	100.0
subroutine	9	9	100.0
pod	4	4	100.0
total	93	94	100.0

package LCS::Similar;

use 5.010001;
use strict;
use warnings;
our $VERSION = '0.04';
#use utf8;
#use Data::Dumper;

sub new {
    my $class = shift;
    # uncoverable condition false
    bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
}

sub LCS {
    my ($self, $a, $b, $compare, $threshold) = @_;

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

    $compare //= sub { $_[0] eq $_[1] };

    #my $m = scalar @$a;
    my $m = $amax - $amin +1;
    #my $n = scalar @$b;
    my $n = $bmax - $bmin +1;

    my $c = [];
    my ($i,$j);
    for ($i=0; $i<=$m; $i++) {
        for ($j=0;$j<=$n;$j++) {
            $c->[$i][$j]=0;
        }
    }
    for ($i=1; $i<=$m; $i++) { # my $j ($bmin..$bmax)
        for ($j=1; $j<=$n; $j++) {
            $c->[$i][$j] = $self->max3(
                &$compare(
                    $a->[$amin + $i-1],
                    $b->[$bmin + $j-1],
                    $threshold
                ) + $c->[$i-1][$j-1],
                $c->[$i][$j-1],
                $c->[$i-1][$j],
            );
        }
    }
    my $path = $self->_lcs($a, $b, $amin, $bmin, $c, $m, $n,[],$compare, $threshold);
    ##return $path;
    return [
        map([$_ => $_], 0 .. ($bmin-1)), ## no critic qw(BuiltinFunctions::RequireBlockMap)
            @$path,
            map([++$amax => $_], ($bmax+1) .. $#$b) ## no critic qw(BuiltinFunctions::RequireBlockMap)
    ];
}


sub max { ($_[1] > $_[2]) ? $_[1] : $_[2]; }

sub max3 {
    ($_[1] >= $_[2])
        ? ($_[1] >= $_[3]
            ? $_[1] : $_[3]
        )
        : ($_[2] >= $_[3]
            ? $_[2] : $_[3]
        );
}

sub _lcs {
    my ($self, $a, $b, $amin, $bmin, $c, $i, $j, $L, $compare, $threshold) = @_;

    while ($i > 0 && $j > 0) {
        if ( &$compare($a->[$amin + $i-1],$b->[$bmin + $j-1], $threshold) ) {
            unshift @{$L},[$amin + $i-1, $bmin + $j-1];
            $i--;
            $j--;
        }
        elsif ( $c->[$i][$j] == $c->[$i-1][$j] ) {
            $i--;
        }
        else {
            $j--;
        }
    }
    return $L;
}

1;

__END__