http://qs1969.pair.com?node_id=44952

vroom has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to take diffs between a current document and a version with a proposed change. Then the author of the document could okay or discard the changes after viewing them.

I'm working on writing an applyChange function but am having some trouble getting it to work correctly. Here's a toy script I've been playing with: 

use Data::Dumper;
use Algorithm::Diff qw(diff);
@a=qw(a b c e h j l m n p);
@b=qw(b c d e f j k l m r s t);
print "@a\n";
print "@b\n";
my $diff=diff(\@a,\@b);
while(<>){
chomp;
my(@action)=split(/ /,$_);
if($action[0] eq "+"){
      splice(@a, $action[1], 0, $action[2]);
   } elsif($action[0] eq "-"){
      splice(@a, $action[1],1);
   }


print "@a\n";
print "@b\n";
}

[download]
Then I go through and sequentially apply the "actions" within diff array from Data::Dumper which looks like so: 
$VAR1 = [
          [
            [
              '-',
              '0',
              'a'
            ]
          ],
          [
            [
              '+',
              2,
              'd'
            ]
          ],
          [
            [
              '-',
              4,
              'h'
            ],
            [
              '+',
              4,
              'f'
            ]
          ],
          [
            [
              '+',
              6,
              'k'
            ]
          ],
          [
            [
              '-',
              8,
              'n'
            ],
            [
              '-',
              9,
              'p'
            ],
            [
              '+',
              9,
              'r'
            ],
            [
              '+',
              10,
              's'
            ],
            [
              '+',
              11,
              't'
            ]
          ]
        ];

[download]
I then run my script and input the "actions" in the array above. All goes fine until the - 8 'n' command. There isn't an 'n' in location 8 at that point and it looks like we really want to take away the n at spot 9.

As I see it a number of things could be happening

  1. My splice behavior in the script is wrong
  2. I'm missing something fundamental with Algorithm::Diff's behavior and the chunks of changes
  3. Operator error running/writing the script
  4. Something weird really is going on
It's probably one or all of the first three but any help or insight would be much appreciated. 
a b c e h j l m n p
b c d e f j k l m r s t
- 0 a
b c e h j l m n p
b c d e f j k l m r s t
+ 2 d
b c d e h j l m n p
b c d e f j k l m r s t
- 4 h
b c d e j l m n p
b c d e f j k l m r s t
+ 4 f
b c d e f j l m n p
b c d e f j k l m r s t
+ 6 k
b c d e f j k l m n p
b c d e f j k l m r s t
- 8 n
b c d e f j k l n p
b c d e f j k l m r s t
- 9 p
b c d e f j k l n
b c d e f j k l m r s t
+ 9 r
b c d e f j k l n r
b c d e f j k l m r s t
+ 10 s
b c d e f j k l n r s
b c d e f j k l m r s t
+ 11 t
b c d e f j k l n r s t
b c d e f j k l m r s t


vroom | Tim Vroom | vroom@cs.hope.edu

Replies are listed 'Best First'.
Re: Yet another Algorithm::Diff question
by merlyn (Sage) on Dec 05, 2000 at 10:03 UTC
[reply]
      I looked at that node before and just glanced at your column. My problem is I have the original sequence, and a frozen diff and need to find the target sequence based on those two things.

      vroom | Tim Vroom | vroom@cs.hope.edu
[reply]
[reply]
Re: Yet another Algorithm::Diff question
by chipmunk (Parson) on Dec 05, 2000 at 10:14 UTC
    The 'n' is at line 9 instead of line 8 because at that point you've removed 2 elements and added 3, shifting everything after that up by one.

    Solution: apply your changes starting at the end of the array, and work towards the beginning.

[reply]
      Exactly, or keep a line offset counter and work forward!

      --
      $you = new YOU;
      honk() if $you->love(perl)

[reply]
      Oh, that won't work either... It looks like the - instructions are indexes into the original array, while the + instructions are indexes into the new array... Try this:

      First, process all the delete instructions, starting at the end. Then, process all the insert instructions, starting at the beginning.

      I tested that by hand and it came out properly.

[reply]
        here's my code for it: 
        #!/usr/bin/perl -w

use strict;

use Data::Dumper;

use Algorithm::Diff qw(diff);

my @orig = qw(a b c e h j l m n p);
my @rev = qw(b c d e f j k l m r s t);

print "Original:\t@orig\n";
print "Revision:\t@rev\n";

my $diff = diff \@orig, \@rev;

my @adds;

for my $hunk (reverse @$diff)
{
    for my $change (reverse @$hunk)
    {
        if($change->[0] eq "-")
        {
            # process deletions
            splice @orig, $change->[1], 1;
        }
        elsif ($change->[0] eq "+")
        {
            # defer handling additions
            unshift @adds, $change;
        }
    }
}

# process additions
splice @orig, $_->[1], 0, $_->[2] for @adds;

print "Patched:\t@orig\n";

        [download]
[reply]
[d/l]
Re: Yet another Algorithm::Diff question
by mdillon (Priest) on Dec 05, 2000 at 22:23 UTC
    here it is again in forward order, with deletions and additions processed in a single pass: 
    #!/usr/bin/perl -w

use Data::Dumper;

use Algorithm::Diff qw(diff);

use strict;

use subs qw(patch);

##
##

sub patch
{
    my @orig = @{shift()};
    my $diff = shift;

    my $shift = 0;

    for my $hunk (@$diff)
    {
        for my $change (@$hunk)
        {
            if ($change->[0] eq "-")
            {
                # process deletions
                splice @orig, $change->[1] + $shift, 1;
                --$shift;
            }
            elsif ($change->[0] eq "+")
            {
                # process additions
                splice @orig, $change->[1], 0, $change->[2];
                ++$shift;
            }
        }
    }

    @orig;
}

##
##

my @orig = qw(a b c e h j l m n p);
my @rev = qw(b c d e f j k l m r s t);

my $diff = diff \@orig, \@rev;

my @patched = patch \@orig, $diff;

print "Original:\t@orig", $/;
print "Revision:\t@rev", $/;
print "Patched:\t@patched", $/;

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom