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";
Related Tutorials