"I'm also looking to make this code more readable and easily understandable as well as shorter"
Here's my try at shorter, coding straight from the Wikipedia page.
#!/usr/bin/perl
# http://perlmonks.org/?node_id=1142518
# https://en.wikipedia.org/wiki/Smoothsort
use strict;
use warnings;
my $size = shift // 23;
my (@n, @roots); # Leonardo numbers of heaps, and root indexes
my @leonardo = (1, 1); # https://en.wikipedia.org/wiki/Leonardo_number
push @leonardo, $leonardo[-1] + $leonardo[-2] + 1
while $leonardo[-1] <= $size; # precompute enough (fake memoize :)
my @original = my @a = map { int rand 10 } 1..$size;
print "start a @a\n";
for my $root (0..$#a) ############################## grow
{
if( @n >= 2 && $n[-2] == $n[-1] + 1 ) # consecutive => make bigger h
+eap
{
splice @n, -2, 2, $n[-2] + 1;
splice @roots, -2, 2, $root;
}
else # new heap of size 1
{
push @n, @n && $n[-1] == 1 ? 0 : 1;
push @roots, $root;
}
restring( $#n );
}
print "grown a @a n @n\n";
while( @n ) ######################################## shrink
{
if( $n[-1] > 1 ) # add two subheaps to string
{
push @n, --$n[-1] - 1;
splice @roots, -1, 0, --$roots[-1] - $leonardo[$n[-1]];
restring( $#n - 1 );
restring( $#n );
}
else # just remove last size 1 heap
{
pop @n;
pop @roots;
}
}
print "answer a @a n @n\n";
my @oldsort = sort {$a <=> $b} @original;
"@a" eq "@oldsort" or die "***** not sorted *****";
sub restring
{
my ($more, $current) = (1, @_);
while( $current > 0 and $more )
{
my ($root, $stringleftroot) = @roots[ $current, $current - 1 ];
my $leftval = $a[$stringleftroot];
if( $more = $leftval > $a[$root] && # test left > current
($n[$current] <= 1 or $leftval > $a[$root - 1] &&
$leftval > $a[$root - 1 - $leonardo[$n[$current]-2]] ) )
{
@a[$root, $stringleftroot] = @a[ $stringleftroot, $root]; # swap
$current--; # and move left
}
}
my ($n, $root) = ( $n[$current], $roots[$current] ); # filter
while( $n > 1 )
{
my $rightroot = $root - 1;
my $leftroot = $rightroot - $leonardo[$n - 2];
$a[$leftroot] <= $a[$root] && $a[$rightroot] <= $a[$root] and retu
+rn;
if( $a[$leftroot] > $a[$rightroot] ) # swap largest child
{
@a[$leftroot, $root] = @a[$root, $leftroot];
($n, $root) = ($n - 1, $leftroot);;
}
else
{
@a[$rightroot, $root] = @a[$root, $rightroot];
($n, $root) = ($n - 2, $rightroot);;
}
}
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.