Algorithm DiffOld
SummaryIncluded librariesPackage variablesSynopsisGeneral documentationMethods
Toolbar
WebCvsRaw content
Summary
Algorithm::DiffOld - Compute `intelligent' differences between two files / lists
but use the old (<=0.59) interface.
Package variables
No package variables defined.
Inherit
Exporter
Synopsis
  use Algorithm::DiffOld qw(diff LCS traverse_sequences);
@lcs = LCS( \@seq1, \@seq2, $comparison_function ); $lcsref = LCS( \@seq1, \@seq2, $comparison_function ); @diffs = diff( \@seq1, \@seq2, $comparison_function ); traverse_sequences( \@seq1, \@seq2, { MATCH => $callback, DISCARD_A => $callback, DISCARD_B => $callback, }, $comparison_function );
Description
No description!
Methods
LCS
No description
Code
_longestCommonSubsequence
No description
Code
_replaceNextLargerWith
No description
Code
diff
No description
Code
traverse_sequences
No description
Code
Methods description
None available.
Methods code
LCSdescriptionprevnextTop
sub LCS {
	my $a = shift;	# array ref
my $matchVector = _longestCommonSubsequence( $a, @_ ); my @retval; my $i; for ( $i = 0; $i <= $#$matchVector; $i++ ) { if ( defined( $matchVector->[ $i ] ) ) { push( @retval, $a->[ $i ] ); } } return wantarray ? @retval :\@ retval;
}
_longestCommonSubsequencedescriptionprevnextTop
sub _longestCommonSubsequence {
	my $a = shift;	# array ref
my $b = shift; # array ref
my $compare = shift || sub { my $a = shift; my $b = shift; $a eq $b }; my $aStart = 0; my $aFinish = $#$a; my $bStart = 0; my $bFinish = $#$b; my $matchVector = []; # First we prune off any common elements at the beginning
while ( $aStart <= $aFinish and $bStart <= $bFinish and &$compare( $a->[ $aStart ], $b->[ $bStart ], @_ ) ) { $matchVector->[ $aStart++ ] = $bStart++; } # now the end
while ( $aStart <= $aFinish and $bStart <= $bFinish and &$compare( $a->[ $aFinish ], $b->[ $bFinish ], @_ ) ) { $matchVector->[ $aFinish-- ] = $bFinish--; } my $thresh = []; my $links = []; my ( $i, $ai, $j, $k ); for ( $i = $aStart; $i <= $aFinish; $i++ ) { $k = 0; # look for each element of @b between $bStart and $bFinish
# that matches $a->[ $i ], in reverse order
for ($j = $bFinish; $j >= $bStart; $j--) { next if ! &$compare( $a->[$i], $b->[$j] ); # optimization: most of the time this will be true
if ( $k and $thresh->[ $k ] > $j and $thresh->[ $k - 1 ] < $j ) { $thresh->[ $k ] = $j; } else { $k = _replaceNextLargerWith( $thresh, $j, $k ); } # oddly, it's faster to always test this (CPU cache?).
if ( defined( $k ) ) { $links->[ $k ] = [ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ]; } } } if ( @$thresh ) { for ( my $link = $links->[ $#$thresh ]; $link; $link = $link->[ 0 ] ) { $matchVector->[ $link->[ 1 ] ] = $link->[ 2 ]; } } return wantarray ? @$matchVector : $matchVector;
}
_replaceNextLargerWithdescriptionprevnextTop
sub _replaceNextLargerWith {
	my ( $array, $aValue, $high ) = @_;
	$high ||= $#$array;

	# off the end?
if ( $high == -1 || $aValue > $array->[ -1 ] ) { push( @$array, $aValue ); return $high + 1; } # binary search for insertion point...
my $low = 0; my $index; my $found; while ( $low <= $high ) { $index = ( $high + $low ) / 2;
# $index = int(( $high + $low ) / 2); # without 'use integer'
$found = $array->[ $index ]; if ( $aValue == $found ) { return undef; } elsif ( $aValue > $found ) { $low = $index + 1; } else { $high = $index - 1; } } # now insertion point is in $low.
$array->[ $low ] = $aValue; # overwrite next larger
return $low; } # This method computes the longest common subsequence in $a and $b.
# Result is array or ref, whose contents is such that
# $a->[ $i ] = $b->[ $result[ $i ] ]
# foreach $i in ( 0..scalar( @result ) if $result[ $i ] is defined.
# An additional argument may be passed; this is a CODE ref to a comparison
# routine. By default, comparisons will use "eq" .
# Note that this routine will be called as many as M*N times, so make it fast!
# Additional parameters, if any, will be passed to the key generation routine.
}
diffdescriptionprevnextTop
sub diff {
	my $a = shift;	# array ref
my $b = shift; # array ref
my $retval = []; my $hunk = []; my $discard = sub { push( @$hunk, [ '-', $_[ 0 ], $a->[ $_[ 0 ] ] ] ) }; my $add = sub { push( @$hunk, [ '+', $_[ 1 ], $b->[ $_[ 1 ] ] ] ) }; my $match = sub { push( @$retval, $hunk ) if scalar(@$hunk); $hunk = [] }; traverse_sequences( $a, $b, { MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ ); &$match(); return wantarray ? @$retval : $retval; } 1;
}
traverse_sequencesdescriptionprevnextTop
sub traverse_sequences {
	my $a = shift;	# array ref
my $b = shift; # array ref
my $callbacks = shift || { }; my $compare = shift; my $matchCallback = $callbacks->{'MATCH'} || sub { }; my $discardACallback = $callbacks->{'DISCARD_A'} || sub { }; my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { }; my $matchVector = _longestCommonSubsequence( $a, $b, $compare, @_ ); # Process all the lines in match vector
my $lastA = $#$a; my $lastB = $#$b; my $bi = 0; my $ai; for ( $ai = 0; $ai <= $#$matchVector; $ai++ ) { my $bLine = $matchVector->[ $ai ]; if ( defined( $bLine ) ) { &$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine; &$matchCallback( $ai, $bi++, @_ ); } else { &$discardACallback( $ai, $bi, @_ ); } } &$discardACallback( $ai++, $bi, @_ ) while ( $ai <= $lastA ); &$discardBCallback( $ai, $bi++, @_ ) while ( $bi <= $lastB ); return 1;
}
General documentation
NOTETop
This has been provided as part of the Algorithm::Diff package by Ned Konz.
This particular module is ONLY for people who HAVE to have the old
interface, which uses a comparison function rather than a key generating
function.
Because each of the lines in one array have to be compared with each
of the lines in the other array, this does M*N comparisions. This can
be very slow. I clocked it at taking 18 times as long as the stock
version of Algorithm::Diff for a 4000-line file. It will get worse
quadratically as array sizes increase.
COMPARISON FUNCTIONSTop
Each of the main routines should be passed a comparison function. If you
aren't passing one in, use Algorithm::Diff instead.
These functions should return a true value when two items should compare
as equal.
For instance,
  @lcs    = LCS( \@seq1, \@seq2, sub { my ($a, $b) = @_; $a eq $b } );
but if that is all you're doing with your comparison function, just use
Algorithm::Diff and let it do this (this is its default).
Or:
  sub someFunkyComparisonFunction
{
my ($a, $b) = @_;
$a =~ m{$b};
}
@diffs = diff( \@lines, \@patterns, \&someFunkyComparisonFunction );
which would allow you to diff an array @lines which consists of text
lines with an array @patterns which consists of regular expressions.
This is actually the reason I wrote this version -- there is no way
to do this with a key generation function as in the stock Algorithm::Diff.