Perl Merge Sort

#!/usr/bin/perl

sub mergesort {
    mergesort_recurse($_[0], 0, $#{ $_[0] });
}

sub mergesort_recurse {
    my ( $array, $first, $last ) = @_;

    if ( $last > $first ) {
        # Silence deep recursion warning.
        local $^W = 0;
        my $middle = int(( $last + $first ) / 2);

        mergesort_recurse( $array, $first,       $middle );
        mergesort_recurse( $array, $middle + 1,  $last   );
        merge( $array, $first, $middle, $last );
    }
}

my @work; # A global work array.

sub merge {
    my ( $array, $first, $middle, $last ) = @_;

    my $n = $last - $first + 1;

    # Initialize work with relevant elements from the array.
    for ( my $i = $first, my $j = 0; $i <= $last; ) {
        $work[ $j++ ] = $array->[ $i++ ];
    }

# Now do the actual merge.  Proceed through the work array
# and copy the elements in order back to the original array.
# $i is the index for the merge result, $j is the index in
# first half of the working copy, $k the index in the second half.

    $middle = int(($first + $last) / 2) if $middle > $last;

    my $n1 = $middle - $first + 1;    # The size of the 1st half.

    for ( my $i = $first, my $j = 0, my $k = $n1; $i <= $last; $i++ ) {
        $array->[ $i ] =
            $j < $n1 &&
              ( $k == $n || $work[ $j ] lt $work[ $k ] ) ?
                $work[ $j++ ] :
                $work[ $k++ ];
    }
}

@array = qw(i feel like i should be using these examples to
            make some sort of profound point, you know?
            it is like, wow, there are gonna be THOUSANDS of people reading this,
            and all i have to say is that i have nothing to say.);

mergesort \@array;

print "@array\n";

Related Tutorials

• « Previous page
• Next page »