package Algorithm::Diff;
# Skip to first =head line for documentation.
use strict;
use integer;# see below in _replaceNextLargerWith() for mod to make
# if you dont use this
use vars qw( $VERSION @EXPORT_OK );
$VERSION = 1.19_01;
#^ ^^ ^^ Incremented at will
#| + Incremented for non-trivial changes to features
# Incremented for fundamental changes
require Exporter;
*import= &Exporter::import;
@EXPORT_OK = qw(
prepare LCS LCDidx LCS_length
diff sdiff compact_diff
traverse_sequences traverse_balanced
);
# McIlroy-Hunt diff algorithm
# Adapted from the Smalltalk code of Mario I. Wolczko,
# by Ned Konz, [email protected]
# Updates by Tye McQueen, http://perlmonks.org/?node=tye
# Create a hash that maps each element of $aCollection to the set of
# positions it occupies in $aCollection, restricted to the elements
# within the range of indexes specified by $start and $end.
# The fourth parameter is a subroutine reference that will be called to
# generate a string to use as a key.
# Additional parameters, if any, will be passed to this subroutine.
#
# my $hashRef = _withPositionsOfInInterval( @array, $start, $end, $keyGen );
sub _withPositionsOfInInterval
{
my $aCollection = shift;# array ref
my $start = shift;
my $end = shift;
my $keyGen= shift;
my %d;
my $index;
for ( $index = $start ; $index <= $end ; $index++ ){my $element = $aCollection->[$index];
my $key = &$keyGen( $element, @_ );
if ( exists( $d{$key} ) )
{
unshift ( @{ $d{$key} }, $index );
}
else
{
$d{$key} = [$index];
}
}
return wantarray ? %d : %d;
}
# Find the place at which aValue would normally be inserted into the
# array. If that place is already occupied by aValue, do nothing, and
# return undef. If the place does not exist (i.e., it is off the end of
# the array), add it to the end, otherwise replace the element at that
# point with aValue.It is assumed that the arrays values are numeric.
# This is where the bulk (75%) of the time is spent in this module, so
# try to make it fast!
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 .. $#result ) if $result[ $i ] is defined.
# An additional argument may be passed; this is a hash or key generating
# function that should return a string that uniquely identifies the given
# element.It should be the case that if the key is the same, the elements
# will compare the same. If this parameter is undef or missing, the key
# will be the element as a string.
# By default, comparisons will use eq and elements will be turned into keys
# using the default stringizing operator .
# Additional parameters, if any, will be passed to the key generation
# routine.
sub _longestCommonSubsequence
{
my $a= shift;# array ref or hash ref
my $b= shift;# array ref or hash ref
my $counting = shift;# scalar
my $keyGen = shift;# code ref
my $compare; # code ref
if ( ref($a) eq HASH )
{# prepared hash must be in $b
my $tmp = $b;
$b = $a;
$a = $tmp;
}
# Check for bogus (non-ref) argument values
if ( !ref($a) || !ref($b) )
{
my @callerInfo = caller(1);
die error: must pass array or hash references to . $callerInfo[3];
}
# set up code refs
# Note that these are optimized.
if ( !defined($keyGen) )# optimize for strings
{
$keyGen = sub { $_[0] };
$compare = sub { my ( $a, $b ) = @_; $a eq $b };
}
else
{
$compare = sub {
my $a = shift;
my $b = shift;
&$keyGen( $a, @_ ) eq &$keyGen( $b, @_ );
};
}
my ( $aStart, $aFinish, $matchVector ) = ( 0, $#$a, [] );
my ( $prunedCount, $bMatches ) = ( 0, {} );
if ( ref($b) eq HASH )# was $bMatches prepared for us?
{
$bMatches = $b;
}
else
{
my ( $bStart, $bFinish ) = ( 0, $#$b );
# First we prune off any common elements at the beginning
while ( $aStart <= $aFinishand $bStart <= $bFinishand &$compare( $a->[$aStart], $b->[$bStart], @_ ) )
{
$matchVector->[ $aStart++ ] = $bStart++;
$prunedCount++;
}
# now the end
while ( $aStart <= $aFinishand $bStart <= $bFinishand &$compare( $a->[$aFinish], $b->[$bFinish], @_ ) )
{
$matchVector->[ $aFinish ] = $bFinish;
$prunedCount++;
}
# Now compute the equivalence classes of positions of elements
$bMatches =
_withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ );
}
my $thresh = [];
my $links= [];
my ( $i, $ai, $j, $k );
for ( $i = $aStart ; $i <= $aFinish ; $i++ ){$ai = &$keyGen( $a->[$i], @_ );
if ( exists( $bMatches->{$ai} ) )
{
$k = 0;
for $j ( @{ $bMatches->{$ai} } )
{
# 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, its faster to always test this (CPU cache?).
if ( defined($k) )
{
$links->[$k] =
[ ( $k ? $links->[ $k 1 ] : undef ), $i, $j ];
}
}
}
}
if (@$thresh)
{
return $prunedCount + @$thresh if $counting;
for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] )
{
$matchVector->[ $link->[1] ] = $link->[2];
}
}
elsif ($counting)
{
return $prunedCount;
}
return wantarray ? @$matchVector : $matchVector;
}
sub traverse_sequences
{
my $a = shift;# array ref
my $b = shift;# array ref
my $callbacks = shift || {};
my $keyGen= shift;
my $matchCallback = $callbacks->{MATCH} || sub { };
my $discardACallback= $callbacks->{DISCARD_A} || sub { };
my $finishedACallback = $callbacks->{A_FINISHED};
my $discardBCallback= $callbacks->{DISCARD_B} || sub { };
my $finishedBCallback = $callbacks->{B_FINISHED};
my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
# Process all the lines in @$matchVector
my $lastA = $#$a;
my $lastB = $#$b;
my $bi= 0;
my $ai;
for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ ){my $bLine = $matchVector->[$ai];
if ( defined($bLine) )# matched
{
&$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;&$matchCallback( $ai,$bi++, @_ );}else{&$discardACallback( $ai, $bi, @_ );}}# The last entry (if any) processed was a match.# $ai and $bi point just past the last matching lines in their sequences.while ( $ai <= $lastA or $bi <= $lastB ){# last A?if ( $ai == $lastA + 1 and $bi <= $lastB ){if ( defined($finishedACallback) ){&$finishedACallback( $lastA, @_ );$finishedACallback = undef;}else{&$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB;}}# last B?if ( $bi == $lastB + 1 and $ai <= $lastA ){if ( defined($finishedBCallback) ){&$finishedBCallback( $lastB, @_ );$finishedBCallback = undef;}else{&$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA;}}&$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA;&$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB;}return 1;}sub traverse_balanced{my $a = shift;# array refmy $b = shift;# array refmy $callbacks = shift || {};my $keyGen= shift;my $matchCallback = $callbacks->{MATCH} || sub { };
my $discardACallback= $callbacks->{DISCARD_A} || sub { };
my $discardBCallback= $callbacks->{DISCARD_B} || sub { };
my $changeCallback= $callbacks->{CHANGE};
my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
# Process all the lines in match vector
my $lastA = $#$a;
my $lastB = $#$b;
my $bi= 0;
my $ai= 0;
my $ma= -1;
my $mb;
while (1)
{
# Find next match indices $ma and $mb
do {
$ma++;
} while(
$ma <= $#$matchVector&&!defined $matchVector->[$ma]
);
last if $ma > $#$matchVector;# end of matchVector?
$mb = $matchVector->[$ma];
# Proceed with discard a/b or change events until
# next match
while ( $ai < $ma || $bi < $mb ){if ( $ai < $ma && $bi < $mb ){# Changeif ( defined $changeCallback ){&$changeCallback( $ai++, $bi++, @_ );}else{&$discardACallback( $ai++, $bi, @_ );&$discardBCallback( $ai, $bi++, @_ );}}elsif ( $ai < $ma ){&$discardACallback( $ai++, $bi, @_ );}else{# $bi < $mb&$discardBCallback( $ai, $bi++, @_ );}}# Match&$matchCallback( $ai++, $bi++, @_ );}while ( $ai <= $lastA || $bi <= $lastB ){if ( $ai <= $lastA && $bi <= $lastB ){# Changeif ( defined $changeCallback ){&$changeCallback( $ai++, $bi++, @_ );}else{&$discardACallback( $ai++, $bi, @_ );&$discardBCallback( $ai, $bi++, @_ );}}elsif ( $ai <= $lastA ){&$discardACallback( $ai++, $bi, @_ );}else{# $bi <= $lastB&$discardBCallback( $ai, $bi++, @_ );}}return 1;}sub prepare{my $a = shift;# array refmy $keyGen= shift;# code ref# set up code ref$keyGen = sub { $_[0] } unless defined($keyGen);return scalar _withPositionsOfInInterval( $a, 0, $#$a, $keyGen, @_ );}sub LCS{my $a = shift;# array refmy $b = shift;# array ref or hash refmy $matchVector = _longestCommonSubsequence( $a, $b, 0, @_ );my @retval;my $i;for ( $i = 0 ; $i <= $#$matchVector ; $i++ ){if ( defined( $matchVector->[$i] ) )
{
push ( @retval, $a->[$i] );
}
}
return wantarray ? @retval : @retval;
}
sub LCS_length
{
my $a = shift;# array ref
my $b = shift;# array ref or hash ref
return _longestCommonSubsequence( $a, $b, 1, @_ );
}
sub LCSidx
{
my $a= shift @_;
my $b= shift @_;
my $match= _longestCommonSubsequence( $a, $b, 0, @_ );
my @am= grep defined $match->[$_], 0..$#$match;
my @bm= @{$match}[@am];
return @am, @bm;
}
sub compact_diff
{
my $a= shift @_;
my $b= shift @_;
my( $am, $bm )= LCSidx( $a, $b, @_ );
my @cdiff;
my( $ai, $bi )= ( 0, 0 );
push @cdiff, $ai, $bi;
while( 1 ) {
while(@$am&&$ai == $am->[0]&&$bi == $bm->[0]) {
shift @$am;
shift @$bm;
++$ai, ++$bi;
}
push @cdiff, $ai, $bi;
last if! @$am;
$ai = $am->[0];
$bi = $bm->[0];
push @cdiff, $ai, $bi;
}
push @cdiff, 0+@$a, 0+@$b
if$ai < @$a || $bi < @$b;return wantarray ? @cdiff : @cdiff;}sub diff{my $a= shift;# array refmy $b= shift;# array refmy $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 0 < @$hunk;$hunk = []};traverse_sequences( $a, $b,{ MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ );
&$match();
return wantarray ? @$retval : $retval;
}
sub sdiff
{
my $a= shift;# array ref
my $b= shift;# array ref
my $retval = [];
my $discard = sub { push ( @$retval, [ -, $a->[ $_[0] ], ] ) };
my $add = sub { push ( @$retval, [ +, , $b->[ $_[1] ] ] ) };
my $change = sub {
push ( @$retval, [ c, $a->[ $_[0] ], $b->[ $_[1] ] ] );
};
my $match = sub {
push ( @$retval, [ u, $a->[ $_[0] ], $b->[ $_[1] ] ] );
};
traverse_balanced(
$a,
$b,
{
MATCH => $match,
DISCARD_A => $discard,
DISCARD_B => $add,
CHANGE=> $change,
},
@_
);
return wantarray ? @$retval : $retval;
}
########################################
my $Root= __PACKAGE__;
package Algorithm::Diff::_impl;
use strict;
sub _Idx(){ 0 } # $me->[_Idx]: Ref to array of hunk indices
# 1 # $me->[1]: Ref to first sequence
# 2 # $me->[2]: Ref to second sequence
sub _End(){ 3 } # $me->[_End]: Diff between forward and reverse pos
sub _Same() { 4 } # $me->[_Same]: 1 if pos 1 contains unchanged items
sub _Base() { 5 } # $me->[_Base]: Added to ranges min and max
sub _Pos(){ 6 } # $me->[_Pos]: Which hunk is currently selected
sub _Off(){ 7 } # $me->[_Off]: Offset into _Idx for current position
sub _Min() { -2 } # Added to _Off to get min instead of max+1
sub Die
{
require Carp;
Carp::confess( @_ );
}
sub _ChkPos
{
my( $me )= @_;
return if$me->[_Pos];
my $meth= ( caller(1) )[3];
Die( Called $meth on reset object );
}
sub _ChkSeq
{
my( $me, $seq )= @_;
return $seq + $me->[_Off]
if1 == $seq||2 == $seq;
my $meth= ( caller(1) )[3];
Die( $meth: Invalid sequence number ($seq); must be 1 or 2 );
}
sub getObjPkg
{
my( $us )= @_;
return ref $us ifref $us;
return $us . ::_obj;
}
sub new
{
my( $us, $seq1, $seq2, $opts ) = @_;
my @args;
for( $opts->{keyGen} ) {
push @args, $_ if$_;
}
for( $opts->{keyGenArgs} ) {
push @args, @$_ if$_;
}
my $cdif= Algorithm::Diff::compact_diff( $seq1, $seq2, @args );
my $same= 1;
if(0 == $cdif->[2]&&0 == $cdif->[3]) {
$same= 0;
splice @$cdif, 0, 2;
}
my @obj= ( $cdif, $seq1, $seq2 );
$obj[_End] = (1+@$cdif)/2;
$obj[_Same] = $same;
$obj[_Base] = 0;
my $me = bless @obj, $us->getObjPkg();
$me->Reset( 0 );
return $me;
}
sub Reset
{
my( $me, $pos )= @_;
$pos= int( $pos || 0 );
$pos += $me->[_End]
if$pos < 0;$pos= 0if$pos < 0||$me->[_End] <= $pos;$me->[_Pos]= $pos || !1;
$me->[_Off]= 2*$pos 1;
return $me;
}
sub Base
{
my( $me, $base )= @_;
my $oldBase= $me->[_Base];
$me->[_Base]= 0+$base ifdefined $base;
return $oldBase;
}
sub Copy
{
my( $me, $pos, $base )= @_;
my @obj= @$me;
my $you= bless @obj, ref($me);
$you->Reset( $pos ) ifdefined $pos;
$you->Base( $base );
return $you;
}
sub Next {
my( $me, $steps )= @_;
$steps= 1 if! defined $steps;
if( $steps ) {
my $pos= $me->[_Pos];
my $new= $pos + $steps;
$new= 0 if$pos&&$new < 0;$me->Reset( $new )
}
return $me->[_Pos];
}
sub Prev {
my( $me, $steps )= @_;
$steps= 1 if! defined $steps;
my $pos= $me->Next(-$steps);
$pos -= $me->[_End] if$pos;
return $pos;
}
sub Diff {
my( $me )= @_;
$me->_ChkPos();
return 0 if$me->[_Same] == ( 1 & $me->[_Pos] );
my $ret= 0;
my $off= $me->[_Off];
for my $seq ( 1, 2 ) {
$ret |= $seq
if$me->[_Idx][ $off + $seq + _Min ]
< $me->[_Idx][ $off + $seq ];
}
return $ret;
}
sub Min {
my( $me, $seq, $base )= @_;
$me->_ChkPos();
my $off= $me->_ChkSeq($seq);
$base= $me->[_Base] if !defined $base;
return $base + $me->[_Idx][ $off + _Min ];
}
sub Max {
my( $me, $seq, $base )= @_;
$me->_ChkPos();
my $off= $me->_ChkSeq($seq);
$base= $me->[_Base] if !defined $base;
return $base + $me->[_Idx][ $off ] -1;
}
sub Range {
my( $me, $seq, $base )= @_;
$me->_ChkPos();
my $off = $me->_ChkSeq($seq);
if( !wantarray ) {
return$me->[_Idx][ $off ]
$me->[_Idx][ $off + _Min ];
}
$base= $me->[_Base] if !defined $base;
return( $base + $me->[_Idx][ $off + _Min ] )
..( $base + $me->[_Idx][ $off ] 1 );
}
sub Items {
my( $me, $seq )= @_;
$me->_ChkPos();
my $off = $me->_ChkSeq($seq);
if( !wantarray ) {
return$me->[_Idx][ $off ]
$me->[_Idx][ $off + _Min ];
}
return
@{$me->[$seq]}[
$me->[_Idx][ $off + _Min ]
..( $me->[_Idx][ $off ] 1 )
];
}
sub Same {
my( $me )= @_;
$me->_ChkPos();
return wantarray ? () : 0
if$me->[_Same] != ( 1 & $me->[_Pos] );
return $me->Items(1);
}
my %getName;
BEGIN {
%getName= (
same => &Same,
diff => &Diff,
base => &Base,
min=> &Min,
max=> &Max,
range=> &Range,
items=> &Items, # same thing
);
}
sub Get
{
my $me= shift @_;
$me->_ChkPos();
my @value;
for my $arg (@_) {
for my $word (split , $arg) {
my $meth;
if( $word !~ /^(-?d+)?([a-zA-Z]+)([12])?$/
||not$meth= $getName{ lc $2 }
) {
Die( $Root, , Get: Invalid request ($word) );
}
my( $base, $name, $seq )= ( $1, $2, $3 );
push @value, scalar(
4 == length($name)
? $meth->( $me )
: $meth->( $me, $seq, $base )
);
}
}
if(wantarray) {
return @value;
} elsif(1 == @value) {
return $value[0];
}
Die( 0+@value, values requested from ,
$Root, s Get in scalar context );
}
my $Obj= getObjPkg($Root);
no strict refs;
for my $meth (qw( new getObjPkg )) {
*{$Root.::.$meth} = &{$meth};
*{$Obj .::.$meth} = &{$meth};
}
for my $meth (qw(
Next Prev Reset Copy Base Diff
Same Items Range Min Max Get
_ChkPos _ChkSeq
)) {
*{$Obj.::.$meth} = &{$meth};
}
1;
__END__
=head1 NAME
Algorithm::Diff Compute `intelligent differences between two files / lists
=head1 SYNOPSIS
require Algorithm::Diff;
# This example produces traditional diff output:
my $diff = Algorithm::Diff->new( @seq1, @seq2 );
$diff->Base( 1 ); # Return line numbers, not indices
while($diff->Next()) {
next if$diff->Same();
my $sep = ;
if(! $diff->Items(2)) {
sprintf %d,%dd%d
,
$diff->Get(qw( Min1 Max1 Max2 ));
} elsif(! $diff->Items(1)) {
sprint %da%d,%d
,
$diff->Get(qw( Max1 Min2 Max2 ));
} else {
$sep =
;
sprintf %d,%dc%d,%d
,
$diff->Get(qw( Min1 Max1 Min2 Max2 ));
}
print < $_” for$diff->Items(1);
print $sep;
print > $_ for$diff->Items(2);
}
# Alternate interfaces:
use Algorithm::Diff qw(
LCS LCS_length LCSidx
diff sdiff compact_diff
traverse_sequences traverse_balanced );
@lcs= LCS( @seq1, @seq2 );
$lcsref = LCS( @seq1, @seq2 );
$count= LCS_length( @seq1, @seq2 );
( $seq1idxref, $seq2idxref ) = LCSidx( @seq1, @seq2 );
# Complicated interfaces:
@diffs= diff( @seq1, @seq2 );
@sdiffs = sdiff( @seq1, @seq2 );
@cdiffs = compact_diff( @seq1, @seq2 );
traverse_sequences(
@seq1,
@seq2,
{ MATCH => &callback1,
DISCARD_A => &callback2,
DISCARD_B => &callback3,
},
&key_generator,
@extra_args,
);
traverse_balanced(
@seq1,
@seq2,
{ MATCH => &callback1,
DISCARD_A => &callback2,
DISCARD_B => &callback3,
CHANGE=> &callback4,
},
&key_generator,
@extra_args,
);
=head1 INTRODUCTION
(by Mark-Jason Dominus)
I once read an article written by the authors of C
that they worked very hard on the algorithm until they found the
right one.
I think what they ended up using (and I hope someone will correct me,
because I am not very confident about this) was the `longest common
subsequence method.In the LCS problem, you have two sequences of
items:
a b c d f g h j q z
a b c d e f g i j k r x y z
and you want to find the longest sequence of items that is present in
both original sequences in the same order.That is, you want to find
a new sequence I which can be obtained from the first sequence by
deleting some items, and from the secend sequence by deleting other
items.You also want I to be as long as possible.In this case I
is
a b c d f g j z
From there its only a small step to get diff-like output:
e h i k q r x y
+ + + + + +
This module solves the LCS problem.It also includes a canned function
to generate C
It might seem from the example above that the LCS of two sequences is
always pretty obvious, but thats not always the case, especially when
the two sequences have many repeated elements.For example, consider
a x b y c z p d q
a b c a x b y c z
A naive approach might start by matching up the C and C that
appear at the beginning of each sequence, like this:
a x b y c z p d q
a b c a b y c z
This finds the common subsequence C .But actually, the LCS
is C :
a x b y c z p d q
a b c a x b y c z
or
a x b y c z p d q
a b c a x b y c z
=head1 USAGE
(See also the README file and several example
scripts include with this module.)
This module now provides an object-oriented interface that uses less
memory and is easier to use than most of the previous procedural
interfaces.It also still provides several exportable functions.Well
deal with these in ascending order of difficulty:C
C
C
=head2 C
Given references to two lists of items, LCS returns an array containing
their longest common subsequence.In scalar context, it returns a
reference to such a list.
@lcs= LCS( @seq1, @seq2 );
$lcsref = LCS( @seq1, @seq2 );
C
reference to a key generation function.See L .
@lcs= LCS( @seq1, @seq2, &keyGen, @args );
$lcsref = LCS( @seq1, @seq2, &keyGen, @args );
Additional parameters, if any, will be passed to the key generation
routine.
=head2 C
This is just like C
longest common subsequence.This provides a performance gain of about
9% compared to C
=head2 C
Like C
contains the indices into @seq1 where the LCS items are located.The
second array contains the indices into @seq2 where the LCS items are located.
Therefore, the following three lists will contain the same values:
my( $idx1, $idx2 ) = LCSidx( @seq1, @seq2 );
my @list1 = @seq1[ @$idx1 ];
my @list2 = @seq2[ @$idx2 ];
my @list3 = LCS( @seq1, @seq2 );
=head2 C
$diff = Algorithm::Diffs->new( @seq1, @seq2 );
$diff = Algorithm::Diffs->new( @seq1, @seq2, %opts );
C
to turn the first sequence into the second and compactly records them
in the object.
You use the object to iterate over I
a contiguous section of items which should be added, deleted, replaced,
or left unchanged.
=over 4
The following summary of all of the methods looks a lot like Perl code
but some of the symbols have different meanings:
[ ] Encloses optional arguments
: Is followed by the default value for an optional argument
| Separates alternate return results
Method summary:
$obj= Algorithm::Diff->new( @seq1, @seq2, [ %opts ] );
$pos= $obj->Next([ $count : 1 ] );
$revPos = $obj->Prev([ $count : 1 ] );
$obj= $obj->Reset( [ $pos : 0 ] );
$copy = $obj->Copy([ $pos, [ $newBase ] ] );
$oldBase= $obj->Base([ $newBase ] );
Note that all of the following methods C
is reset (not currently pointing at any hunk).
$bits = $obj->Diff();
@items|$cnt = $obj->Same();
@items|$cnt = $obj->Items( $seqNum );
@idxs |$cnt = $obj->Range( $seqNum, [ $base ] );
$minIdx = $obj->Min( $seqNum, [ $base ] );
$maxIdx = $obj->Max( $seqNum, [ $base ] );
@values = $obj->Get( @names );
Passing in C
as if no argument were passed in.
=item C
$pos = $diff->Next();# Move forward 1 hunk
$pos = $diff->Next( 2 ); # Move forward 2 hunks
$pos = $diff->Next(-5);# Move backward 5 hunks
C
out reset, which means it isnt pointing at any hunk.If the object
is reset, then C
C
So C
Actually, C
between 1 and the number of hunks (inclusive), or returns a false value.
=item C
C
previous hunk.On a reset object, C
to the last hunk.
The position returned by C
hunks; -1 for the last hunk, -2 for the second-to-last, etc.
=item C
$diff->Reset(); # Reset the objects position
$diff->Reset($pos); # Move to the specified hunk
$diff->Reset(1);# Move to the first hunk
$diff->Reset(-1); # Move to the last hunk
C
C<< $diff->Reset()->Next(-1) >> to get the number of hunks.
=item C
$copy = $diff->Copy( $newPos, $newBase );
C
share most of their data, so making copies takes very little memory.
The copy maintains its own position (separate from the original), which
is the main purpose of copies.It also maintains its own base.
By default, the copys position starts out the same as the original
objects position.But C
new position, so the following three snippets are equivalent:
$copy = $diff->Copy($pos);
$copy = $diff->Copy();
$copy->Reset($pos);
$copy = $diff->Copy()->Reset($pos);
C
the copy.If you wish to change the base of the copy but leave
the position the same as in the original, here are two
equivalent ways:
$copy = $diff->Copy();
$copy->Base( 0 );
$copy = $diff->Copy(undef,0);
Here are two equivalent way to get a reset copy:
$copy = $diff->Copy(0);
$copy = $diff->Copy()->Reset();
=item C
$bits = $obj->Diff();
C
different between the two sequences.It actually returns one of the
follow 4 values:
=over 4
=item 3
C<3==(1|2)>.This hunk contains items from @seq1 and the items
from @seq2 that should replace them.Both sequence 1 and 2
contain changed items so both the 1 and 2 bits are set.
=item 2
This hunk only contains items from @seq2 that should be inserted (not
items from @seq1).Only sequence 2 contains changed items so only the 2
bit is set.
=item 1
This hunk only contains items from @seq1 that should be deleted (not
items from @seq2).Only sequence 1 contains changed items so only the 1
bit is set.
=item 0
This means that the items in this hunk are the same in both sequences.
Neither sequence 1 nor 2 contain changed items so neither the 1 nor the
2 bits are set.
=back
=item C
C
are the same in both sequences.It actually returns the list of items
if they are the same or an emty list if they arent.In a scalar
context, it returns the size of the list.
=item C
$count = $diff->Items(2);
@items = $diff->Items($seqNum);
C
are part of the current hunk.
If the current hunk contains only insertions, then
C<< $diff->Items(1) >> will return an empty list (0 in a scalar conext).
If the current hunk contains only deletions, then C<< $diff->Items(2) >>
will return an empty list (0 in a scalar conext).
If the hunk contains replacements, then both C<< $diff->Items(1) >> and
C<< $diff->Items(2) >> will return different, non-empty lists.
Otherwise, the hunk contains identical items and all of the following
will return the same lists:
@items = $diff->Items(1);
@items = $diff->Items(2);
@items = $diff->Same();
=item C
$count = $diff->Range( $seqNum );
@indices = $diff->Range( $seqNum );
@indices = $diff->Range( $seqNum, $base );
C
the items rather than the items themselves.By default, the index of
the first item (in each sequence) is 0 but this can be changed by
calling the C
return the same lists:
@list = $diff->Items(2);
@list = @seq2[ $diff->Range(2) ];
You can also specify the base to use as the second argument.So the
following two snippets I
@list = $diff->Items(1);
@list = @seq1[ $diff->Range(1,0) ];
=item C
$curBase = $diff->Base();
$oldBase = $diff->Base($newBase);
C
used when you request range information.The base defaults to 0 so
that range information is returned as array indices.You can set the
base to 1 if you want to report traditional line numbers instead.
=item C
$min1 = $diff->Min(1);
$min = $diff->Min( $seqNum, $base );
C
same arguments) or returns C
list.
=item C
C
=item C
( $n, $x, $r ) = $diff->Get(qw( min1 max1 range1 ));
@values = $diff->Get(qw( 0min2 1max2 range2 same base ));
C
names of the values you want returned.Each name must match one of the
following regexes:
/^(-?d+)?(min|max)[12]$/i
/^(range[12]|same|diff|base)$/i
The 1 or 2 after a name says which sequence you want the information
for (and where allowed, it is required).The optional number before
min or max is the base to use.So the following equalities hold:
$diff->Get(min1) == $diff->Min(1)
$diff->Get(0min2) == $diff->Min(2,0)
Using C
name is a fatal error (C
=back
=head2 C Given a reference to a list of items, C $prep = prepare( @seq1 ); C $prep = prepare( @seq1, &keyGen ); Using C =head2 C @diffs = diff( @seq1, @seq2 ); C The return value of C Here is an example.Calling C a b c e h j l m n p would produce the following list: ( [ [ +, 2, d ] ], [ [ -, 4, h ], [ [ +, 6, k ] ], [ [ -,8, n ], There are five hunks here.The first hunk says that the C at C Additional parameters, if any, will be passed to the key generation =head2 C @sdiffs = sdiff( @seq1, @seq2 ); C same same It returns a list of array refs, each pointing to an array of Display instructions consist of three elements: A modifier indicator An C a b c e h j l m n p results in ( [ -, a, ], C Additional parameters, if any, will be passed to the key generation =head2 C C my @a = qw( a b c eh j l m n p); The 0th, 2nd, 4th, etc. entries are all indices into @seq1 (@a in the So each pair of indices (except the last pair) describes where a hunk So, the first 4 entries (0..3) describe the first hunk.Entries 0 and 1 In other words, the first hunk consists of the following two lists of items: #1st pair 2nd pair Note that the hunks will always alternate between those that are part of By convention, we always make the first hunk contain unchanged items. Since @a and @b dont begin with the same value, the first hunk in our @hunk1a = @a[ 0 .. 0-1 ]; And C<0..-1> returns the empty list. Move down one pair of indices (2..5) and we get the offset ranges for Since C<@diff[2..5]> contains (0,0,1,0) in our example, the second hunk @hunk2a = @a[ $cdiff[2] .. $cdiff[4]-1 ]; That is, we would delete item 0 (a) from @a. Since C<@diff[4..7]> contains (1,0,3,2) in our example, the third hunk @hunk3a = @a[ $cdiff[4] .. $cdiff[6]-1 ]; Note that this third hunk contains unchanged items as our convention demands. You can continue this process until you reach the last two indices, =head2 C C Imagine that there are two arrows.Arrow A points to an element of Otherwise, one of the arrows is pointing to an element of its sequence The arguments to C traverse_sequences( Callbacks for MATCH, DISCARD_A, and DISCARD_B are invoked with at least Callbacks for A_FINISHED and B_FINISHED are invoked with at least the If arrow A reaches the end of its sequence, before arrow B does, C Additional parameters, if any, will be passed to the key generation function. If you want to pass additional parameters to your callbacks, but dont traverse_sequences( C =head2 C C In addition to the C traverse_balanced( If no C C The C C =head1 KEY GENERATION FUNCTIONS Most of the functions accept an optional extra parameter.This is a By default, comparisons will use eq and elements will be turned into keys Where this is important is when youre comparing something other than For instance, consider this example: package Person; sub new sub clone sub hash my $person1 = Person->new( name => Joe, ssn => 123-45-6789 ); If you did this: my $array1 = [ $person1, $person2, $person4 ]; everything would work out OK (each of the objects would be converted But if you did this: my $array1 = [ $person1, $person2, $person4 ]; $person4 and $person4->clone() (which have the same name and SSN) my $array1 = [ $person1, $person2, $person4 ]; This would use the ssn field in each Person as a comparison key, and You may also pass additional parameters to the key generation function =head1 ERROR CHECKING If you pass these routines a non-reference and they expect a reference, =head1 AUTHOR This version released by Tye McQueen (http://perlmonks.org/?node=tye). =head1 LICENSE Parts Copyright (c) 2000-2004 Ned Konz.All rights reserved. This program is free software; you can redistribute it and/or modify it =head1 MAILING LIST Mark-Jason still maintains a mailing list.To join a low-volume mailing =head1 CREDITS Versions through 0.59 (and much of this documentation) were written by: Mark-Jason Dominus, [email protected] This version borrows some documentation and routine names from This code was adapted from the Smalltalk code of Mario Wolczko C The algorithm is that described in Much work was done by Ned Konz ([email protected]). The OO interface and some other changes are by Tye McQueen. =cut
to a hash which can be used when comparing this sequence to other
sequences with C
for $i ( 0 .. 10_000 )
{
@lcs = LCS( $prep, $seq[$i] );
# do something useful with @lcs
}
reference to a key generation function.See L .
for $i ( 0 .. 10_000 )
{
@lcs = LCS( $seq[$i], $prep, &keyGen );
# do something useful with @lcs
}
many times compared with not preparing.
$diffs_ref = diff( @seq1, @seq2 );
to turn the first sequence into the second, and returns a description
of these changes.The description is a list of I
represents a contiguous section of items which should be added,
deleted, or replaced.(Hunks containing unchanged items are not
included.)
reference to such a list.If there are no differences, the list will be
empty.
b c d e f j k l m r s t
[ [ -, 0, a ] ],
[ +, 4, f ] ],
[ -,9, p ],
[ +,9, r ],
[ +, 10, s ],
[ +, 11, t ] ],
)
position 0 of the first sequence should be deleted (C<->).The second
hunk says that the C
be inserted (C<+>).The third hunk says that the C
of the first sequence should be removed and replaced with the C
from position 4 of the second sequence.And so on.
reference to a key generation function.See L .
routine.
$sdiffs_ref = sdiff( @seq1, @seq2 );
and their minimized differences side by side, just like the
Unix-utility I
before | after
old< –> new
display instructions. In scalar context it returns a reference
to such a list. If there are no differences, the list will have one
entry per item, each indicating that the item was unchanged.
(C<+>: Element added, C<->: Element removed, C : Element unmodified,
C
be displayed side-by-side.
b c d e f j k l m r s t
[ u, b, b ],
[ u, c, c ],
[ +, ,d ],
[ u, e, e ],
[ c, h, f ],
[ u, j, j ],
[ +, ,k ],
[ u, l, l ],
[ u, m, m ],
[ c, n, r ],
[ c, p, s ],
[ +, ,t ],
)
reference to a key generation function.See L .
routine.
compact description consisting of just one flat list of indices.An
example helps explain the format:
my @b = qw( b c d e fj k l mr s t );
@cdiff = compact_diff( @a, @b );
# Returns:
# @a@b @a @b
#start start values values
(0,0, # =
0,0, #a!
1,0, #b c=b c
3,2, # !d
3,3, #e=e
4,4, #f!h
5,5, #j=j
6,6, # !k
6,7, #l m=l m
8,9, #n p!r s t
10, 12, #
);
above example) indicating where a hunk begins.The 1st, 3rd, 5th, etc.
entries are all indices into @seq2 (@b in the above example) indicating
where the same hunk begins.
begins (in each sequence).Since each hunk must end at the item just
before the item that starts the next hunk, the next pair of indices can
be used to determine where the hunk ends.
describe where the first hunk begins (and so are always both 0).
Entries 2 and 3 describe where the next hunk begins, so subtracting 1
from each tells us where the first hunk ends.That is, the first hunk
contains items C<$diff[0]> through C<$diff[2] – 1> of the first sequence
and contains items C<$diff[1]> through C<$diff[3] – 1> of the second
sequence.
# of indices of indices
@list1 = @a[ $cdiff[0] .. $cdiff[2]-1 ];
@list2 = @b[ $cdiff[1] .. $cdiff[3]-1 ];
# Hunk start Hunk end
the LCS (those that contain unchanged items) and those that contain
changes.This means that all we need to be told is whether the first
hunk is a same or diff hunk and we can determine which of the other
hunks contain same items or diff items.
So the 1st, 3rd, 5th, etc. hunks (all odd-numbered hunks if you start
counting from 1) all contain unchanged items.And the 2nd, 4th, 6th,
etc. hunks (all even-numbered hunks if you start counting from 1) all
contain changed items.
example is empty (otherwise wed violate the above convention).Note
that the first 4 index values in our example are all zero.Plug these
values into our previous code block and we get:
@hunk1b = @b[ 0 .. 0-1 ];
the second hunk, which contains changed items.
consists of these two lists of items:
@hunk2b = @b[ $cdiff[3] .. $cdiff[5]-1 ];
# or
@hunk2a = @a[ 0 .. 1-1 ];
@hunk2b = @b[ 0 .. 0-1 ];
# or
@hunk2a = @a[ 0 .. 0 ];
@hunk2b = @b[ 0 .. -1 ];
# or
@hunk2a = ( a );
@hunk2b = ( );
consists of these two lists of items:
@hunk3a = @b[ $cdiff[5] .. $cdiff[7]-1 ];
# or
@hunk3a = @a[ 1 .. 3-1 ];
@hunk3a = @b[ 0 .. 2-1 ];
# or
@hunk3a = @a[ 1 .. 2 ];
@hunk3a = @b[ 0 .. 1 ];
# or
@hunk3a = qw( b c );
@hunk3a = qw( b c );
which will always be the number of items in each sequence.This is
required so that subtracting one from each will give you the indices to
the last items in each sequence.
this module (the new OO interface is more powerful and much easier to
use).
sequence A, and arrow B points to an element of the sequence B.
Initially, the arrows point to the first elements of the respective
sequences.C
sequences one element at a time, calling an appropriate user-specified
callback function before each advance.It willadvance the arrows in
such a way that if there are equal elements C<$A[$i]> and C<$B[$j]>
which are equal and which are part of the LCS, there will be some moment
during the execution of C
to C<$A[$i]> and arrow B is pointing to C<$B[$j]>.When this happens,
C
it will advance both arrows.
that is not part of the LCS.C
arrow and will call the C
depending on which arrow it advanced.If both arrows point to elements
that are not part of the LCS, then C
one of them and call the appropriate callback, but it is not specified
which it will call.
traverse, and a hash which specifies the callback functions, like this:
@seq1, @seq2,
{ MATCH => $callback_1,
DISCARD_A => $callback_2,
DISCARD_B => $callback_3,
}
);
the indices of the two arrows as their arguments.They are not expected
to return any values.If a callback is omitted from the table, it is
not called.
corresponding index in A or B.
C
advances arrow B, if there is such a function; if not it will call
C
C
respective sequences.It returns true on success and false on failure.
At present there is no way to fail.
is a CODE reference to a key generation function.See L .
need a custom key generation function, you can get the default by
passing undef:
@seq1, @seq2,
{ MATCH => $callback_1,
DISCARD_A => $callback_2,
DISCARD_B => $callback_3,
},
undef, # default key-gen
$myArgument1,
$myArgument2,
$myArgument3,
);
expected to plug in the appropriate behavior with the callback
functions.
uses a different algorithm to iterate through the entries in the
computed LCS. Instead of sticking to one side and showing element changes
as insertions and deletions only, it will jump back and forth between
the two sequences and report I
side followed immediatly by an insertion on the other side.
supported by C
a C
@seq1, @seq2,
{ MATCH => $callback_1,
DISCARD_A => $callback_2,
DISCARD_B => $callback_3,
CHANGE=> $callback_4,
}
);
therefore resulting in a similar behaviour as C
noticable only while processing huge amounts of data.
is implemented as call to C
plug in the appropriate behavior with the callback functions.
CODE reference to a key generating (hashing) function that should return
a string that uniquely identifies a given element.It should be the
case that if two elements are to be considered equal, their keys should
be the same (and the other way around).If no key generation function
is provided, the key will be the element as a string.
using the default stringizing operator .
strings.If it is the case that you have multiple different objects
that should be considered to be equal, you should supply a key
generation function. Otherwise, you have to make sure that your arrays
contain unique references.
{
my $package = shift;
return bless { name => , ssn => , @_ }, $package;
}
{
my $old = shift;
my $new = bless { %$old }, ref($old);
}
{
return shift()->{ssn};
}
my $person2 = Person->new( name => Mary, ssn => 123-47-0000 );
my $person3 = Person->new( name => Pete, ssn => 999-45-2222 );
my $person4 = Person->new( name => Peggy, ssn => 123-45-9999 );
my $person5 = Person->new( name => Frank, ssn => 000-45-9999 );
my $array2 = [ $person1, $person3, $person4, $person5 ];
Algorithm::Diff::diff( $array1, $array2 );
into a string like Person=HASH(0x82425b0) for comparison).
my $array2 = [ $person1, $person3, $person4->clone(), $person5 ];
Algorithm::Diff::diff( $array1, $array2 );
would be seen as different objects. If you wanted them to be considered
equivalent, you would have to pass in a key generation function:
my $array2 = [ $person1, $person3, $person4->clone(), $person5 ];
Algorithm::Diff::diff( $array1, $array2, &Person::hash );
so would consider $person4 and $person4->clone() as equal.
if you wish.
they will die with a message.
Parts by Tye McQueen.
under the same terms as Perl.
list for announcements related to diff and Algorithm::Diff, send an
empty mail message to [email protected].
Mark-Jasons, but Diff.pms code was completely replaced.
ftp://st.cs.uiuc.edu/pub/Smalltalk/MANCHESTER/manchester/4.0/diff.st
I ,
CACM, vol.20, no.5, pp.350-353, May 1977, with a few
minor improvements to improve the speed.
Reviews
There are no reviews yet.