Merge Sort in Perl

Question

I'm new to Perl and have successfully written a merge sort program. I'll paste the entire program below, but would like mostly a review of the subroutines mergeSort() and merge().

I tried to use pass-by-reference as much as possible to make as it as fast as possible. Is there ways I can make this better/more optimized yet?

For example in my merge() subroutine, there is a line:

@$arr[$r] = $b[$j];

Where $arr is a pointer to an array, $b is an array, and $r and $j are both integer indexes. I am assigning the value at index $j in array $b to the $r index of my dereferenced array @$arr.

Is there a way to instead assign by dereferencing like in C where I might do *arr = b[j] then *arr++, or is this the best way? It seems like maybe I'm processing the entire array to change one element, but I probably just don't fully understand.

#!/usr/bin/perl -w
#Program usage: perl  PROGRAM  LIST_OF_INTEGERS
#example: 
#perl mergeSort.pl 3 2 1 139 17 -3 3 5 0 1 9 -33 3 0 5335 4 -3 3

use strict;

### MAIN ###

# ensure a list has been passed with program call
if($#ARGV == -1) {
    print STDERR "ERROR: You must specify a list of integers.\n".
        "EXAMPLE: perl mergeSort.pl 1 7 20 11 2\n\n";
    exit(-1);
}

# print outputs
print "\nBEFORE: [";
for $_ (@ARGV){
    print $_, " ";
}
print "]\n";


### merge sort ###
print scalar (@ARGV), " elements\n";  # print # elements
my @sol = @ARGV; # copy list
mergeSort( \@sol );


# more printing
print " AFTER: [";
for $_ (@sol){
    print $_, " ";
}
print "]\n";

# ensure sort was correct, comparing with built-in sort
print "CONFIRMED SORT WAS CORRECT? ";
my @sorted = sort {$a <=> $b} @ARGV; # built in numerical sort

my $i = my $j = 0;
while( $i < scalar(@sol) || $j < scalar(@sorted)){
    if( $sol[$i++] != $sorted[$j++] ){
        print "FALSE\n\n";
        exit(0);
    }
}
print "TRUE\n\n";

### END MAIN ###


# break array down in half until sorted, then call merge
#
# arg0 = array
sub mergeSort{
    my $arr = shift; #take argument (reference to array)

    #base case: array size is 1 implies it is sorted
    if( scalar(@$arr) == 1){
        return;
    }

    my $bound = int( scalar(@$arr)/2 ) ; # half array size
    my @left = @$arr[ 0 .. ($bound - 1) ]; # first half of array
    my @right = @$arr[ $bound .. ( scalar(@$arr)-1) ]; # remaining half

    # recurse while both halves must still be broken down
    mergeSort( \@left );
    mergeSort( \@right );

    # merge the two sorted halves
    merge( \@left, \@right, $arr ); #pass references

}#end sort()


# called by sort
# merge arrays a & b into arr
#
# arg0,1 = references to the two sorted arrays a & b
#   arg2 = merged array that shall contain elements of a & b
sub merge{

    #store reference to arrays
    my $aRef = shift; # store arg0 = pointer to array a
    my $bRef = shift;
    my $arr = shift;

    #store dereferences of arrays a & b
    my @a = @{$aRef};
    my @b = @{$bRef};

    my $r = my $i = my $j = 0; # indexers for @arr, @a, @b

    #fill arr in proper order while a and b both contain elements
    while( ($i < scalar(@a)) && ($j < scalar(@b)) ){
        if( $a[$i] > $b[$j]){
            @$arr[$r] = $b[$j];
            $j++;
        }
        else{
            @$arr[$r] = $a[$i];
            $i++;
        }
        $r++;
    }

    #once the while loop is broken, this means a or b has been emptied,
    #so simply need to fill arr with elements of the remaining array,
    #so fill arr with remaining (if any) elements of a
    while( $i < scalar(@a) ){
        @$arr[$r++] = $a[$i++];
    }

    #fill arr with remaining (if any) elements of b
    while( $j < scalar(@b) ){
        @$arr[$r++] = $b[$j++];
    }
}#end merge()

Answer 1

Here are some thoughts on your code

• Always prefer use warnings to -w on the command line or shebang line

• People whose first language is Perl will thank you for using only lower case letters, decimal digits and underscores in local variable names. Capital letters are reserved for globals such as constants or package names

• Reduce your comments as far as possible, and try to use identifiers that are self-explanatory. Comments break the flow of comprehension and should be reserved for truly confusing sections. Think of it like the friend sitting next to you on the sofa "helpfully" explaining the movie to you

