Perl Monk, Perl Meditation PerlMonks

### comment on

 Need Help??

"I'm also looking to make this code more readable and easily understandable as well as shorter"

```#!/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);;
}
}
}

In reply to Re: Smoothsort by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

• Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
• Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
• Read Where should I post X? if you're not absolutely sure you're posting in the right place.
• Posts may use any of the Perl Monks Approved HTML tags:
a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
• You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
 For: Use: & & < < > > [ [ ] ]
• Link using PerlMonks shortcuts! What shortcuts can I use for linking?

Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (4)
As of 2020-11-28 10:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?