http://qs321.pair.com?node_id=1142518

QuillMeantTen has asked for the wisdom of the Perl Monks concerning the following question:

greetings,
Last year after I discovered smoothsort I thought about making it my fetish sorting algorithm.
After breaking my teeth on it for a while I dumped it in favor of introsort.

Three days ago I decided to get back at it.

UPDATE: thanks to Athanasius, I set up to reworking all my for loops and found out where the error occured, it was a silly mistake having to do with parenthesis placement :

when working on the heapify function (I started there because it seemed most logical that the loss of the max heap status occured because of something occuring there)
I found out the following : instead of giving the right position as \$start+leonardo(\$order)-1 as position for root I gave \$start+leonardo(\$order-1)

This mistake created an error that could go unnoticed with small enough trees but would grow quite fast as tree size would grow.

I also made some refactoring to make the code more readable (mainly using hashs instead of those pesky chained dereference.
I post the code here at the top, the old flawed code can be found at the bottom. Thanks for the help guys, I'm also looking to make this code more readable and easily understandable as well as shorter so it can be used to explain in a perl way (rather than keithschwartz's c++ way) how to make an unoptimized smoothsort.

Update's Update : added some new lines to prevent eyes from bleeding and the following link th the CUFP smoothsort post

```#!/usr/bin/perl
use strict;
use warnings;
use Memoize;
memoize('leonardo');
sub leonardo{
my \$n = shift;
\$n == 0 || \$n == 1?1:leonardo(\$n-2)+leonardo(\$n-1)+1;
}

sub heapify{
#this function operates on only one tree, given its order and star
+t
#it will make sure its a heap
my(\$tab_ref,\$order,\$start) = @_;
my \$move = 0;
#if the tree order is 0 or 1 then its a one element tree, so
if(\$order > 1){
my %father = (value=>\$tab_ref->[\$start+leonardo(\$order)-1],
pos=>\$start+leonardo(\$order)-1);
my %left_child = (value =>\$tab_ref->[\$start+leonardo(\$order-1)
+-1],
pos=>\$start+leonardo(\$order-1)-1);
my %right_child = (value=>\$tab_ref->[\$start+leonardo(\$order)-2
+],
pos=>\$start+leonardo(\$order)-2);

#is left child bigger than father?
#if yes swap them
if(\$left_child{value} > \$father{value}){

\$tab_ref->[\$father{pos}] = \$left_child{value};
\$tab_ref->[\$left_child{pos}] = \$father{value};
\$move++;
}

#is right child bigger than father? if yes swap them
elsif ( \$right_child{value} > \$father{value}){
\$tab_ref->[\$father{pos}] = \$right_child{value};
\$tab_ref->[\$right_child{pos}] = \$father{value};
\$move++;
}
#now lets do a recursion into the left child if it is more tha
+n one
#node
if(\$order -1 > 1){
heapify(\$tab_ref,\$order-1,\$start);
}
#now lets do a recursion into the right child if it is more th
+an one
#node
if(\$order-2 > 1){
heapify(\$tab_ref,\$order-2,\$start+leonardo(\$order-1));
}

if(\$move > 0){
#lets reheapify myself in case something percolated up
heapify(\$tab_ref,\$order,\$start);
}

}
}

sub restring{
my(\$tab_ref,\$trees_ref,\$treenum) = @_;
my @roots;
my (\$start,\$root) = (0,0);

#I create an array containing the indices of all tree roots
for my \$i ( 0..\$treenum-1){
(\$start,\$root) = get_start_root(\$trees_ref,\$i);
\$roots[\$i] = \$root;
}
my \$move = 0;

#now for each tree root I make sure its bigger than its predecesso
+r
for my \$i ( 0 ..  \$#roots){
my %cur = (pos=>\$roots[\$i],value=>\$tab_ref->[\$roots[\$i]]);

#if I'm checking the first root, the predecessor is himself
my %prev = \$i > 0?(pos=>\$roots[\$i-1],value=>\$tab_ref->[\$roots[
+\$i-1]]):%cur;

#if the current root is lower than its predecessor I swap them
#then make sure the heap property of both is still ok
if(\$cur{value}<\$prev{value}){
\$tab_ref->[\$cur{pos}] = \$prev{value};
\$tab_ref->[\$prev{pos}] = \$cur{value};
\$move++;
(\$start,\$root) = get_start_root(\$trees_ref,\$i);
heapify(\$tab_ref,\$\$trees_ref[\$i],\$start);
(\$start,\$root) = get_start_root(\$trees_ref,\$i-1);
heapify(\$tab_ref,\$\$trees_ref[\$i-1],\$start);
}
}

#if I made any move, the heapify function might have crapped up my
#stringing, hence I recurse to make sure everything is ok
if(\$move > 0){
restring(\$tab_ref,\$trees_ref,\$treenum);
}
}
my(\$trees_ref,\$tree_num_ref,\$tab_ref) = @_;
my (\$start,\$root);

#if last two treers are of continuous orders
if(\$\$trees_ref[\$\$tree_num_ref-1] == \$\$trees_ref[\$\$tree_num_ref-2]-
+1){
\$\$trees_ref[\$\$tree_num_ref-1]."\n";
\$\$trees_ref[\$\$tree_num_ref-2]++;
\$\$tree_num_ref--;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+2);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}

#if last tree is not of order 1 I create one
elsif(\$\$trees_ref[\$\$tree_num_ref-1] != 1){
\$\$trees_ref[\$\$tree_num_ref] = 1;
\$\$tree_num_ref++;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}

#else I create a tree of order 0
else{
\$\$trees_ref[\$\$tree_num_ref] = 0;
\$\$tree_num_ref++;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}
}

sub smoothsort{
my \$tab_ref = shift;
my @trees;
my \$trees_ref = \@trees;
my \$treenum = 0;
#I have more than one value, so I initiate with two trees of l0 an
+d l1
if(\$#\$tab_ref > 0){
\$\$trees_ref[0] = 1;
\$\$trees_ref[1] = 0;
\$treenum +=2;
}

#I have only one value
else{
\$\$trees_ref[0] = 0;
\$treenum++;
}
my(\$start,\$root);
restring(\$tab_ref,\$trees_ref,\$treenum);
my \$cur = 2;
while(\$cur < \$#\$tab_ref+1){
\$cur++;
}

#now that I'm done tree building and stringing I can start to dequ
+eue:
#starting from the last tree
while(\$treenum > 0){
my \$cur_tree = \$\$trees_ref[\$treenum-1];
(\$start,\$root)=get_start_root(\$trees_ref,\$treenum-1);
if(\$cur_tree > 1){
#this tree has children, hence it is broken up in two subt
+rees
#the first is of the same order minus one takes the place
+of
#its father, the second one of same order minus two is add
+ed
\$\$trees_ref[\$treenum] = \$\$trees_ref[\$treenum-1]-2;
\$\$trees_ref[\$treenum-1] -= 1;
\$treenum++;
(\$start,\$root) = get_start_root(\$trees_ref,\$treenum-1);
restring(\$tab_ref,\$trees_ref,\$treenum);
heapify(\$tab_ref,\$\$trees_ref[\$treenum-1],\$start);

(\$start,\$root) = get_start_root(\$trees_ref,\$treenum-2);
heapify(\$tab_ref,\$\$trees_ref[\$treenum-2],\$start);

}
else{
\$treenum--;
}
}
}

sub get_start_root{
my (\$trees_ref,\$tree_ind) = @_;
my (\$start,\$root) = (0,0);
#if it is the first tree, then its start indice is 0
if(\$tree_ind > 0){
for my \$i ( 0 .. \$tree_ind-1){
\$start += leonardo(\$\$trees_ref[\$i]);
}
}
\$root = \$start + leonardo(\$\$trees_ref[\$tree_ind])-1;
return (\$start,\$root);
}

my \$n = \$ARGV[0];
my @tab;
for(my \$i = 0; \$i < \$n;\$i++){
\$tab[\$i] = int(rand(1000));
}
print "unsorted tab = @tab\n";
smoothsort(\@tab);

print "sorted tab = @tab\n"

So here is a flawed implementation : it works for arrays up to a size of 9 but after I start getting misplaced values. I would love some help, for I feel close to my goal and yet I am thwarted.

```#!/usr/bin/perl
use strict;
use warnings;
sub leonardo{
my \$n = shift;
if(\$n == 0 || \$n == 1){
return 1;
}
else{
return leonardo(\$n-2)+leonardo(\$n-1)+1;
}
}

