Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

"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);; } } }

In reply to Re: Smoothsort by Anonymous Monk
in thread Smoothsort by QuillMeantTen

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.
  • Please read these before you post! —
  • 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:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    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?