 Just another Perl shrine PerlMonks

### Re: Fastest way to sort a list of integers into 0,1,2,3,-3,-2,-1

by Discipulus (Abbot)
 on Feb 05, 2019 at 16:27 UTC ( #1229419=note: print w/replies, xml ) Need Help??

Hello haukex,

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;
Compare(\@list,\@output) or die "@list" if DO_CHECK;
},

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%          --

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.

Replies are listed 'Best First'.
Re^2: Fastest way to sort a list of integers into 0,1,2,3,-3,-2,-1
by hdb (Monsignor) on Feb 05, 2019 at 17:03 UTC

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;
},
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 and \$list[-1] > 0){
push @list, shift @list until \$list >= 0;
}
Compare(\@list,\@output) or die "@list" if DO_CHECK;
},

update: more test cases.. more checks!

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

I did, that's why I said it fails if there is a zero in the data. I am still thinking whether it can be saved in some way without extra checks for zero.

Re^2: Fastest way to sort a list of integers into 0,1,2,3,-3,-2,-1
by Eily (Monsignor) on Feb 06, 2019 at 09:54 UTC

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

```my @list = @input;
@list = EXPR @list;
You wrote:
```my @list = EXPR @input;
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;
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;
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%
+            --

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2021-10-19 19:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My first memorable Perl project was:

Results (77 votes). Check out past polls.

Notices?