sub heapify{
#this function operates on only one tree, given its order and star
+t
#it will make sure its a heap
my(\$tab_ref,\$order,\$start) = @_;
printf("going to heapify:\n");
for(my \$i = \$start; \$i < leonardo(\$order);\$i++){
print "\$\$tab_ref[\$i]\n";
}
my \$move = 0;
#if the tree order is 0 or 1 then its a one element tree, so
if(\$order > 1){
my \$tmp;
#is left child bigger than father?
#if yes swap them
if(\$\$tab_ref[\$start+leonardo(\$order)-1] <
\$\$tab_ref[\$start+leonardo(\$order-1)-1]){

\$tmp = \$\$tab_ref[\$start+leonardo(\$order)-1];
\$\$tab_ref[\$start+leonardo(\$order)-1] =
\$\$tab_ref[\$start+leonardo(\$order-1)-1];

\$\$tab_ref[\$start+leonardo(\$order-1)-1] = \$tmp;
\$move++;
}

#is right child bigger than father? if yes swap them
elsif (\$\$tab_ref[\$start+leonardo(\$order)-1]<
\$\$tab_ref[\$start+leonardo(\$order)-2]){

\$tmp = \$\$tab_ref[\$start+leonardo(\$order)-1];
\$\$tab_ref[\$start+leonardo(\$order)-1] =
\$\$tab_ref[\$start+leonardo(\$order)-2];

\$\$tab_ref[\$start+leonardo(\$order)-2] = \$tmp;
\$move++;
}
for(my \$i = \$start; \$i < leonardo(\$order);\$i++){
printf("\n\nheapified:\n");
print "\$\$tab_ref[\$i]\n";
}
#now lets do a recursion into the left child
heapify(\$tab_ref,\$order-1,\$start);

#now lets do a recursion into the right child
heapify(\$tab_ref,\$order-2,\$start+leonardo(\$order));

if(\$move > 0){
#lets reheapify myself in case something percolated up
print "reheapifying myself:\n";
heapify(\$tab_ref,\$order,\$start);
}

}
}

