view release on metacpan or  search on metacpan

lib/Algorithm/DiffOld.pm  view on Meta::CPAN

	{
		$matchVector->[ $aStart++ ] = $bStart++;
	}

	# now the end
	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;
		# look for each element of @b between $bStart and $bFinish
		# that matches $a->[ $i ], in reverse order
		for ($j = $bFinish; $j >= $bStart; $j--)
		{
			next if ! &$compare( $a->[$i], $b->[$j], @_ );
			# 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, it's faster to always test this (CPU cache?).
			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 traverse_sequences
{
	my $a = shift;	# array ref
	my $b = shift;	# array ref
	my $callbacks = shift || { };
	my $compare = 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, $compare, @_ );
	# Process all the lines in match vector
	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.

	if ( defined( $finishedBCallback ) && $ai <= $lastA )
	{
		&$finishedBCallback( $bi, @_ );
	}
	else
	{
		&$discardACallback( $ai++, $bi, @_ ) while ( $ai <= $lastA );
	}

	if ( defined( $finishedACallback ) && $bi <= $lastB )
	{
		&$finishedACallback( $ai, @_ );
	}
	else
	{
		&$discardBCallback( $ai, $bi++, @_ ) while ( $bi <= $lastB );
	}
	return 1;
}

sub LCS
{
	my $a = shift;	# array ref
	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 diff
{
	my $a = shift;	# array ref