#!/usr/bin/perl -w use strict; use Algorithm::Diff 1.19 (); Main( @ARGV ); exit( 0 ); { package DiffToMerge; sub new { my $class= shift @_; my $diff= Algorithm::Diff->new( @_ ); $diff->Next(); # Start out at first chunk my $me= bless { diff => $diff, offset => 0, }, $class; if( $diff->Diff() ) { $me->{sublist}= [ $diff->Items( 1 ) ]; $me->{suboff}= $diff->Min( 1 ); } return $me; } sub Same { my( $me, $off )= @_; for( $me->{offset} ) { die if $off < $_; die if $_+1 < $off; $_= $off; } my $diff= $me->{diff}; if( $diff->Max(2) < $off ) { die if ! $diff->Next(); if( $diff->Diff() ) { $me->{sublist}= [ $diff->Items( 1 ) ]; $me->{suboff}= $diff->Min( 1 ); } if( ! $diff->Range(2) ) { die if $off <= $diff->Max(2); die if ! $diff->Next(); } die if $off < $diff->Min(2); die if $diff->Max(2) < $off; } return $diff->Same(); } sub Shift { my( $me )= @_; my $diff= $me->{diff}; die if ! $diff->Same(); return $diff->Min(1) + $me->{offset}++ - $diff->Min(2); } sub Sublist { my( $me )= @_; my $sublist= $me->{sublist}; return if ! $sublist || ! @$sublist; return $sublist; } sub SublistOffset { my( $me, $offset )= @_; return undef if ! defined $offset; shift @{ $me->{sublist} }; return $me->{suboff}++; } sub SublistIdxs { my( $me )= @_; my $beg= $me->{suboff}; $me->{suboff} += @{ $me->{sublist} || [] }; $me->{sublist}= []; return $beg .. $me->{suboff}-1; } } sub FlushSublist { my( $avOut, $d, $diff )= @_; for( $diff->SublistIdxs() ) { my @row; $row[$d]= $_; push @$avOut, \@row; } } sub DiffMerge { my( $finish, @seq )= @_; my @diff= map { DiffToMerge->new( $_, $seq[-1] ) } @seq[ 0 .. $#seq-1 ]; my @out; for my $i ( 0 .. $#{ $seq[-1] } ) { my @row; my %sublists; my @flush; for my $d ( 0 .. $#diff ) { my $same= $diff[$d]->Same($i); for( $diff[$d]->Sublist() ) { $sublists{$d}= $_ if $_; } if( $same ) { push @flush, $d if $sublists{$d}; $row[$d]= $diff[$d]->Shift(); } } if( @flush ) { for my $row ( DiffMerge( 0, values %sublists ) ) { my @subrow; for my $d ( keys %sublists ) { $subrow[$d]= $diff[$d]->SublistOffset( shift @$row ); } push @out, \@subrow; } FlushSublist( \@out, $_, $diff[$_] ) for @flush; } $row[@diff]= $i; push @out, \@row; } if( $finish ) { for( 0 .. $#diff ) { FlushSublist( \@out, $_, $diff[$_] ) if $diff[$_]->Sublist(); } } return @out; } sub Main { my @seq= @_; @seq= qw( abdefhi azcdfghi abcjkgnhi ) if ! @seq; @seq= map [ /./gs ], @seq; my @out= DiffMerge( 1, @seq ); for( @seq ) { push @$_, '-'; } for( @out ) { for( @$_ ) { $_= '-' if ! defined $_; } print "( @$_ )\n"; } print $/; for( @seq ) { my @l= map shift @$_, @out; for( @l ) { $_= -1 if ! defined $_ || '-' eq $_; } print "( @$_[@l] )\n"; } } #### % perl diffN.pl ( 0 0 0 ) ( 1 - 1 ) ( 2 - ) ( 3 - ) ( 4 - ) ( - 1 ) ( - 2 2 ) ( - - 3 ) ( - - 4 ) ( - 3 ) ( - 4 ) ( - 5 5 ) ( - - 6 ) ( 5 6 7 ) ( 6 7 8 ) ( a b d e f - - - - - - - - h i ) ( a - - - - z c - - d f g - h i ) ( a b - - - - c j k - - g n h i ) % perl diffN.pl tye says japhy asked ( - - 0 ) ( - 0 ) ( - 1 1 0 ) ( - - 2 ) ( - - 3 ) ( 0 - - ) ( 1 2 4 ) ( - 3 - 1 ) ( - - - 2 ) ( 2 - - 3 ) ( - - - 4 ) ( - - - - - t y - - e - ) ( - s a - - - y s - - - ) ( j - a p h - y - - - - ) ( - - a - - - - s k e d ) #### % perl diffN.pl encyclopedia cyclops enclosure wikipedia cyclone wicked lonely ( - - - 0 - 0 ) ( - - - 1 - 1 ) ( 0 - 0 - - - ) ( 1 - 1 - - - ) ( 2 0 2 - 0 2 ) ( - - - 2 - 3 ) ( 3 ) ( 4 ) ( - 1 ) ( - 2 ) ( - - - - 1 ) ( - - - - 2 ) ( 5 3 3 - 3 - 0 ) ( 6 4 4 - 4 - 1 ) ( - - - - 5 - 2 ) ( - - - 3 ) ( 7 5 - 4 ) ( - 6 5 - ) ( - - 6 - ) ( - - 7 - ) ( 8 - 8 5 6 4 3 ) ( - - - - - - 4 ) ( - - - - - - 5 ) ( 9 ) ( 10 ) ( 11 ) ( - - - 6 ) ( - - - 7 ) ( - - - 8 ) ( - - - - - 5 ) ( - - e n c - y c - - - - l o - - p - - - e - - d i a - - - - ) ( - - - - c - - - y c - - l o - - p s - - - - - - - - - - - - ) ( - - e n c - - - - - - - l o - - - s u r e - - - - - - - - - ) ( w i - - - k - - - - - - - - - i p - - - e - - - - - d i a - ) ( - - - - c - - - - - y c l o n - - - - - e - - - - - - - - - ) ( w i - - c k - - - - - - - - - - - - - - e - - - - - - - - d ) ( - - - - - - - - - - - - l o n - - - - - e l y - - - - - - - ) # ^ ^ ^ ^ ^ ^ < should merge > ^ ^ ^ ^ ^ ^ ^