File Coverage

blib/lib/LCS/Similar.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	16	16	100.0
condition	7	8	100.0
subroutine	9	9	100.0
pod	4	4	100.0
total	74	75	100.0

package LCS::Similar;

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

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

sub LCS {
  my ($self, $X, $Y, $compare, $threshold) = @_;

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

  my $m = scalar @$X;
  my $n = scalar @$Y;

  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++) {
    for ($j=1;$j<=$n;$j++) {
      $c->[$i][$j] = $self->max3(
        &$compare(
            $X->[$i-1],
            $Y->[$j-1],
            $threshold
          ) + $c->[$i-1][$j-1],
        $c->[$i][$j-1],
        $c->[$i-1][$j],
      );
    }
  }
  my $path = $self->_lcs($X,$Y,$c,$m,$n,[],$compare, $threshold);
  return $path;
}


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

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

sub _lcs {
  my ($self,$X,$Y,$c,$i,$j,$L,$compare, $threshold) = @_;

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

1;

__END__