Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Perl's quicksort implemented in Perl
#!/Users/brian/bin/perls/perl5.20.0
use strict;
use warnings;
use List::Util qw(shuffle);
use Term::ANSIColor;
my @colors = qw(red blue green);
my $QSORT_ORDER_GUESS = 2;
my $QSORT_MAX_STACK = 32;
my $QSORT_BREAK_EVEN = 6;
my $QSORT_PLAY_SAFE = 255;
my $array = [ shuffle( 0 .. 9 ) ];
my $num_elts = @$array;
my $compare = sub { $_[0] <=> $_[1] };
my $partition_stack_entry = [];
my $swapped;
my $qsort_cmp = sub {
my( $elt1, $elt2 ) = @_;
print "compare: ";
while( my( $index, $value ) = each $array ) {
if( $index != $elt1 and $index != $elt2 ) {
print "$value ";
}
elsif( $index == $elt1 ) {
print colored( $value, $colors[0] ), ' ';
}
elsif( $index == $elt2 ) {
print colored( $value, $colors[1] ), ' ';
}
}
print "\n";
$compare->( $array->[$elt1], $array->[$elt2] );
};
my $qsort_swap = sub{
my( $elt1, $elt2 ) = @_;
$swapped++;
print " swap: ";
while( my( $index, $value ) = each $array ) {
if( $index != $elt1 and $index != $elt2 ) {
print "$value ";
}
elsif( $index == $elt1 ) {
print colored( $value, $colors[0] ), ' ';
}
elsif( $index == $elt2 ) {
print colored( $value, $colors[1] ), ' ';
}
}
print "\n";
my $temp = $array->[$elt1];
$array->[$elt1] = $array->[$elt2];
$array->[$elt2] = $temp;
print "swapped: ";
while( my( $index, $value ) = each $array ) {
if( $index != $elt1 and $index != $elt2 ) {
print "$value ";
}
elsif( $index == $elt1 ) {
print colored( $value, $colors[1] ), ' ';
}
elsif( $index == $elt2 ) {
print colored( $value, $colors[0] ), ' ';
}
}
print "\n";
};
my $qsort_rotate = sub {
my( $elt1, $elt2, $elt3 ) = @_;
my $temp = $array->[$elt1];
print " rotate: ";
while( my( $index, $value ) = each $array ) {
if( $index != $elt1 and $index != $elt2 and $index != $elt3 ) {
print "$value ";
}
elsif( $index == $elt1 ) {
print colored( $value, $colors[0] ), ' ';
}
elsif( $index == $elt2 ) {
print colored( $value, $colors[1] ), ' ';
}
elsif( $index == $elt3 ) {
print colored( $value, $colors[2] ), ' ';
}
}
print "\n";
$array->[$elt1] = $array->[$elt2];
$array->[$elt2] = $array->[$elt3];
$array->[$elt3] = $temp;
print "rotated: ";
while( my( $index, $value ) = each $array ) {
if( $index != $elt1 and $index != $elt2 and $index != $elt3 ) {
print "$value ";
}
elsif( $index == $elt1 ) {
print colored( $value, $colors[2] ), ' ';
}
elsif( $index == $elt2 ) {
print colored( $value, $colors[0] ), ' ';
}
elsif( $index == $elt3 ) {
print colored( $value, $colors[1] ), ' ';
}
}
print "\n";
};
my $quicksort = sub {
my( $array, $num_elts, $compare ) = @_;
return if $num_elts == 1;
my $partition_stack = [];
my $next_stack_entry = 0;
my $last_index = $#$array;
my $part_left = 0;
my $part_right = $last_index;
my $qsort_break_even = $QSORT_BREAK_EVEN;
OUTER: for( ;; ) {
if( ($part_right - $part_left) >= $qsort_break_even ) {
my $pc_left = int( ($part_left + $part_right ) / 2 );
my $pc_right = $pc_left;
my $u_right = $pc_left - 1;
my $u_left = $pc_right + 1;
$swapped = 0;
my $s = $qsort_cmp->( $u_right, $pc_left );
if( $s < 0 ) { # l < c
$s = $qsort_cmp->( $pc_left, $u_left ); # if l < c, c < r - already in order - nothing to do
if( $s == 0 ) { # l < c, c == r - already in order, pc grows
++$pc_right;
}
elsif( $s > 0) { # l < c, c > r - need to know more
$s = $qsort_cmp->( $u_right, $u_left );
if( $s < 0 ) { #l < c, c > r, l < r - swap c & r to get ordered
$qsort_swap->( $pc_left, $u_left );
}
elsif( $s == 0) { # l < c, c > r, l == r - swap c &r , grow pc
$qsort_swap->( $pc_left, $u_left );
--$pc_left;
}
else { # l < c, c > r, l > r - make lcr into rlc to get ordered
$qsort_rotate->( $pc_left, $u_right, $u_left );
}
}
}
elsif( $s == 0 ) { # l == c
$s = $qsort_cmp->( $pc_left, $u_left );
if( $s < 0 ) { # l == c, c < r - already in order, grow pc
--$pc_left;
}
elsif( $s == 0 ) { # l == c, c == r - already in order, grow pc both ways
--$pc_left;
++$pc_right;
}
else { # l == c, c > r - swap l & r, grow pc
$qsort_swap->( $u_right, $u_left );
++$pc_right;
}
}
else { # l > c
$s = $qsort_cmp->( $pc_left, $u_left );
if( $s < 0) { # l > c, c < r - need to know more
$s = $qsort_cmp->( $u_right, $u_left );
if( $s < 0) { # l > c, c < r, l < r - swap l & c to get ordered
$qsort_swap->( $u_right, $pc_left );
}
elsif( $s == 0) { # l > c, c < r, l == r - swap l & c, grow pc
$qsort_swap->( $u_right, $pc_left );
++$pc_right;
}
else { # l > c, c < r, l > r - rotate lcr into crl to order
$qsort_rotate->( $u_right, $pc_left, $u_left );
}
}
elsif( $s == 0 ) { # l > c, c == r - swap ends, grow pc
$qsort_swap->( $u_right, $u_left );
--$pc_left;
}
else { # l > c, c > r - swap ends to get in order
$qsort_swap->( $u_right, $u_left );
}
}
--$u_right;
++$u_left;
INNER: for( ;; ) {
my $still_work_on_left;
my $still_work_on_right;
LEFT: while( $still_work_on_left = $u_right >= $part_left ) {
$s = $qsort_cmp->( $u_right, $pc_left );
if( $s < 0 ) {
--$u_right;
}
elsif( $s == 0 ) {
--$pc_left;
if( $pc_left != $u_right ) {
$qsort_swap->( $u_right, $pc_left );
}
--$u_right;
}
else {
last LEFT;
}
}
RIGHT: while( $still_work_on_right = $u_left <= $part_right ) {
$s = $qsort_cmp->( $pc_right, $u_left );
if( $s < 0 ) {
++$u_left;
}
elsif( $s == 0 ) {
++$pc_right;
if( $pc_right != $u_left ) {
$qsort_swap->( $pc_right, $u_left );
}
++$u_left;
}
else {
last RIGHT;
}
}
if( $still_work_on_left ) {
if( $still_work_on_right ) {
$qsort_swap->( $u_right, $u_left );
--$u_right;
++$u_left;
}
else {
--$pc_left;
if( $pc_left == $u_right ) {
$qsort_swap->( $u_right, $pc_right );
}
else {
$qsort_rotate->( $u_right, $pc_left, $pc_right );
}
--$pc_right;
--$u_right;
}
}
elsif( $still_work_on_right ) {
++$pc_right;
if( $pc_right == $u_left ) {
$qsort_swap->( $u_left, $pc_left );
}
else {
$qsort_rotate->( $pc_right, $pc_left, $u_left );
}
++$pc_left;
++$u_left;
}
else {
last INNER;
}
}
if( $swapped < 3 ) {
$qsort_break_even *= 2;
}
else {
$qsort_break_even = $QSORT_BREAK_EVEN;
}
if( $part_left < $pc_left ) {
if( $pc_right < $part_right ) {
if( ($part_right - $pc_right ) > ($pc_left - $part_left )) {
$partition_stack->[$next_stack_entry]{left} = $pc_right + 1;
$partition_stack->[$next_stack_entry]{right} = $part_right;
$partition_stack->[$next_stack_entry]{qsort_break_even} = $qsort_break_even;
$part_right = $pc_left - 1;
}
else {
$partition_stack->[$next_stack_entry]{left} = $part_left;
$partition_stack->[$next_stack_entry]{right} = $pc_left - 1;
$partition_stack->[$next_stack_entry]{qsort_break_even} = $qsort_break_even;
$part_left = $pc_right + 1;
}
++$next_stack_entry;
}
else {
$part_right = $pc_left - 1;
}
}
elsif( $pc_right < $part_right ) {
$part_left = $pc_right + 1;
}
else {
if( $next_stack_entry == 0) {
last;
}
--$next_stack_entry;
$part_left = $partition_stack->[$next_stack_entry]{left};
$part_right = $partition_stack->[$next_stack_entry]{right};
$qsort_break_even = $partition_stack->[$next_stack_entry]{qsort_break_even};
}
}
else {
my $i;
for( $i = $part_left + 1; $i <= $part_right; ++$i ) {
my $j;
for( $j = $i - 1; $j >= $part_left; --$j ) {
if( $qsort_cmp->( $i, $j ) >= 0 ) {
last;
}
}
++$j;
if( $j != $i) {
my $k;
print " shift: ";
while( my( $index, $value ) = each $array ) {
if( $index > $i or $index < $j ) {
print "$value ";
}
elsif( $index == $i ) {
print colored( $value, $colors[0] ), ' ';
}
else {
print colored( $value, $colors[1] ), ' ';
}
}
print "\n";
my $temp = $array->[$i];
for( $k = $i - 1; $k >= $j; --$k ) {
$array->[ $k + 1 ] = $array->[$k];
}
$array->[$j] = $temp;
print "shifted: ";
while( my( $index, $value ) = each $array ) {
if( $index > $i or $index < $j ) {
print "$value ";
}
elsif( $index == $j ) {
print colored( $value, $colors[0] ), ' ';
}
else {
print colored( $value, $colors[1] ), ' ';
}
}
print "\n";
}
}
if( $next_stack_entry == 0) {
last;
}
--$next_stack_entry;
$part_left = $partition_stack->[$next_stack_entry]{left};
$part_right = $partition_stack->[$next_stack_entry]{right};
$qsort_break_even = $partition_stack->[$next_stack_entry]{qsort_break_even};
}
}
};
print "@$array\n";
$quicksort->( $array, scalar @$array, $compare );
print "@$array\n";
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.