login

Perl Quicksort

In this tutorial, you will learn how quick sort is implemented in Perl.

#!/usr/bin/perl

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

    my $i = $first;
    my $j = $last - 1;
    my $pivot = $array->[ $last ];

 SCAN: {
        do {
            # $first <= $i <= $j <= $last - 1
            # Point 1.

            # Move $i as far as possible.
            while ( $array->[ $i ] le $pivot ) {  
                $i++;
                last SCAN if $j < $i;
            }

            # Move $j as far as possible.
            while ( $array->[ $j ] ge $pivot ) {
                $j--;
                last SCAN if $j < $i;
            }

# $i and $j did not cross over, so swap a low and a high value.
            @$array[ $j, $i ] = @$array[ $i, $j ];
        } while ( --$j >= ++$i );
    }
    # $first - 1 <= $j < $i <= $last
    # Point 2.

# Swap the pivot with the first larger
# element (if there is one).
    if ( $i < $last ) {
        @$array[ $last, $i ] = @$array[ $i, $last ];
        ++$i;
    }

    # Point 3.

    return ( $i, $j );   # The new bounds exclude the middle.
}

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

    if ( $last > $first ) {
        my ( $first_of_last, $last_of_first ) =
                                partition( $array, $first, $last );

        local $^W = 0; # Silence deep recursion warning.
        quicksort_recurse($array, $first,         $last_of_first);
        quicksort_recurse($array, $first_of_last, $last);
    }
}

sub quicksort {
# The recursive version is bad with BIG lists
# because the function call stack gets REALLY deep.
    quicksort_recurse($_[ 0 ], 0, $#{ $_[ 0 ] });
}

# If you expect that many of your keys will be the same,
# try adding this before the <LITERAL>return</LITERAL> in
# <LITERAL>partition()</LITERAL>:
#
# Extend the middle partition as much as possible.
#
# ++$i while $i <= $last  && $array->[ $i ] eq $pivot;
# --$j while $j >= $first && $array->[ $j ] eq $pivot;

@array = qw(The little ridges on the edges of coins are called millings.);

quicksort( \@array );

print "@array\n";