Alister West

home is where your code is ...

Perl Sorting Algorithms

These were written to remind me of the main sorting algorithms. Maybe I will come back and focus on performance.

Testing Harness

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;

local $" = ', ';
my $DEBUG = 1;

my @unsorted  = ( 9,3,1,4,6,2,-2 );
say "unsorted      : @unsorted";
say "quick_sort    : " . join ", ", quick_sort( @unsorted );
say "merge_sort    : " . join ", ", merge_sort( @unsorted );
say "insertion_sort: " . join ", ", insertion_sort( @unsorted );

Quick Sort

Recursively subdivide array into lt, eq, gt.

sub quick_sort {

    my @unsorted = @_;
    $DEBUG and say "quick_sort(@unsorted)";

    return @unsorted if @unsorted <= 1;

    my $pivot_index = int $#unsorted/2;
    my $pivot = $unsorted[$pivot_index];

    my (@left,@right);

    for my $i (0..$#unsorted) {
        next if $i == $pivot_index;
        if ($unsorted[$i] <= $pivot) {
            push @left, $unsorted[$i];
        } else {
            push @right, $unsorted[$i];
        }
    }
    $DEBUG and say "@left | $pivot | @right";

    my @sorted = (quick_sort(@left), $pivot, quick_sort(@right)); 

    $DEBUG and say "sorted: @sorted";

    return @sorted;
}

Merge Sort

sub merge_sort {

    my @unsorted = @_;
    $DEBUG and say "merge_sort(@unsorted)";

    my $size = @unsorted;
    my @sorted;

    return @unsorted if (!$size || $size == 1);

    # divide ..
    my @left  = splice @unsorted, 0, $size/2;
    my @right = @unsorted;
    $DEBUG and say "@left || @right";

    @left = merge_sort(@left);
    @right = merge_sort(@right); 

    # .. and conqure with merge!
    while (@left || @right) {
        my $a = $left[0]; my $b = $right[0];
        if (!$b) { push @sorted, @left; last; }
        if (!$a) { push @sorted, @right; last; }
        if ($a <= $b) { push @sorted, shift(@left); next; }
        if ($b < $a)  { push @sorted, shift(@right); next; }
    } 

    $DEBUG and say "sorted: @sorted";
    return @sorted;
}

Insertion Sort

sub insertion_sort {

    my @unsorted = @_;
    $DEBUG and say "insertion_sort(@unsorted)";

    # for every element in turn
    for my $i (0 .. $#unsorted) {
        say "@unsorted";
        say "---" x ($i) . "^";
        # go back over each elem we've past,
        for (my $j = $i-1; $j >= 0; $j--) {

            # STOP:  $i gt all previous array elems.
            last if $unsorted[$i] >= $unsorted[$j];

            # SWAP: if $j > $i
            if ($unsorted[$j] > $unsorted[$i]) {
                $DEBUG and say "swapping to be: $unsorted[$i] with $unsorted[$j]";
                my $a = $unsorted[$i];
                $unsorted[$i] = $unsorted[$j];
                $unsorted[$j] = $a;
                $i = $j; # update index pointer
            }
        }
    }

    # Unsorted is now Sorted!
    return @unsorted;
}
By Alister West