Algorithm
DiffOld
Toolbar
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
sub LCS
{
my $a = shift; 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; } |
sub _longestCommonSubsequence
{
my $a = shift; my $b = shift; 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 = [];
while ( $aStart <= $aFinish
and $bStart <= $bFinish
and &$compare( $a->[ $aStart ], $b->[ $bStart ], @_ ) )
{
$matchVector->[ $aStart++ ] = $bStart++;
}
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;
for ($j = $bFinish; $j >= $bStart; $j--)
{
next if ! &$compare( $a->[$i], $b->[$j] );
if ( $k
and $thresh->[ $k ] > $j
and $thresh->[ $k - 1 ] < $j )
{
$thresh->[ $k ] = $j;
}
else
{
$k = _replaceNextLargerWith( $thresh, $j, $k );
}
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; } |
sub _replaceNextLargerWith
{
my ( $array, $aValue, $high ) = @_;
$high ||= $#$array;
if ( $high == -1 || $aValue > $array->[ -1 ] )
{
push( @$array, $aValue );
return $high + 1;
}
my $low = 0;
my $index;
my $found;
while ( $low <= $high )
{
$index = ( $high + $low ) / 2;
$found = $array->[ $index ];
if ( $aValue == $found )
{
return undef;
}
elsif ( $aValue > $found )
{
$low = $index + 1;
}
else
{
$high = $index - 1;
}
}
$array->[ $low ] = $aValue; return $low;
}
} |
sub diff
{
my $a = shift; my $b = shift; 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_sequences | description | prev | next | Top |
sub traverse_sequences
{
my $a = shift; my $b = shift; 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, @_ );
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
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.
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.