Perl-Sensitive Sunglasses PerlMonks

### comment on

 Need Help??
Translated from C (translated from Delphi) by Keith Schwarz and slightly Perlified:
```package SmoothSort;
use warnings;
use strict;

my (\$q, \$r, \$p, \$b, \$c, \$r1, \$b1, \$c1);  # Boo! Globals!
my \$A;

sub up   { (\$_[0], \$_[1]) = (\$_[0] + \$_[1] + 1, \$_[0]) }
sub down { (\$_[0], \$_[1]) = (\$_[1], \$_[0] - \$_[1] - 1) }

sub sift {
my \$r2;
my \$T = \$A->[ my \$r0 = \$r1 ];
while (\$b1 >= 3) {
\$r2 = \$r1 - \$b1 + \$c1;
\$r2 = \$r1 - 1, down(\$b1, \$c1) if \$A->[ \$r1 - 1 ] > \$A->[\$r2];
if (\$A->[\$r2] <= \$T) {
\$b1 = 1;
} else {
\$A->[\$r1] = \$A->[\$r2];
\$r1 = \$r2;
down(\$b1, \$c1);
}
}
\$A->[\$r1] = \$T if \$r1 - \$r0;
}

sub trinkle {
my (\$p1, \$T) = (\$p, \$A->[ my \$r0 = \$r1 ]);
my (\$r2, \$r3);
(\$b1, \$c1) = (\$b, \$c);
while (\$p1 > 0) {
\$p1 >>= 1, up(\$b1, \$c1) while !(\$p1 & 1);
\$r3 = \$r1 - \$b1;
if ((1 == \$p1) || \$A->[\$r3] <= \$T) {
\$p1 = 0;
} else {
\$p1--;
if (1 == \$b1) {
\$A->[\$r1] = \$A->[\$r3];
\$r1 = \$r3;
} elsif (\$b1 >= 3) {
\$r2 = \$r1 - \$b1 + \$c1;
if (\$A->[ \$r1 - 1 ] > \$A->[\$r2]) {
\$r2 = \$r1 - 1;
down(\$b1, \$c1);
\$p1 <<= 1;
}
if (\$A->[\$r2] <= \$A->[\$r3]) {
\$A->[\$r1] = \$A->[\$r3];
\$r1 = \$r3;
} else {
\$A->[\$r1] = \$A->[\$r2];
\$r1 = \$r2;
down(\$b1, \$c1);
\$p1 = 0;
}
}
}
}
\$A->[\$r1] = \$T if \$r0 - \$r1;
sift();
}

sub semitrinkle {
\$r1 = \$r - \$c;
if (\$A->[\$r1] > \$A->[\$r]) {
@{\$A}[ \$r, \$r1 ] = @{\$A}[ \$r1, \$r ];
trinkle();
}
}

sub smoothsort {
\$A = shift;
\$r = 0;
\$_ = 1 for \$q, \$p, \$b, \$c;

while (\$q < @\$A) {
\$r1 = \$r;
if ((\$p & 7) == 3) {
(\$b1, \$c1) = (\$b, \$c);
sift();
\$p = (\$p + 1) >> 2;
up(\$b, \$c) for 1, 2;
} elsif ((\$p & 3) == 1) {
if (\$q + \$c < @\$A) {
(\$b1, \$c1) = (\$b, \$c);
sift();
} else {
trinkle();
}
down(\$b, \$c);
\$p <<= 1;
down(\$b, \$c), \$p <<= 1 while \$b > 1;
\$p++;
}
\$q++;
\$r++;
}
\$r1 = \$r;
trinkle();

while (\$q > 1) {
\$q--;
if (1 == \$b) {
\$r--;
\$p--;
\$p >>= 1, up(\$b, \$c) while !(\$p & 1);
} elsif (\$b >= 3) {
\$p--;
\$r -= \$b - \$c;
semitrinkle() if \$p > 0;
down(\$b, \$c);
\$p = (\$p << 1) + 1;
\$r += \$c;
semitrinkle();
down(\$b, \$c);
\$p = (\$p << 1) + 1;
}
}
}

__PACKAGE__

Testing code:

```#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use Test::More tests => 1;
use List::Util qw{ shuffle };
use SmoothSort;

my @arr = shuffle(1 .. 10000);
say "@arr";
SmoothSort::smoothsort(\@arr);
say "@arr";

is_deeply(\@arr, [ 1 .. 10000 ], 'sorted');

Update: I pasted the wrong link. I started with the linked page, but in the end, I used Algorithm Implementation on Wikibooks.

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

In reply to Re: Smoothsort by choroba

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 lurking in the Monastery: (7)
As of 2020-11-24 12:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?