Previously, in our hit series, “Algorithm and Blues” (part 1) and (part 2), our villain, Dr. Evil Bubblesort made his appearance. Not once, but twice. Both times being neatly stuffed into a clever subroutine of confinement. But our hero was subjected to much turmoil, gnashing of teeth and mind altering spell books (THE ART OF COMPUTER PROGRAMMING, VOLUME 3, SORTING AND SEARCHING, SECOND EDITION, by Dr. Donald Knuth).
For the rest of us, if you don’t feel like figuring that all out on your own, consider cheating (I did) and pull-out Jon Orwant’s book, “Algorithms With Perl” and turn to page 125 where you will find something like this.
sub bubblesort{
my $array = shift;
my $i;
my $j;
my $ncomp = 0;
my $nswap = 0;
for ($i = $#$array; $i; $i--) {
for ($j=1; $j<=$i; $j++){
$ncomp++;
if ($array->[$j-1] gt $array->[$j]) {
@$array[$j, $j-1] = @$array[$j-1, $j];
$nswap++;
}
}
}
}In this version, neither $ncomp nor $nswap are functional parts of Jon Orwant’s implementation. Since they are only there to add analytic information referenced in the book, we will just remove them. In fact, we’ll bring out our TinyBubbles.pl script one more time and add the following to it.
bubblesort_jon(["wilma", "pebbles", "fred", "dino", "barney", "bam-bam"]);
sub bubblesort_jon{
my $array = shift;
my $i;
my $j;
DeBug($array, "presort", "bubblesort_jon") if $DEBUG;
for ($i = $#$array; $i; $i--) {
for ($j=1; $j<=$i; $j++){
if ($array->[$j-1] gt $array->[$j]) {
@$array[$j, $j-1] = @$array[$j-1, $j];
}
}
}
DeBug($array, "postsort", "bubblesort_jon") if $DEBUG;
}
As we saw in part 1 of this series, Dr. Knuth uses a temporary variable ($t) to track the last sorted index. He uses that to set the variable $BOUND in the loop test. This has the theoretical advantage of being able to lessen the number of cycles the bubble loop must go through. In my implementation, I simply left this out. Jon’s algorithm takes a middle ground and assumes each successive loop can do at least one less iteration. To manage this, his outer loop counts DOWN instead of up. He starts the outer loop counter with the value of the last index and decrements it after each loop. His inner loop, then loops UP from one to whatever the current value of the outer loop counter is, which will be one less each time.
Having the outer loop count down instead of up is really the clever part here. Doing so automatically shrinks the known, unsorted boundary of our word list without the need of the temporary variable $t from Dr. Knuth’s algorithm. In theory, I would imagine Dr. Knuth’s version would run the fastest on sorted, or mostly sorted data as it would loop the fewest times. Jon Orwant’s would be next fastest on the same data as the inner loop would iterate one less time for each iteration of the outer loop, where mine would run the same time, every time (mostly) no matter how sorted or unsorted the list because it will perform precisely the same number of loops every single time.
But more on that later. Until then, always remember:
True friends don’t try to pull you up when you’re down. They sit down with you with chocolate and a bottle of bubbly.
fortune cookie
For posterity, here is the new script in its entirety.
#!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_jon(["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_jon{
my $array = shift;
my $i;
my $j;
DeBug($array, "presort", "bubblesort_jon") if $DEBUG;
for ($i = $#$array; $i; $i--) {
for ($j=1; $j<=$i; $j++){
if ($array->[$j-1] gt $array->[$j]) {
@$array[$j, $j-1] = @$array[$j-1, $j];
}
}
}
DeBug($array, "postsort", "bubblesort_jon") 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";
}
And of course, a sample run…
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_jon
Word count: 6
Sort State: presort
wilma
pebbles
fred
dino
barney
bam-bam
Called by: bubblesort_jon
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>