• Get used to the implicit context of expressions and reduce your use of scalar. For instance, check whether any command-line parameters have been supplied with unless ( @ARGV ) { ... }

• Get used to the statement modifier forms of if, while, unless and for, which allow things like return if @$arr == 1

• Get used to variable interpolation. By default arrays are interpolated into double-quoted strings with spaces separating the elements, which lets you write things like printf "\nBEFORE: [@ARGV]\n";. It also lets you compare (short) arrays with just "@sol" eq "@sorted"

• Get used to using and and or for control flow instead of && and ||. They have better readability and their low priority will help you write what you mean without excessive parentheses

• Get used to using list assignment, particularly when copying the parameters of a subroutine

• Remember that $#arr is the last index of @arr, so scalar(@$arr)-1) is $#$arr

Here's how I would implement your algorithm. The only optimisation I can see immediately is that there's no need to copy the arrays in the merge subroutine. It is simple to access the data in-place using the dereference operator ->

#!/usr/bin/perl

use strict;
use warnings;

unless ( @ARGV ) {
    warn "ERROR: You must specify a list of integers\n",
         "EXAMPLE: perl merge_sort.pl 1 7 20 11 2\n\n";
    exit -1;
}

printf "\nBEFORE: [@ARGV]\n";
print scalar @ARGV, " elements\n\n";

my @sol = @ARGV;
merge_sort(\@sol);

printf "AFTER: [@sol]\n";
print scalar @sol, " elements\n\n";

print "Confirmed sort was correct? ";

my @sorted = sort {$a <=> $b} @ARGV;
print "@sol" eq "@sorted" ? "TRUE\n\n" : "FALSE\n\n";



sub merge_sort {

    my ($arr) = @_;

    return if @$arr == 1;

    my $bound = int( @$arr / 2 );
    my @left  = @$arr[ 0 .. $bound-1 ];
    my @right = @$arr[ $bound .. $#$arr ];

    merge_sort( \@left );
    merge_sort( \@right );

    merge( \@left, \@right, $arr );
}


sub merge {

    my ($a_ref, $b_ref, $arr) = @_;

    my ($i, $j, $r) = (0, 0, 0);

    while ( $i < @$a_ref and $j < @$b_ref ) {

        if ( $a_ref->[$i] < $b_ref->[$j] ) {
            $arr->[$r++] = $a_ref->[$i++];
        }
        else {
            $arr->[$r++] = $b_ref->[$j++];
        }
    }

    $arr->[$r++] = $a_ref->[$i++] while $i < @$a_ref;
    $arr->[$r++] = $b_ref->[$j++] while $j < @$b_ref;
}

Answer 2

Just a few minor remarks,

this is a shallow copy of @{$aRef} array and there is no need to move elements into another array,

my @a = @{$aRef};

instead keep using an array reference,

my $a = $aRef; # later use @$a instead of @a

You can also replace two similar while() loops

while( $i < scalar(@a) ){
    # array slice not needed when assigning single scalar
    # @$arr[$r++] = $a[$i++];

    $arr->[$r++] = $a[$i++];
}

with array slice,

my $n = @$a - $i;
@$arr[$r .. ($r+$n)] = @$a[$i .. ($i+$n)];

This is a little tighter while() loop (not necessarily faster one, so you can benchmark it)

#fill arr in proper order while a and b both contain elements
while( ($i < @$a) && ($j < @$b) ) {
    $arr->[$r++] = ($a->[$i] > $b->[$j]) ? $b->[$j++] : $a->[$i++];

    #if( $a->[$i] > $b->[$j]){
    #    $arr->[$r++] = $b->[$j++];
    #}
    #else{
    #    $arr->[$r++] = $a->[$i++];
    #}
}

Answer 3

$i and $j in merge are extraneous if you don't need to preserve the original array, which saves all of the increments and de-referencing -- and saves some heap if the input array is large.

For large[ish] arrays you could also populate the scratch arrays with:

my @lower = splice @$arr, 0, @$arr/2;
my @upper = splice @$arr;

which leaves $arr empty in the call to merge. This also leaves $arr empty but pre-sized on the heap to the correct number of elements, which saves some heap management.

Note that @$arr/2 used as an offset is treated as an integer, which saves the int() call also.

So, merge gets the lower and upper portions with an empty, pre-sized $arr:

my ( $l, $u, $arr ) = @_;

while( @$l && @$u )
{
    push @$arr,
    $l->[0] <= $u->[0]
    ? shift @$l
    : shift @$u
}

push @$arr, @$l, @$u

push in Perl turns out to be rather fast, especially for a pre-sized array.