Doers of Stuff.org

A place to Do Stuff and see Stuff Done…

Algorithm and Blues (part 2)

I mentioned recently I faced the infamous Bubble Sort in an interview and did less than stellar. Excuse mongering aside, I decided I should look into it and discussed it here. Now reading that article, you might be inclined to cut me some slack, but really, it’s not that tough. I knew I needed two loops to manage it and without thinking deeper, I figured both would loop based on the number of words in the array. So allowing for hindsight, let’s walk through what I would have done.

We can use all the same startup as our previous script. In fact, since we elected to use a subroutine for bubble_don() we can just use the same script and create a new subroutine, bubble_me(). So I’ll skip discussion of the top of the script since you can get that from my previous post here, and jump straight into the new code.

We start with the subroutine call and the subroutine declaration.

bubblesort_me(["wilma", "pebbles", "fred", "dino", "barney", "bam-bam"]);

sub bubblesort_me{
}

The support part of the subroutine is similar to bubble_don(), but less complex. Again, we will pass in our word list as a reference to an array we will call words. We will use two special Perl variables to set two more variables, $wordCount and $lastIndex. As the variable names imply, @$words returns the number of words (elements) in the array and $#$words returns the last index of the array. Obviously, there are a variety of ways I could have handled this. As the Perl saying goes TIMTOWTDI (There Is More Than One Way To Do It). Since Perl Arrays start at zero, the last index is nothing more than one less than the number of elements. I could just do the math everywhere needed.

In general, I prefer and lean towards being explicit not only in what I am doing, but to the degree possible, WHY I’m doing it. Perl has two built in special variables for arrays, so I chose to use them, and save them in variables whose purpose I assume will be made self-evident by their names. In other words, I am trying to make the code self-documenting, but I am trying to document “WHY”, not just “what.”

sub bubblesort_me{
    my $words = shift;
    my $wordCount = @$words;
    my $lastIndex = $#$words;

    DeBug($words, "presort", "bubblesort_me") if $DEBUG;

    DeBug($words, "postsort", "bubblesort_me") if $DEBUG;
}

Our two, nested loops will then fall between the DeBug() calls. The first, outer loop logic assumes we will need to perform our sorting action once for every word. Coming up with this on the spot (with no previous thought) I would have looped exactly once for every word. However, as mentioned in my previous post, It takes very little thought to recognize the first and second words in the array (alphabetically) will be sorted at the same time. i.e. if we have to move the second to the last word from position 1 to position 2, the word in position 1 is automatically “sorted.” So I will grant myself the one less loop optimization and decide to loop one less than the word count. Yes, I realize mathematically, the element count minus one for a Perl array is equal to the last index number. But conceptually, our logic is based not on the index numbers, but on the word count and I want my code to indicate that. $i is just the loop counter. Since I don’t need it anywhere else, I declare it, use it and discard it all within the loop itself.

    for (my $i = 1; $i <= $wordCount -1; $i++) {

    }

The second loop is where we do the bubbling. The logic I used is simplified from Dr. Knuth’s. It will not try to save any cycles because it knows what has already been sorted. It will, somewhat wastefully, run through the entire array each time. In retrospect, I understand this, but would never have thought of it on the fly. Notice again how the outer loop makes clear conceptually our loop count is based on the word count and the inner loop makes clear it is looping based on the array index. This is also [obviously] why the outer loop starts counting at ‘1’ and the inner loop at ‘0’.

    for (my $i = 1; $i <= $wordCount -1; $i++) {
        for (my $j=0; $j <= $lastIndex - 1; $j++){
            if ($words->[$j] gt $words->[$j+1]) {
                @$words[$j, $j+1] = @$words[$j+1, $j];
            }
        }
    }

Altogether now (including bubble_don()) our code looks like this.

#!C:\Strawberry\perl\bin\perl.exe -w

use strict;
use warnings;
use diagnostics;
use English;

local $OUTPUT_AUTOFLUSH = 1;

my $DEBUG = 1;

bubblesort_me(["wilma", "pebbles", "fred", "dino", "barney", "bam-bam"]);
bubblesort_don(["wilma", "pebbles", "fred", "dino", "barney", "bam-bam"]);

sub bubblesort_me{
    my $words = shift;
    my $wordCount = @$words;
    my $lastIndex = $#$words;

    DeBug($words, "presort", "bubblesort_me") if $DEBUG;
    for (my $i = 1; $i <= $wordCount -1; $i++) {
        for (my $j=0; $j <= $lastIndex - 1; $j++){
            if ($words->[$j] gt $words->[$j+1]) {
                @$words[$j, $j+1] = @$words[$j+1, $j];
            }
        }
    }
    DeBug($words, "postsort", "bubblesort_me") if $DEBUG;
}

sub bubblesort_don{
    use Array::Base +1; # Start array index at 1 to match Algorithm description
    my $R = shift;      # reference to array of records (words)
    my $K = $R;         # secondary reference to records array.  used as the "key" for each record (word)
    my $BOUND;          # highest index for which the record is not known to be in its final position
    my $j;              # lopp index
    my $t;              # last swapped value array index
    my $N = $#$R;       # highest array index (aka, number of array elements)

    DeBug($R, "presort", "bubblesort_don") if $DEBUG;
    B1: # [Initialize BOUND.]
        $BOUND = $N;
    B2: # [Loop on j.]
        $t = 0;
        for ($j=1; $j<=$BOUND-1; $j++){
    B3: # [Compare/exchange Rj:Rj+1.]
            if ($K->[$j] gt $K->[$j+1]) {
                @$R[$j, $j+1] = @$R[$j+1, $j];
                $t = $j;
            }
        }
    B4: # [Any exchanges?]
    if ($t) {
        $BOUND = $t;
        goto B2;
    }
    DeBug($R, "postsort", "bubblesort_don") if $DEBUG;
    no Array::Base;
}

sub DeBug {
    my $array = shift;
    my $sorting = shift;
    my $calling_subroutine = shift;
    my $tab = "";
    $tab = "     " if ($sorting eq "postsort");
    print $tab . " Called by: " . $calling_subroutine . "\n";
    print $tab . "Word count: " . @$array . "\n";
    print $tab . "Sort State: " . $sorting . "\n";
    print $tab;
    print join("\n$tab", @$array),"\n";
    print "\n";
}

Running it produces the following:

PS D:\Dev\PerlPlay\TinyBubbles> .\TinyBubbles.pl 
 Called by: bubblesort_me
Word count: 6
Sort State: presort
wilma
pebbles
fred
dino
barney
bam-bam

      Called by: bubblesort_me 
     Word count: 6
     Sort State: postsort      
     bam-bam
     barney
     dino
     fred
     pebbles
     wilma

 Called by: bubblesort_don     
Word count: 6
Sort State: presort
wilma
pebbles
fred
dino
barney
bam-bam

      Called by: bubblesort_don
     Word count: 6
     Sort State: postsort      
     bam-bam
     barney
     dino
     fred
     pebbles
     wilma

PS D:\Dev\PerlPlay\TinyBubbles> 

Now, if I could just get that time machine up to 88 mph I could leave this on a post-it note next to my laptop, just before that interview…

Leave a Reply

Algorithm and Blues (part 2)

by Robert time to read: 5 min
0