Just another Perl shrine PerlMonks

### Re: Smoothsort

by choroba (Archbishop)
 on Sep 20, 2015 at 01:04 UTC ( #1142533=note: print w/replies, xml ) 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.

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

Replies are listed 'Best First'.
Re^2: Smoothsort
by QuillMeantTen (Friar) on Sep 20, 2015 at 10:30 UTC

Thank you for that implementation, I too am working from keithschwartz webpage's explanation. Would you be so kind though as to give more explicit variable and sub names though? I find your code quite cryptic in this regard.

Create A New User
Node Status?
node history
Node Type: note [id://1142533]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (8)
As of 2020-11-27 00:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?