File Coverage

blib/lib/Text/Levenshtein.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	30	30	100.0
condition	6	6	100.0
subroutine	9	9	100.0
pod	2	2	100.0
total	102	102	100.0

package Text::Levenshtein;
$Text::Levenshtein::VERSION = '0.15';
use 5.006;
use strict;
use warnings;
use Exporter;
use Carp;
use List::Util ();

our @ISA         = qw(Exporter);
our @EXPORT      = ();
our @EXPORT_OK   = qw(distance fastdistance);
our %EXPORT_TAGS = ();


sub distance
{
    my $opt = pop(@_) if @_ > 0 && ref($_[-1]) eq 'HASH';
    croak "distance() takes 2 or more arguments" if @_ < 2;
	my ($s,@t)=@_;
    my @results;

    $opt = {} if not defined $opt;

	foreach my $t (@t) {
		push(@results, fastdistance($s, $t, $opt));
	}

	return wantarray ? @results : $results[0];
}

my $eq_with_diacritics = sub {
    my ($x, $y) = @_;
    return $x eq $y;
};

my $eq_without_diacritics;

# This is the "Iterative with two matrix rows" version
# from the wikipedia page
# http://en.wikipedia.org/wiki/Levenshtein_distance#Computing_Levenshtein_distance
sub fastdistance
{
    my $opt = pop(@_) if @_ > 0 && ref($_[-1]) eq 'HASH';
    croak "fastdistance() takes 2 or 3 arguments" unless @_ == 2;
    my ($s, $t) = @_;
    my (@v0, @v1);
    my ($i, $j);
    my $eq;

    $opt = {} if not defined $opt;
    if ($opt->{ignore_diacritics}) {
        if (not defined $eq_without_diacritics) {
            require Unicode::Collate;
            my $collator = Unicode::Collate->new(normalization => undef, level => 1);
            $eq_without_diacritics = sub {
                return $collator->eq(@_);
            };
        }
        $eq = $eq_without_diacritics;
    }
    else {
        $eq = $eq_with_diacritics;
    }

    my $s_length = defined($s) ? length($s) : 0;
    my $t_length = defined($t) ? length($t) : 0;

    return $s_length if $t_length == 0;
    return $t_length if $s_length == 0;

    return 0 if $s eq $t;

    for ($i = 0; $i < $t_length + 1; $i++) {
        $v0[$i] = $i;
    }

    for ($i = 0; $i < $s_length; $i++) {
        $v1[0] = $i + 1;

        for ($j = 0; $j < $t_length; $j++) {
            # my $cost = substr($s, $i, 1) eq substr($t, $j, 1) ? 0 : 1;
            my $cost = $eq->(substr($s, $i, 1), substr($t, $j, 1)) ? 0 : 1;
            $v1[$j + 1] = List::Util::min(
                              $v1[$j] + 1,
                              $v0[$j + 1] + 1,
                              $v0[$j] + $cost,
                             );
        }

        for ($j = 0; $j < $t_length + 1; $j++) {
            $v0[$j] = $v1[$j];
        }
    }

    return $v1[ $t_length];
}

1;

__END__