File Coverage

blib/lib/LCS/Tiny.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	20	20	100.0
condition	17	18	100.0
subroutine	6	6	100.0
pod	2	2	100.0
total	101	102	100.0

package LCS::Tiny;

use 5.006;
use strict;
use warnings;
our $VERSION = '0.09';
#use utf8;

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

# Implemented according to

# J. W. Hunt and T. G. Szymanski.
# A fast algorithm for computing longest common subsequences.
# Commun. ACM, 20(5):350-353, 1977.

sub LCS {
  my ($self, $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 $bMatches;
  unshift @{ $bMatches->{$b->[$_]} },$_ for $bmin..$bmax;

  my $matchVector = [];
  my $thresh = [];
  my $links  = [];

  my ( $i, $ai, $j, $k );
  for ( $i = $amin ; $i <= $amax ; $i++ ) {
    $ai = $a->[$i];
    if ( exists( $bMatches->{$ai} ) ) {
      for $j ( @{ $bMatches->{$ai} } ) {
        if ( !@$thresh || $j > $thresh->[-1] ) {
          $k = $#$thresh+1;
          $thresh->[$k] = $j;
        }
        #elsif ( $k and $thresh->[$k] > $j and $thresh->[ $k - 1 ] < $j ) {
        #  $thresh->[$k] = $j;
        #}
        else {
          # binary search for insertion point
          $k = 0;
          my $index;
          my $found;
          my $high = $#$thresh;
          while ( $k <= $high ) {
            use integer;
            $index = ( $high + $k ) / 2;
            #$index = int(( $high + $k ) / 2);  # without 'use integer'
            $found = $thresh->[$index];

            if ( $j == $found ) { $k = undef; last; }
            elsif ( $j > $found ) { $k = $index + 1; }
            else { $high = $index - 1; }
          }
          # now insertion point is in $k.
          $thresh->[$k] = $j if (defined $k);    # overwrite next larger
        }
        if (defined $k) {
          $links->[$k] = [ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ];
        }
      }
    }
  }
  if (@$thresh) {
    for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] ) {
      unshift @$matchVector,[$link->[1],$link->[2]];
    }
  }
  return [ map([$_ => $_], 0 .. ($bmin-1)),
        @$matchVector,
            map([++$amax => $_], ($bmax+1) .. $#$b) ];
}

1;

__END__