File Coverage

blib/lib/Algorithm/LCSS.pm
Criterion Covered Total %
statement 71 71 100.0
branch 22 22 100.0
condition n/a
subroutine 15 15 100.0
pod 3 3 100.0
total 111 111 100.0


line stmt bran cond sub pod time code
1             package Algorithm::LCSS;
2              
3 1     1   6788 use 5.006;
  1         3  
  1         42  
4 1     1   5 use strict;
  1         2  
  1         32  
5 1     1   5 use warnings;
  1         8  
  1         43  
6 1     1   1169 use Algorithm::Diff qw(traverse_sequences);
  1         7119  
  1         98  
7             require Exporter;
8 1     1   10 use vars qw( @ISA @EXPORT_OK $VERSION );
  1         2  
  1         937  
9             our @ISA = qw(Exporter);
10             @EXPORT_OK = qw( LCSS CSS CSS_Sorted );
11             $VERSION = '0.01';
12              
13 4     4   52 sub _tokenize { [split //, $_[0]] }
14              
15             sub CSS {
16 4 100   4 1 13 my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
17 4         5 my ( $seq1, $seq2, @match, $from_match );
18 4         6 my $i = 0;
19 4 100       9 if ( $is_array ) {
20 2         3 $seq1 = $_[0];
21 2         2 $seq2 = $_[1];
22             traverse_sequences( $seq1, $seq2, {
23 26     26   104 MATCH => sub { push @{$match[$i]}, $seq1->[$_[0]]; $from_match = 1 },
  26         46  
  26         53  
24 26 100   26   81 DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
  2         2  
  2         4  
25 26 100   26   1382 DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
  4         4  
  4         10  
26 2         23 });
27             }
28             else {
29 2         8 $seq1 = _tokenize($_[0]);
30 2         10 $seq2 = _tokenize($_[1]);
31             traverse_sequences( $seq1, $seq2, {
32 26     26   108 MATCH => sub { $match[$i] .= $seq1->[$_[0]]; $from_match = 1 },
  26         41  
33 26 100   26   84 DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
  2         3  
  2         4  
34 26 100   26   1389 DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
  4         4  
  4         9  
35 2         32 });
36             }
37 4         55 return \@match;
38             }
39              
40             sub CSS_Sorted {
41 2     2 1 298 my $match = CSS(@_);
42 2 100       6 if ( ref $_[0] eq 'ARRAY' ) {
43 1         2 @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match
  3         6  
  2         5  
  3         8  
44             }
45             else {
46 1         3 @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match
  3         7  
  2         7  
  3         13  
47             }
48 2         7 return $match;
49             }
50              
51             sub LCSS {
52 2 100   2 1 222 my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
53 2         4 my $css = CSS(@_);
54 2         3 my $index;
55 2         3 my $length = 0;
56 2 100       6 if ( $is_array ) {
57 1         31 for( my $i = 0; $i < @$css; $i++ ) {
58 3 100       5 next unless @{$css->[$i]}>$length;
  3         10  
59 2         3 $index = $i;
60 2         3 $length = @{$css->[$i]};
  2         6  
61             }
62             }
63             else {
64 1         6 for( my $i = 0; $i < @$css; $i++ ) {
65 3 100       9 next unless length($css->[$i])>$length;
66 2         2 $index = $i;
67 2         8 $length = length($css->[$i]);
68             }
69             }
70 2         17 return $css->[$index];
71             }
72              
73             1;
74             __END__