File Coverage

blib/lib/Text/Brew.pm

Criterion	Covered	Total	%
statement	87	112	77.6
branch	11	28	39.2
condition	1	2	50.0
subroutine	13	13	100.0
pod	0	1	0.0
total	112	156	71.7

package Text::Brew;

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = '0.02';
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(&distance);
%EXPORT_TAGS = ();

use constant INITIAL	=> 'INITIAL';
use constant DEL	=> 'DEL';
use constant INS	=> 'INS';
use constant SUBST	=> 'SUBST';
use constant MATCH	=> 'MATCH';
use constant None	=> [];

sub _best {

	my ($sub_move,$ins_move,$del_move)=@_;

	my ($increment,$move1,$move2,$move3,$tb1,$tb2,$tb3);

	($increment,$move1,$tb1)=@$sub_move;
	my $cost_with_sub=$increment+$tb1->[0];

	($increment,$move2,$tb2)=@$ins_move;
	my $cost_with_ins=$increment+$tb2->[0];

	($increment,$move3,$tb3)=@$del_move;
	my $cost_with_del=$increment+$tb3->[0];

	my $best_cost=$cost_with_sub;
	my $move=$move1;
	my $tb=$tb1;

	if ($cost_with_ins < $best_cost) {

		$best_cost=$cost_with_ins;
		$move=$move2;
		$tb=$tb2;
	}

	if ($cost_with_del < $best_cost) {

		$best_cost=$cost_with_del;
		$move=$move3;
		$tb=$tb3;
	}

	if ($best_cost == $tb->[0]) {$move=MATCH}
	return [$best_cost,$move,$tb];
}

sub _edit_path {

	my ($string1,$string2,$refc)=@_;

	my $m=length($string1);
	my $n=length($string2);

	my ($matchCost,$insCost,$delCost,$substCost)=@$refc;
	my @d;

	$d[0][0]=[0,INITIAL,None];

	foreach my $i (0 .. $m-1) {

		my $sofar= $d[$i][0][0];

		#		cost		move	tb
		$d[$i+1][0]=[$sofar+$delCost, 	DEL , 	$d[$i][0]];
	}

	foreach my $j (0 .. $n-1) {

		my $sofar= $d[0][$j][0];

		#		cost		move	tb
		$d[0][$j+1]=[$sofar+$insCost, 	INS ,	$d[0][$j]];
	}

	foreach my $i (0 .. $m-1) {

		my $string1_i=substr($string1,$i,1);

		foreach my $j (0 .. $n-1) {

			my $string2_i=substr($string2,$j,1);
			my $subst;

			if ($string1_i eq $string2_i) {

				$subst=$matchCost;

			} else {

				$subst=$substCost;
			}

			#			cost	move	tb
			$d[$i+1][$j+1]=_best([$subst,	SUBST ,	$d[$i][$j]],
					     [$insCost,	INS ,	$d[$i+1][$j]],
					     [$delCost, DEL ,	$d[$i][$j+1]]);
		}
	}

	return $d[$m][$n];
}

sub distance {

	my ($string1,$string2,$optional_ref)=@_;
	my $output;
	my $cost;

	if ($optional_ref) {

		if (ref($optional_ref) ne "HASH") {

			warn "Text::Brew: options not well formed, using default";

		} else {

			foreach my $key (keys %$optional_ref) {

				if ($key eq "-cost") {

					$cost=$$optional_ref{'-cost'};
					if (ref($cost) ne "ARRAY") {

           					require Carp;
				      		Carp::croak("Text::Brew: -cost option requires an array");

					} else {

						if (@$cost < 4) {

							warn "Text::Brew: array cost not well formed, using default";
							$cost=undef;
						}
					}

				} elsif ($key eq "-output") {

					$output=$$optional_ref{'-output'};

				} else {

					require Carp;
					Carp::croak("Text::Brew: $key is not a valid option");
				}
			}
		}
	}

	$cost ||= [0,1,1,1];
	$output='both' if (!defined $output);

	if ($output eq 'both') {

		my $tb=_edit_path($string1,$string2,$cost);
		my $distance=$tb->[0];
		my $arrayref_edits;

		while (defined $tb->[0]) {

			unshift @$arrayref_edits,$tb->[1];
			$tb=$tb->[2];
		}

		return $distance,$arrayref_edits;

	} elsif ($output eq 'distance') {

		my $tb=_edit_path($string1,$string2,$cost);
		my $distance=$tb->[0];

		return $distance;

	} elsif ($output eq 'edits') {

		my $tb=_edit_path($string1,$string2,$cost);
		my $arrayref_edits;

		while (defined $tb->[0]) {

			unshift @$arrayref_edits,$tb->[1];
			$tb=$tb->[2];
		}

		return $arrayref_edits;

	} else {

		require Carp;
		Carp::croak("Text::Brew: -output option must be 'distance' or 'both' or 'edits', not $output");
	}
}

1;

__END__