Using the fact that a negative value read as an unsigned is bigger than any signed positive:

  eily => sub {
    my @list = -50..50;
    @list = sort { ~$b <=> ~$a } @list;
    Compare(\@list,[0..50,-50..-1]) or die "@list" if DO_CHECK;
  }
[download]

             Rate grepfirst sortfirst      eily
grepfirst 59577/s        --      -14%      -32%
sortfirst 69292/s       16%        --      -21%
eily      87583/s       47%       26%        --
[download]

Just noting down a small caveat that using unary you may loose a bit of numeric range in Perl (including this method). On a 64 machine the valid range for this method would be from -(2^63): -9223372036854775808 to (2^63-1) 9223372036854775807 (thus signed 64 bit integer). Positive Perl integers can be bigger but the result of the unary overlaps the negative range for positive numbers in the upper range (> 2^63-1).

To illustrate this with some numbers:

 ~ -9223372036854775808 = 9223372036854775807
 ~  9223372036854775808 = 9223372036854775807
[download]

I have not checked all of the other (now 13) proposed solutions, but just spotted this one. I think there are proposed solutions that do not suffer from this (such as Discipulus's method).

As vr pointed out this only performs well on already sorted lists but falls behind pretty fast otherwise. This actually means that you can make it run faster on unsorted list by sorting twice (still doesn't beat most of the leading propositions though):

use warnings;
use strict;
use Benchmark 'cmpthese';
use constant DO_CHECK => 0;
use if DO_CHECK, 'Data::Compare', qw/Compare/;

my @input = (-57..50,52,0);
my @output = (0,0..50,52,-57..-1);
use List::Util 'shuffle';
srand 123;
@input = shuffle @input;

cmpthese(DO_CHECK ? 1 : -2, {
  Eily => sub {
    my @list = @input;
    @list = sort { ~$b <=> ~$a } @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  Eily2 => sub {
    my @list = @input;
    @list = sort { ~$b <=> ~$a } sort { $a <=> $b } @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
});

__END__
         Rate  Eily Eily2
Eily  20139/s    --  -58%
Eily2 47615/s  136%    --
[download]

Going twice as fast by doing the job twice, talk about counter intuitive :D.

I have not seen others but here are two attempts. Anyway i bet on tybalt89's regex ;)

Discipulus => sub{
    my @list = @input;
    my @neg = sort {$a<=>$b} grep { $_ < 0 } @list;
    my @pos = sort {$a<=>$b} grep { $_ >= 0} @list;
    @list = (@pos,@neg);
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
},
Discipulus2 => sub{
    my @list = sort {$a<=>$b} @input;
    push @list, shift @list until $list[0] >= 0;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
},
[download]

UPDATE what I first imagined was a sort block.. now after the right dose of spaghetti..

Discipulus3 => sub{
    my @list = sort {    
                     (( $a >= 0 and $b >= 0) 
                        or 
                     ($a < 0 and $b < 0  ))     ? 
                     $a<=>$b                    : 
                     $b<=>$a 
    } @input;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
},

#OUTPUT
               Rate  Discipulus Discipulus3 Discipulus2
Discipulus  46252/s          --        -14%        -46%
Discipulus3 53805/s         16%          --        -38%
Discipulus2 86380/s         87%         61%          --
[download]

L*

I think your second version will be very slow if there are only negative numbers... ;) My version below is reasonably fast if there is no zero in the input, otherwise it fails:

hdb => sub {
    my @list = @input;
    @list = sort{$a*$b>0?$a<=>$b:$b<=>$a} @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;        
    },
[download]

Hello hdb

> version will be very slow if there are only negative numbers... ;)

eh eh, you are right but the check does not slow it at all..

Discipulus => sub{
        my @list = sort {$a<=>$b} @input;
        if ($list[0] < 0 and $list[-1] > 0){
            push @list, shift @list until $list[0] >= 0;
        }
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

update: more test cases.. more checks!

Discipulus4 => q{ # https://www.perlmonks.org/?node_id=1229437
        @list = sort {$a<=>$b} @list;
        if ($list[0] < 0 and $list[-1] >= 0)
            { push @list, shift @list until $list[0] >= 0 }        },
[download]

L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

You might not have run this with DO_CHECK *on*, as your lists sort like 1 2 3 4 5 0 -5 -4 -3 -2 -1: Your 0 ends up in the middle instead of at the start.


Enjoy, Have FUN! H.Merijn

You missed one step in the last two. Instead of:

my @list = @input;
@list = EXPR @list;
[download]

You wrote:

my @list = EXPR @input;
[download]

I don't know exactly how well perl optimizes, but there's a chance you're skipping one copy of the values, and one overwrite of the content of @list. On my computer your Discipulus2 rewritten to have the same format as the other tests is slightly slower than using first_index (like haukex did in the comments of his code, rather than the code itself?) with push and splice. Now the "NoOverwrite" below is just your Discipulus2 where the absence of overwrite of @list is made explicit, and I have not been able to beat that one. Edit: nope, that code was wrong. Fixed, and first_index wins:

use warnings;
use strict;
use Benchmark 'cmpthese';
use constant DO_CHECK => 0;
use if DO_CHECK, 'Data::Compare', qw/Compare/;
use List::MoreUtils qw( first_index );

my @input = (-57..50,52,0);
my @output = (0,0..50,52,-57..-1);
use List::Util 'shuffle';
srand 123;
@input = shuffle @input;

cmpthese(DO_CHECK ? 1 : -2, {
  Eily => sub { # https://www.perlmonks.org/?node_id=1229411
    my @list = @input;
    @list = sort { ~$b <=> ~$a } @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  vr => sub { # https://www.perlmonks.org/?node_id=1229415
    my @list = @input;
    @list = unpack 'i*', pack 'I*', sort { $a <=> $b }
      unpack 'I*', pack 'i*', @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  Discipulus => sub{ # https://www.perlmonks.org/?node_id=1229419
    my @list = @input;
    my @neg = sort {$a<=>$b} grep { $_ < 0 } @list;
    my @pos = sort {$a<=>$b} grep { $_ >= 0} @list;
    @list = (@pos,@neg);
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  Discipulus2 => sub{ # https://www.perlmonks.org/?node_id=1229419
    my @list = @input;
    @list = sort {$a<=>$b} @list;
    push @list, shift @list until $list[0] >= 0;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  NoOverwrite => sub{ # Actually Discipulus2
    my @list = @input;
    my @sorted = sort {$a<=>$b} @list; # Don't overwrite
    push @sorted, shift @sorted until $sorted[0] >= 0;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
  Splice_FirstIdx => sub{ # Haukexish
    my @list = @input;
    @list = sort { $a <=> $b } @list;
    my $nb_neg = first_index { $_ >= 0 } @list;
    push @list, splice @list, 0, $nb_neg;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
});

__END__
                   Rate Eily Discipulus   vr NoOverwrite Discipulus2 S
+plice_FirstIdx
Eily            19851/s   --       -55% -65%        -68%        -72%  
+          -75%
Discipulus      43848/s 121%         -- -23%        -28%        -37%  
+          -44%
vr              56978/s 187%        30%   --         -7%        -18%  
+          -28%
NoOverwrite     61148/s 208%        39%   7%          --        -12%  
+          -22%
Discipulus2     69804/s 252%        59%  23%         14%          --  
+          -11%
Splice_FirstIdx 78838/s 297%        80%  38%         29%         13%  
+            --
[download]

#!/usr/bin/perl
use warnings;
use strict;

use Test::More;
use Test::Deep;

my @in  = -2 .. 2;
my @exp = (0, 1, 2, -2, -1);

my @sorted = sort {
    ((-1, 0, 1)[$a <=> 0] <=> (-1, 0, 1)[$b <=> 0]) || ($a <=> $b)
} @in;

cmp_deeply([@sorted], [@exp]);

done_testing();
[download]

Update: It seems comparable to grepfirst, thus slower than sortfirst.

Update 2: This seems to be a bit faster than grepfirst, but still not as fast as sortfirst:

            ((($a <=> 0) & 3) <=> (($b <=> 0) & 3)) || ($a <=> $b)
[download]

Alas, mine is the slowest so far...

use warnings;
use strict;
use Benchmark 'cmpthese';
use constant DO_CHECK => 0;
use if DO_CHECK, 'Data::Compare', qw/Compare/;

my @GLOBAL_LIST = -5 .. 5;

cmpthese(-2, {
    sortfirst => sub {
        my @list = @GLOBAL_LIST;
        @list = sort {$a<=>$b} @list;
        @list = ( (grep {$_>=0} @list), (grep {$_<0} @list) );
        DO_CHECK and ( Compare(\@list,[0..5,-5..-1]) or die "@list");
    },
    grepfirst => sub {
        my @list = @GLOBAL_LIST;
        my @pos = grep {$_>=0} @list;
        my @neg = grep {$_<0} @list;
        @list = ( (sort {$a<=>$b} @pos), (sort {$a<=>$b} @neg) );
        DO_CHECK and ( Compare(\@list,[0..5,-5..-1]) or die "@list");
    },
    pryrt => sub {
        my @list = @GLOBAL_LIST;
        sub sgn { $_[0]<0?-1:1 }
        @list = (sort {(sgn($b) <=> sgn($a)) || ($a <=> $b)} @list);
        DO_CHECK and ( Compare(\@list,[0..5,-5..-1]) or die "@list");
    },
    choroba => sub {
        my @in = @GLOBAL_LIST;
        my @sorted = sort {
            ((-1, 0, 1)[$a <=> 0] <=> (-1, 0, 1)[$b <=> 0]) || ($a <=>
+ $b)
        } @in;
        DO_CHECK and ( Compare(\@sorted,[0..5,-5..-1]) or die "@sorted
+");
    }
});
__END__
              Rate     pryrt   choroba grepfirst sortfirst
pryrt      89602/s        --      -26%      -67%      -74%
choroba   120426/s       34%        --      -56%      -65%
grepfirst 271358/s      203%      125%        --      -20%
sortfirst 340119/s      280%      182%       25%        --
[download]

Mine is also way slower than I expected, here just to be complete :)

cmpthese (-2, {
    sortfirst => sub {
        my @list = -5..5;
        @list =   sort { $a <=> $b } @list;
        @list = ((grep { $_ >=   0 } @list), (grep { $_ < 0 } @list));
        DO_CHECK and (Compare (\@list, [0..5, -5..-1]) or die "@list")
+;
        },
    grepfirst => sub {
        my @list = -5..5;
        my @pos = grep { $_ >= 0 } @list;
        my @neg = grep { $_ <  0 } @list;
        @list = ((sort { $a <=> $b } @pos), (sort { $a <=> $b } @neg))
+;
        DO_CHECK and (Compare (\@list, [0..5, -5..-1]) or die "@list")
+;
        },
    packunpck => sub {
        my @list = map { unpack "l>", $_ } sort map { pack "l>", $_ } 
+-5..5;
        DO_CHECK and (Compare (\@list, [0..5, -5..-1]) or die "@list")
+;
        },
    pryrt => sub {
        my @list = -5..5;
        sub sgn { $_[0] < 0 ? -1 : 1 }
        @list = sort { (sgn ($b) <=> sgn ($a)) || ($a <=> $b) } @list;
        DO_CHECK and (Compare (\@list, [0..5, -5..-1]) or die "@list")
+;
        },
    choroba => sub {
        my @list = -5..5;
        @list = sort {
            ((-1, 0, 1)[$a <=> 0] <=> (-1, 0, 1)[$b <=> 0]) || ($a <=>
+ $b)
            } @list;
        DO_CHECK and (Compare (\@list, [0..5, -5..-1]) or die "@list")
+;
        },
    });
[download]

              Rate     pryrt packunpck   choroba grepfirst sortfirst
pryrt     123672/s        --      -35%      -39%      -66%      -73%
packunpck 190037/s       54%        --       -7%      -48%      -59%
choroba   204244/s       65%        7%        --      -44%      -56%
grepfirst 367991/s      198%       94%       80%        --      -20%
sortfirst 460545/s      272%      142%      125%       25%        --
[download]

use warnings;
use strict;
use Benchmark 'cmpthese';
use constant DO_CHECK => 0;
use if DO_CHECK, 'Data::Compare', qw/Compare/;

my @input = (-50..50);
my @output = (0..50,-50..-1);

use List::Util 'shuffle';
srand 123;
@input = shuffle @input;        # NB. NB. NB. NB.

cmpthese(-2, {
    packz => sub {
        my @list = @input;
        @list = 
            unpack 'i*', pack 'I*',
            sort { $a <=> $b }
            unpack 'I*', pack 'i*', @list;        
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
    Eily => sub { # https://www.perlmonks.org/?node_id=1229411
        my @list = @input;
        @list = sort { ~$b <=> ~$a } @list;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
});

__END__

         Rate  Eily packz
Eily   6495/s    --  -66%
packz 18967/s  192%    --
[download]

Slow machine here. Shuffled input is important, otherwise Eily's code seems to be faster.

Shuffled input is important

Yes, good catch! The GRT makes each comparison faster, but it seems like the number of comparisons is far lower for already sorted or nearly sorted input. It looks like the pack method is better no matter what because with this (and a list from -50 to 250):

vr_map => sub { # https://www.perlmonks.org/?node_id=1229415
                my @list = @input;
                @list = unpack 'i*', pack 'I*', sort { $a <=> $b }
                        map { ~$_ } @list; # Doesn't even give the cor
+rect answer, there's an offset of 1
                Compare(\@list,\@output) or die "@list" if DO_CHECK;
              },
[download]

your implementation is still noticeably faster (my version falls behind pretty fast on a non-sorted list):

             Rate      Eily    vr_map grepfirst sortfirst        vr
Eily       5208/s        --      -53%      -64%      -67%      -71%
vr_map    11021/s      112%        --      -25%      -31%      -38%
grepfirst 14623/s      181%       33%        --       -8%      -17%
sortfirst 15977/s      207%       45%        9%        --      -10%
vr        17701/s      240%       61%       21%       11%        --
[download]

Shuffled input is important, otherwise Eily's code seems to be faster.

Excellent point, having more representative sample input is important, as tybalt89 showed :-)

I've updated the root node, yours is the best so far, congratulations!

If using CPAN is allowed, see Sort::Packed, this is faster:

# ...
use Sort::Packed 'sort_packed';
# ...
    sort_packed => sub {
        sort_packed I => my $s = pack 'i*', @input;
        my @list = unpack 'i*', $s;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
# ...
[download]

Edit: As I see now, I omitted copying @input list to unnecessary intermediate @list, as all contestants, it seems, are bound to do. To be fair, either everybody drop that line, or it's inserted into code above. Still, Sort::Packed is faster and scales better. Sorry, didn't measure other monks' answers from last night on. Surprise is counter-intuitive good speed of Discipulus' simple just-push-in-loop solution. + All tricks with sign bit interpretation sacrifice integer range (Veltro++).

Isn't

                @list = unpack 'j*', pack 'J*',
                        sort { $a <=> $b }
                        unpack 'J*', pack 'j*',
                        @list;
[download]

just a complicated/expensive way of doing

                @list = unpack 'j>*',
                        sort
                        pack 'j>*',
                        @list;
[download]

No, ikegami, what you wrote won't work, but perhaps, instead, you meant Tux' version. It's slower -- (un)packing per element rather than "en masse" into (from) single scalar.

A GRT on packed negativity indicator and value seems to work.

use 5.026;
use warnings;

say for
   map { 
      unpack q{xl>}, $_;
      }
   sort
   map {
      my $neg = $_ < 0 ? 1 : 0;
      pack q{Cl>}, $neg, $_;
      }
   -4 .. 4;
[download]

The output.

0
1
2
3
4
-4
-3
-2
-1
[download]

I hope this is useful.

Update: I just noticed that Tux posted exactly the same method while I was posting this.

Update 2: Ah! Not quite the same, negativity indicator not required apparently.

    array => sub {
        my @list = @input;
        @list[@input] = @input;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

When added, outputs:

             Rate johngg  Tux pryrt choroba0 choroba choroba2 grepfirs
+t sortfirst Eily array
johngg     6047/s     -- -26%  -36%     -57%    -67%     -69%      -70
+%      -73% -83%  -93%
Tux        8142/s    35%   --  -14%     -42%    -55%     -58%      -60
+%      -64% -77%  -90%
pryrt      9471/s    57%  16%    --     -32%    -48%     -51%      -54
+%      -58% -73%  -89%
choroba0  13922/s   130%  71%   47%       --    -23%     -28%      -32
+%      -38% -61%  -83%
choroba   18181/s   201% 123%   92%      31%      --      -6%      -11
+%      -19% -49%  -78%
choroba2  19424/s   221% 139%  105%      40%      7%       --       -5
+%      -13% -45%  -77%
grepfirst 20451/s   238% 151%  116%      47%     12%       5%        -
+-       -8% -42%  -75%
sortfirst 22333/s   269% 174%  136%      60%     23%      15%        9
+%        -- -37%  -73%
Eily      35540/s   488% 337%  275%     155%     95%      83%       74
+%       59%   --  -57%
array     83332/s  1278% 923%  780%     499%    358%     329%      307
+%      273% 134%    --
[download]

It passes your test case, so for (some) perl golfs, it is considered correct :)

cool but fail :)

I've got this one which runs faster than Discipulus' original version, but I can't get any of them to run faster than vr's on my computer:

  GrepPos => sub{
    my @list = @input;
    my $pos =  grep { $_ >= 0 } @list;
    @list[$pos..$#list, 0..$pos-1] = sort {$a<=>$b} @list;
    Compare(\@list,\@output) or die "@list" if DO_CHECK;
  },
[download]

               Rate        Eily  Discipulus Discipulus3          vr
Eily        21060/s          --        -55%        -61%        -65%
Discipulus  47134/s        124%          --        -13%        -22%
GrepPos     54377/s        158%         15%          --        -10%
vr          60414/s        187%         28%         11%          --
[download]

    try1a => sub {
        my $high = my @list = sort { $a <=> $b } @input;
        my $mid = my $low = 0;
        $list[$mid = $low + $high >> 1] < 0 ?
          ($low = $mid + 1) : ($high = $mid) while $low < $high;
        push @list, splice @list, 0, $low;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

Grumble... I hate speed contests :(

Although that "push" line is quite interesting. perl++

Although that "push" line is quite interesting. perl++

The "push" line isn't the punchline. The punchline is how you calculate $low for the splice, which amounts to 7 iterations of the while loop for the sample data. Then, the array reordering is done with one fell swoop. Takes some time to grok that. tybalt89++

perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

I found this a very worthwhile learning experience. Thanks all for the answers and remarks (and haukex for starting it).

I've gathered all versions (as some others also did) and formatted them all alike, all using the *same* *shuffled* input of -50..50

I disabled hdb's solution, as it does not meet the requirements (it sorts the 0 in the middle)

I tested all solutions also against an input list that:

• does not have a 0
• only negatives (Corion's solution fails on this one)
• only positives
• many duplicates

Linux 4.20.6-1-default [openSUSE Tumbleweed 20190202]  HP ZBook 15G3 C
+ore(TM) i7-6820HQ CPU @ 2.70GHz/3480(8 cores) x86_64  15958 Mb

              Rate pryrt choroba0 choroba choroba2 johngg Corion packu
+npck eily grepfirst sortfirst haukex3 GrepPos   vr swl2 tybalt89 Disc
+ipulus
pryrt       2427/s    --     -30%    -41%     -53%   -61%   -62%      
+-68% -71%      -81%      -84%    -87%    -89% -90% -90%     -92%     
+  -93%
choroba0    3486/s   44%       --    -16%     -32%   -44%   -46%      
+-53% -59%      -73%      -77%    -82%    -84% -86% -86%     -88%     
+  -89%
choroba     4129/s   70%      18%      --     -20%   -34%   -36%      
+-45% -51%      -68%      -73%    -78%    -82% -83% -84%     -86%     
+  -87%
choroba2    5132/s  111%      47%     24%       --   -18%   -20%      
+-31% -39%      -60%      -66%    -73%    -77% -79% -80%     -82%     
+  -84%
johngg      6280/s  159%      80%     52%      22%     --    -3%      
+-16% -25%      -51%      -59%    -67%    -72% -74% -75%     -78%     
+  -81%
Corion      6455/s  166%      85%     56%      26%     3%     --      
+-14% -23%      -49%      -58%    -66%    -71% -73% -74%     -78%     
+  -80%
packunpck   7469/s  208%     114%     81%      46%    19%    16%      
+  -- -11%      -41%      -51%    -61%    -67% -69% -70%     -74%     
+  -77%
eily        8413/s  247%     141%    104%      64%    34%    30%      
+ 13%   --      -34%      -45%    -56%    -62% -65% -67%     -71%     
+  -75%
grepfirst  12739/s  425%     265%    209%     148%   103%    97%      
+ 71%  51%        --      -16%    -33%    -43% -47% -49%     -56%     
+  -61%
sortfirst  15244/s  528%     337%    269%     197%   143%   136%      
+104%  81%       20%        --    -20%    -32% -37% -39%     -47%     
+  -54%
haukex3    19002/s  683%     445%    360%     270%   203%   194%      
+154% 126%       49%       25%      --    -15% -21% -24%     -34%     
+  -42%
GrepPos    22333/s  820%     541%    441%     335%   256%   246%      
+199% 165%       75%       46%     18%      --  -8% -11%     -23%     
+  -32%
vr         24206/s  897%     594%    486%     372%   285%   275%      
+224% 188%       90%       59%     27%      8%   --  -4%     -16%     
+  -27%
swl2       25121/s  935%     621%    508%     390%   300%   289%      
+236% 199%       97%       65%     32%     12%   4%   --     -13%     
+  -24%
tybalt89   28845/s 1088%     727%    599%     462%   359%   347%      
+286% 243%      126%       89%     52%     29%  19%  15%       --     
+  -13%
Discipulus 33027/s 1261%     847%    700%     544%   426%   412%      
+342% 293%      159%      117%     74%     48%  36%  31%      14%     
+    --
[download]

Linux 4.4.165-81-default [openSUSE Leap 42.3]  HP Z420/1589 Xeon(R) CP
+U E5-1650 0 @ 3.20GHz/3533(12 cores) x86_64  15972 Mb

              Rate pryrt choroba0 choroba Corion choroba2 johngg packu
+npck eily grepfirst sortfirst haukex3 GrepPos   vr swl2 tybalt89 Disc
+ipulus
pryrt       6019/s    --     -40%    -40%   -54%     -56%   -62%      
+-72% -77%      -84%      -87%    -88%    -90% -90% -92%     -92%     
+  -93%
choroba0    9954/s   65%       --     -1%   -23%     -28%   -37%      
+-53% -61%      -74%      -79%    -81%    -83% -84% -86%     -87%     
+  -89%
choroba    10046/s   67%       1%      --   -23%     -27%   -36%      
+-53% -61%      -73%      -79%    -81%    -83% -83% -86%     -87%     
+  -88%
Corion     12970/s  115%      30%     29%     --      -6%   -18%      
+-39% -50%      -66%      -73%    -75%    -78% -79% -82%     -84%     
+  -85%
choroba2   13770/s  129%      38%     37%     6%       --   -13%      
+-35% -46%      -64%      -71%    -73%    -77% -77% -81%     -83%     
+  -84%
johngg     15761/s  162%      58%     57%    22%      14%     --      
+-26% -39%      -58%      -67%    -70%    -73% -74% -78%     -80%     
+  -82%
packunpck  21299/s  254%     114%    112%    64%      55%    35%      
+  -- -17%      -44%      -55%    -59%    -64% -65% -71%     -73%     
+  -75%
eily       25713/s  327%     158%    156%    98%      87%    63%      
+ 21%   --      -32%      -46%    -50%    -56% -57% -65%     -68%     
+  -70%
grepfirst  37834/s  529%     280%    277%   192%     175%   140%      
+ 78%  47%        --      -20%    -27%    -36% -37% -48%     -52%     
+  -56%
sortfirst  47348/s  687%     376%    371%   265%     244%   200%      
+122%  84%       25%        --     -8%    -20% -22% -35%     -40%     
+  -45%
haukex3    51687/s  759%     419%    414%   299%     275%   228%      
+143% 101%       37%        9%      --    -13% -14% -29%     -35%     
+  -40%
GrepPos    59076/s  882%     494%    488%   355%     329%   275%      
+177% 130%       56%       25%     14%      --  -2% -19%     -25%     
+  -32%
vr         60424/s  904%     507%    501%   366%     339%   283%      
+184% 135%       60%       28%     17%      2%   -- -17%     -24%     
+  -30%
swl2       73079/s 1114%     634%    627%   463%     431%   364%      
+243% 184%       93%       54%     41%     24%  21%   --      -8%     
+  -16%
tybalt89   79276/s 1217%     696%    689%   511%     476%   403%      
+272% 208%      110%       67%     53%     34%  31%   8%       --     
+   -9%
Discipulus 86809/s 1342%     772%    764%   569%     530%   451%      
+308% 238%      129%       83%     68%     47%  44%  19%      10%     
+    --
[download]

edit - this is essentially the same as Tybalt's entry in 1229444, which I missed when posting.

Here's one that is adapted from Discipulus and haukex3. Using a binary search will speed up the search for the inflection point, while pushing and splicing in one pass avoids repeated pushes. It should scale better as the data increases in size.

The binary search needs a recent version of List::MoreUtils. I've specified the latest here, but one could go somewhat older I think. One could also use List::BinarySearch::XS

    swl => sub {
        my @list = @input;
        use List::MoreUtils 0.428;
        @list = sort {$a<=>$b} @list;
        my $i = List::MoreUtils::bsearchidx {$_ <=> 0} @list;
        push @list, splice @list, 0, $i-1;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    }
[download]

Would this work if

1) There is no 0 in the list ?

2) There are several 0, Would it pick the correct (earliest) one ?

Thanks for checking.

It fails if there were three or more zeroes (the test case provided has two zeroes), and if there are no zeroes.

Adding some extra checks seems to fix the issues, and is still close to try1a for speed given the provided test data (sometimes as fast but usually a few percent slower).

    swl2 => sub {
        my @list = @input;
        use List::MoreUtils 0.428;
        @list = sort {$a<=>$b} @list;
        my $i = List::MoreUtils::bsearchidx {$_ <=> 0} @list;
        if ($i < 0) {  #  no zero
            $i = List::MoreUtils::firstidx {$_ >= 0} @list;
        }
        else {
            $i-- while !$list[$i];
            $i++;
        }
        push @list, splice @list, 0, $i;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

It will be slower in cases where there are no zeroes, although List::BinarySearch::binsearch_pos could be used to find an insert point for zero in such cases.

And if non-core modules aren't permitted, then this adaptation of haukex3 can be used:

    swl2 => sub { 
        my @list = @input;
        @list = sort {$a<=>$b} @list;
        my $i = 0;
        $i++ while ($list[$i]<0);
        push @list, splice @list, 0, $i;
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

Updated for lists that are all negative, following Discipulus4 in 1229492.

    swl_pp2 => sub {
        my @list = @input;
        @list = sort {$a<=>$b} @list;
        if ($list[0] < 0 && $list[-1] >= 0) {
            my $i = 0; $i++ while ($list[$i]<0);
            push @list, splice @list, 0, $i;
        }
        Compare(\@list,\@output) or die "@list" if DO_CHECK;
    },
[download]

Hi everyone,

Thank you for all the great submissions, this is really fascinating!

Just to comment on a few things that I saw asked:

• Solutions with CPAN modules are welcome, although my personal order of preference is (1) pure Perl, (2) core modules only, (3) CPAN modules.
• Yes, I did edit all the code to do my @list = @input; @list = sort {...} @list; instead of my @list = sort {...} @input;, this is just to be fair, because it's just test set-up and I think there is a significant performance difference.

I've reorganized the test code somewhat, so that tests and benchmarking happens in one run of the script (I'll keep a version history in this gist). I hope I've reproduced everyone's ideas faithfully, if I didn't please let me know! I also added some more varied test input (thanks to Tux for the idea), and unfortunately, it's causing some failures on some of the routines. I've excluded those from the benchmarks for now, feel free to send me your fixes :-) (please send me a /msg if you edit a node, as I might not catch it otherwise).

At the moment, the top contenders are by Discipulus, swl, tybalt89, and Eily, with vr's solutions coming close depending on the data set - very nice!!

Update 1: Updated with swl's updates, and fixed haukex3. swl's code takes the lead! Any contenders, or other updates/fixes? :-)

Update 2: After a quick fix, Discipulus's Discipulus4 is back in the race!

In most cases the top solutions are equivalent, but Discipulus' fourth solution is a clear winner in a case of all negatives because it's the only one to short circuit after a simple sort in that case. swl is right though, a single zero (or positive value) in an otherwise all-negative list would completely cancel that shortcut.

Anyway, fantastic thread haukex, thanks for creating it (and thanks to everyone for adding to it :D). It's a surprisingly simple and powerful example of why efficient sorting is hard, how you can't tell a good some code is just by looking at it (and shortest does not mean fastest), with some examples of easily you can reach the wrong conclusion if you are not careful with Benchmarking.

The tests should probably also have "negative only with zero" variant.

    td => sub {
        my $q     = POE::Queue::Array->new;
        for (@input) {
            $_ == 0 && $q->enqueue(-1000,$_)&& next;
            $q->enqueue(-1/$_,$_);
        }
        my @out;
        while (my @l = $q->dequeue_next()) {
            push @out,$l[2];
        }
        Compare(\@out,\@output) or die "@out" if DO_CHECK;
    }
[download]

#!/usr/bin/perl -w

use strict;
use warnings;

print "Quick Sort algorithm ported from QBASIC to Perl.\n\n";

my @SAMPLE = (
  384, 12, 44, 847, 66, -324, 217, 550, -3, 18302, 136, 255,
  441, 4.5, -5, 77, 101, -2, 12, 74, 3, 933, 50, -7, 61, 52,
  902, 74, -23, 8, 32, 31, 32, 81, 22, -9, 65, 258, 71, -33,
  433, 985, 164, -19, 0, 1, 0.2, 783, 92, 10, 343, 195, -1);

PrintList("Unsorted list", @SAMPLE);
my $START_TIME = time;

QSort(@SAMPLE);    # Sort list

my $END_TIME = time;

PrintList("Sorted List", @SAMPLE);
print "This operation took ", ($END_TIME - $START_TIME), " second(s)\n
+";
exit;


sub PrintList
{
  print shift, ":\n";
  print '-' x 78 . "\n";
  my $N;
  for (my $i = 1; @_; $i++)
  {
    $N = shift;
    print $N . "\t";
    if (($i % 9) == 0) { print "\n"; }
  }
  print "\n", '-' x 78, "\n";
}

#
# QuickSort algorithm ported from QBASIC to Perl.
#
# Usage: QSort(ARRAY_OF_NUMBERS)
#
sub QSort
{
  @_ or return;

  my $First = 0;
  my $Last = @_ - 1;
  my @QStack;
  my $StackPtr = 0;
  my $temp;
  my $i;
  my $j;

  for (;;)
  {
    do
    {
      $temp = $_[int(($Last + $First) / 2)];
      $i = $First;
      $j = $Last;

      do
      {
        while ($_[$i] < $temp) { $i++; }
        while ($_[$j] > $temp) { $j--; }
        if ($i < $j) { @_[$i, $j] = @_[$j, $i]; }
        if ($i <= $j) { $i++; $j--; }
      }
      while ($i <= $j);

      if ($i < $Last)
      {
        $QStack[$StackPtr++] = $i;
        $QStack[$StackPtr++] = $Last;
      }
      $Last = $j;
    }
    while ($First < $Last);

    $StackPtr or return;
    $Last = $QStack[--$StackPtr];
    $First = $QStack[--$StackPtr];
  }
}
[download]

This thread, especially the top post, already contains the Benchmark and the usual scaffolding so you can easily test the speed (and correctness) of your implementation. Maybe consider using that.

Also, I highly doubt that an implementation of Quicksort will beat the built-in sort keyword at least for the short lists that we are talking about here. Even though Perl sort uses a Mergesort, it will be hard for Perl code to beat the C code simply due to the amount of time spent in the Perl runloop.

I am not sure how to precisely measure its speed in Perl.

As Corion said, you can use Benchmark as I showed in the root node, and I also think that the built-in sort will always be faster. In fact, roughly 19 times faster:

           Rate custom  qsort   sort
custom  10697/s     --   -83%   -95%
qsort   62127/s   481%     --   -70%
sort   209474/s  1858%   237%     --
[download]

Where qsort is from List::MoreUtils.

Read more... code (5 kB)

    td => sub {
        my @out;
        my $q     = POE::Queue::Array->new;
        my @list = ( -52, -50 .. 50, 52, 0 );
        push @out,($_,$_[2]) for $q->dequeue_next;
        Compare(\@out,\@output) or die "@out" if DO_CHECK;
    }
[download]

not quite.. I'm trying to use a priority queue and queue with the right sorting priority, but it's coming up wrong so far