sub restring{
my(\$tab_ref,\$trees_ref,\$treenum) = @_;
my @roots;
my (\$start,\$root) = (0,0);

#I create an array containing the indices of all tree roots
for(my \$i = 0; \$i < \$treenum;\$i++){
(\$start,\$root) = get_start_root(\$trees_ref,\$i);
\$roots[\$i] = \$root;
}
my \$move = 0;

#now for each tree root I make sure its bigger than its predecesso
+r
for(my \$i = 0;\$i < \$#roots+1;\$i++){
my \$cur = \$roots[\$i];

#if I'm checking the first root, the predecessor is himself
my \$prev = \$i > 0?\$roots[\$i-1]:\$cur;

#if the current root is lower than its predecessor I swap them
#then make sure the heap property of both is still ok
if(\$\$tab_ref[\$cur]<\$\$tab_ref[\$prev]){
my \$tmp = \$\$tab_ref[\$cur];
my \$debug1 = \$\$tab_ref[\$prev];
print "exchange cur at \$cur = \$tmp, prev at \$prev =\$debug1
+\n";
\$\$tab_ref[\$cur] = \$\$tab_ref[\$prev];
\$\$tab_ref[\$prev] = \$tmp;
\$move++;
(\$start,\$root) = get_start_root(\$trees_ref,\$i);
heapify(\$tab_ref,\$\$trees_ref[\$i],\$start);
(\$start,\$root) = get_start_root(\$trees_ref,\$i-1);
heapify(\$tab_ref,\$\$trees_ref[\$i-1],\$start);
}
}

#if I made any move, the heapify function might have crapped up my
#stringing, hence I recurse to make sure everything is ok
if(\$move > 0){
restring(\$tab_ref,\$trees_ref,\$treenum);
}
}
my(\$trees_ref,\$tree_num_ref,\$tab_ref) = @_;
my (\$start,\$root);
if(\$\$trees_ref[\$\$tree_num_ref-1] == \$\$trees_ref[\$\$tree_num_ref-2]-
+1){
print "contiguous trees: ".\$\$trees_ref[\$\$tree_num_ref-2].
\$\$trees_ref[\$\$tree_num_ref-1]."\n";
\$\$trees_ref[\$\$tree_num_ref-2]++;
\$\$tree_num_ref--;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+2);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}

