File Coverage

blib/lib/Algorithm/HowSimilar.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	7	8	87.5
condition	3	6	50.0
subroutine	14	14	100.0
pod	1	1	100.0
total	78	82	95.1

package Algorithm::HowSimilar;

use 5.006;
use strict;
use warnings;
use Algorithm::Diff qw(traverse_sequences);
use Carp;
require Exporter;
use vars qw( @ISA @EXPORT_OK $VERSION );
our @ISA = qw(Exporter);
@EXPORT_OK = qw( compare );
$VERSION = '0.01';

sub compare {
    my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
    my $i = 0;
    if ( $is_array ) {
        my $seq1 = $_[0];
        my $seq2 = $_[1];
        my (@match,@d1, @d2) = ((),(),());
        traverse_sequences( $seq1, $seq2, {
            MATCH     => sub { push @match, $seq1->[$_[0]] },
            DISCARD_A => sub { push @d1, $seq1->[$_[0]] },
            DISCARD_B => sub { push @d2, $seq2->[$_[1]] },
        });
        my $m1 = @match/(@match+@d1);
        my $m2 = @match/(@match+@d2);
        my $mav = ($m1+$m2)/2;
      return $mav, $m1, $m2, \@match, \@d1, \@d2;
    }
    else {
        my ( $seq1, $seq2 );
        if ( $_[2] and ref $_[2] eq 'CODE' ) {
            local $_ = $_[0]; $seq1 = &{$_[2]};
            local $_ = $_[1]; $seq2 = &{$_[2]};
            carp "Did not get an array ref from callback!\n"
                unless ref $seq1 eq 'ARRAY' and ref $seq2 eq 'ARRAY';
        }
        else {
            $seq1 = _tokenize($_[0]);
            $seq2 = _tokenize($_[1]);
        }
        my ($match,$d1, $d2) = ('','','');
        traverse_sequences( $seq1, $seq2, {
            MATCH     => sub { $match .= $seq1->[$_[0]] },
            DISCARD_A => sub { $d1 .= $seq1->[$_[0]] },
            DISCARD_B => sub { $d2 .= $seq2->[$_[1]] },
        });
        my $m1 = length($match)/(length($match)+length($d1));
        my $m2 = length($match)/(length($match)+length($d2));
        my $mav = ($m1+$m2)/2;
      return $mav, $m1, $m2, $match, $d1, $d2;
    }

}

sub _tokenize { return [split //, $_[0]] }

1;
__END__