Algorithm-Diff
view release on metacpan or search on metacpan
lib/Algorithm/Diff.pm view on Meta::CPAN
package Algorithm::Diff;
# Skip to first "=head" line for documentation.
use strict;
use integer; # see below in _replaceNextLargerWith() for mod to make
# if you don't use this
use vars qw( $VERSION @EXPORT_OK );
$VERSION = 1.19_03;
# ^ ^^ ^^-- Incremented at will
# | \+----- Incremented for non-trivial changes to features
# \-------- Incremented for fundamental changes
require Exporter;
*import = \&Exporter::import;
@EXPORT_OK = qw(
prepare LCS LCSidx LCS_length
diff sdiff compact_diff
traverse_sequences traverse_balanced
);
# McIlroy-Hunt diff algorithm
# Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com>
# by Ned Konz, perl@bike-nomad.com
# 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 array's 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;
}
}
lib/Algorithm/Diff.pm view on Meta::CPAN
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<diff>; they said
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<S> which can be obtained from the first sequence by
deleting some items, and from the second sequence by deleting other
items. You also want I<S> to be as long as possible. In this case I<S>
is
a b c d f g j z
From there it's 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<diff>-like output.
It might seem from the example above that the LCS of two sequences is
always pretty obvious, but that's 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<a> and C<b> 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<a b c z>. But actually, the LCS
is C<a x b y c z>:
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. We'll
deal with these in ascending order of difficulty: C<LCS>,
C<LCS_length>, C<LCSidx>, OO interface, C<prepare>, C<diff>, C<sdiff>,
C<traverse_sequences>, and C<traverse_balanced>.
=head2 C<LCS>
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<LCS> may be passed an optional third parameter; this is a CODE
reference to a key generation function. See L</KEY GENERATION
FUNCTIONS>.
@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<LCS_length>
This is just like C<LCS> except it only returns the length of the
longest common subsequence. This provides a performance gain of about
9% compared to C<LCS>.
=head2 C<LCSidx>
Like C<LCS> except it returns references to two arrays. The first array
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<new>
$diff = Algorithm::Diffs->new( \@seq1, \@seq2 );
$diff = Algorithm::Diffs->new( \@seq1, \@seq2, \%opts );
C<new> computes the smallest set of additions and deletions necessary
to turn the first sequence into the second and compactly records them
in the object.
You use the object to iterate over I<hunks>, where each hunk represents
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<die> if used on an object that
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<undef> for an optional argument is always treated the same
as if no argument were passed in.
=item C<Next>
$pos = $diff->Next(); # Move forward 1 hunk
$pos = $diff->Next( 2 ); # Move forward 2 hunks
$pos = $diff->Next(-5); # Move backward 5 hunks
C<Next> moves the object to point at the next hunk. The object starts
out "reset", which means it isn't pointing at any hunk. If the object
is reset, then C<Next()> moves to the first hunk.
C<Next> returns a true value iff the move didn't go past the last hunk.
So C<Next(0)> will return true iff the object is not reset.
Actually, C<Next> returns the object's new position, which is a number
between 1 and the number of hunks (inclusive), or returns a false value.
=item C<Prev>
C<Prev($N)> is almost identical to C<Next(-$N)>; it moves to the $Nth
previous hunk. On a 'reset' object, C<Prev()> [and C<Next(-1)>] move
to the last hunk.
The position returned by C<Prev> is relative to the I<end> of the
hunks; -1 for the last hunk, -2 for the second-to-last, etc.
=item C<Reset>
$diff->Reset(); # Reset the object's 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<Reset> returns the object, so, for example, you could use
C<< $diff->Reset()->Next(-1) >> to get the number of hunks.
=item C<Copy>
$copy = $diff->Copy( $newPos, $newBase );
C<Copy> returns a copy of the object. The copy and the original object
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 copy's position starts out the same as the original
object's position. But C<Copy> takes an optional first argument to set the
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<Copy> takes an optional second argument to set the base for
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<Diff>
$bits = $obj->Diff();
C<Diff> returns a true value iff the current hunk contains items that are
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.
lib/Algorithm/Diff.pm view on Meta::CPAN
C<sdiff> computes all necessary components to show two sequences
and their minimized differences side by side, just like the
Unix-utility I<sdiff> does:
same same
before | after
old < -
- > new
It returns a list of array refs, each pointing to an array of
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.
Display instructions consist of three elements: A modifier indicator
(C<+>: Element added, C<->: Element removed, C<u>: Element unmodified,
C<c>: Element changed) and the value of the old and new elements, to
be displayed side-by-side.
An C<sdiff> of the following two sequences:
a b c e h j l m n p
b c d e f j k l m r s t
results in
( [ '-', 'a', '' ],
[ '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' ],
)
C<sdiff> may be passed an optional third parameter; this is a CODE
reference to a key generation function. See L</KEY GENERATION
FUNCTIONS>.
Additional parameters, if any, will be passed to the key generation
routine.
=head2 C<compact_diff>
C<compact_diff> is much like C<sdiff> except it returns a much more
compact description consisting of just one flat list of indices. An
example helps explain the format:
my @a = qw( a b c e h j l m n p );
my @b = qw( b c d e f j k l m r 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, #
);
The 0th, 2nd, 4th, etc. entries are all indices into @seq1 (@a in the
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.
So each pair of indices (except the last pair) describes where a hunk
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.
So, the first 4 entries (0..3) describe the first hunk. Entries 0 and 1
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.
In other words, the first hunk consists of the following two lists of items:
# 1st pair 2nd pair
# of indices of indices
@list1 = @a[ $cdiff[0] .. $cdiff[2]-1 ];
@list2 = @b[ $cdiff[1] .. $cdiff[3]-1 ];
# Hunk start Hunk end
Note that the hunks will always alternate between those that are part of
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.
By convention, we always make the first hunk contain unchanged 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.
Since @a and @b don't begin with the same value, the first hunk in our
example is empty (otherwise we'd 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:
@hunk1a = @a[ 0 .. 0-1 ];
@hunk1b = @b[ 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
the second hunk, which contains changed items.
Since C<@diff[2..5]> contains (0,0,1,0) in our example, the second hunk
consists of these two lists of items:
@hunk2a = @a[ $cdiff[2] .. $cdiff[4]-1 ];
@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 = ( );
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
consists of these two lists of items:
@hunk3a = @a[ $cdiff[4] .. $cdiff[6]-1 ];
@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 );
Note that this third hunk contains unchanged items as our convention demands.
You can continue this process until you reach the last two indices,
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.
=head2 C<traverse_sequences>
C<traverse_sequences> used to be the most general facility provided by
this module (the new OO interface is more powerful and much easier to
use).
( run in 1.163 second using v1.01-cache-2.11-cpan-0bd6704ced7 )