#if last tree is not of order 1 I create one
elsif(\$\$trees_ref[\$\$tree_num_ref-1] != 1){
\$\$trees_ref[\$\$tree_num_ref] = 1;
\$\$tree_num_ref++;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}

#else I create a tree of order 0
else{
\$\$trees_ref[\$\$tree_num_ref] = 0;
\$\$tree_num_ref++;
(\$start,\$root) = get_start_root(\$trees_ref,\$\$tree_num_ref-
+1);
heapify(\$tab_ref,\$\$trees_ref[\$\$tree_num_ref-1],\$start);
restring(\$tab_ref,\$trees_ref,\$\$tree_num_ref);
}
}

sub smoothsort{
my \$tab_ref = shift;
my @trees;
my \$trees_ref = \@trees;
my \$treenum = 0;
#I have more than one value, so I initiate with two trees of l0 an
+d l1
if(\$#\$tab_ref > 0){
\$\$trees_ref[0] = 1;
\$\$trees_ref[1] = 0;
\$treenum +=2;
}

#I have only one value
else{
\$\$trees_ref[0] = 0;
\$treenum++;
}
my(\$start,\$root);
restring(\$tab_ref,\$trees_ref,\$treenum);
my \$cur = 2;
print "trees = @trees\n";
while(\$cur < \$#\$tab_ref+1){
for(my \$i = 0; \$i < \$treenum;\$i++){
print \$\$trees_ref[\$i]."\n";
}
\$cur++;
}

#now that I'm done tree building and stringing I can start to dequ
+eue:
#starting from the last tree
print "now dequeuing\n";
while(\$treenum > 0){
print "treenum  \$treenum\n";
my \$cur_tree = \$\$trees_ref[\$treenum-1];
print "doing tree of order \$cur_tree\n";
(\$start,\$root)=get_start_root(\$trees_ref,\$treenum-1);
print"removing root ".\$\$tab_ref[\$root]." at \$root\n";
if(\$cur_tree > 1){
#this tree has children, hence it is broken up in two subt
+rees
#the first is of the same order minus one takes the place
+of
#its father, the second one of same order minus two is add
+ed
\$\$trees_ref[\$treenum] = \$\$trees_ref[\$treenum-1]-2;
\$\$trees_ref[\$treenum-1] -= 1;
\$treenum++;
for(my \$i = 0; \$i < \$treenum;\$i++){
print \$\$trees_ref[\$i]."\n";
}
(\$start,\$root) = get_start_root(\$trees_ref,\$treenum-1);
restring(\$tab_ref,\$trees_ref,\$treenum);
heapify(\$tab_ref,\$\$trees_ref[\$treenum-1],\$start);

(\$start,\$root) = get_start_root(\$trees_ref,\$treenum-2);
heapify(\$tab_ref,\$\$trees_ref[\$treenum-2],\$start);

}
else{
\$treenum--;
}
}
}

sub get_start_root{
my (\$trees_ref,\$tree_ind) = @_;
my (\$start,\$root) = (0,0);
#if it is the first tree, then its start indice is 0
if(\$tree_ind > 0){
for(my \$i = 0; \$i < \$tree_ind;\$i++){
\$start += leonardo(\$\$trees_ref[\$i]);
}
}
\$root = \$start + leonardo(\$\$trees_ref[\$tree_ind])-1;
return (\$start,\$root);
}

my \$n = \$ARGV[0];
my @tab;
for(my \$i = 0; \$i < \$n;\$i++){
\$tab[\$i] = int(rand(1000));
}
=cut
my @tab = qw( 446 651 889 706 521 643 326 446 10);# 433 );
print "unsorted tab = @tab\n";
smoothsort(\@tab);

print "sorted tab = @tab\n"