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