Hi all, after choroba and davido had to point out the epic fail in my last benchmark attempt, I hope I have done better with this one:
#!/usr/bin/perl
#
use strict;
use warnings;
use 5.010;
use Benchmark qw(cmpthese);
our @orig_array;
for (1 .. 1000) {push @orig_array, int rand 4}
say join ", ", @orig_array;
my $count = 10_000;
cmpthese($count, {
anilmwr => \&anilmwr,
roboticus_1 => \&roboticus_1,
roboticus_2 => \&roboticus_2,
kennethk_1 => \&kennethk_1,
kennethk_2 => \&kennethk_2,
kennethk_3 => \&kennethk_3,
Anonymous_Monk => \&Anonymous_Monk,
SuicideJunkie => \&SuicideJunkie,
kcott => \&kcott,
GrandFather => \&GrandFather,
Cristoforo => \&Cristoforo,
dbuckhal => \&dbuckhal,
});
sub anilmwr { # Fixed but keeping the concept of the original
my @array = @main::orig_array;
my @array1 = ();
my @array2 = ();
foreach my $i (@array) {
push @array1, $i if $i == 0;
push @array2, $i if $i != 0;
}
my @new_array = (@array1, @array2);
}
sub roboticus_1 {
my @array = @main::orig_array;
my @new_array=();
for my $i (@array) {
if ($i) {
push @new_array, $i;
}
else {
unshift @new_array, $i;
}
}
}
sub roboticus_2 {
my @array = @main::orig_array;
my @new_array = (
grep( { ! $_ } @array),
grep( { $_ } @array)
);
}
sub kennethk_1 {
my @array = @main::orig_array;
@array = sort {-($a == 0) || $b == 0} @array;
}
sub kennethk_2 {
my @array = @main::orig_array;
@array = sort {($b == 0)-($a == 0)} @array;
}
sub kennethk_3 {
my @array = @main::orig_array;
@array = sort {!$b - !$a} @array;
}
# I do not have List::MoreUtils on this work machine, and can't instal
+l it now.
# A shame 'cos I had high hopes for this one. May try it at home later
+ if the tuit
# is to be found
# use List::MoreUtils 'part';
# sub davido {
# my @array = @main::orig_array;
# @array = map { @$_ } part { !!$_ } @array;
# }
sub Anonymous_Monk {
my @array = @main::orig_array;
@array = do { my @tmp = grep $_, @array; ((0)x(@array-@tmp),@tmp)
+};
}
sub SuicideJunkie {
my @array = @main::orig_array;
my $size = @array;
@array = grep {$_} @array;
unshift @array, (0) x ($size - @array);
}
sub kcott {
my @array = @main::orig_array;
my $zeros = 0;
@array = map { $_ == 0 ? ++$zeros && () : $_ } @array;
unshift @array, (0) x $zeros;
}
sub GrandFather {
my @array = @main::orig_array;
my @newArray = grep{!$_} @array;
push @newArray, grep {$_} @array;
}
sub Cristoforo {
my @array = @main::orig_array;
for my $i (0 .. $#array) {
unshift @array, splice @array, $i, 1 if $array[$i] == 0;
}
}
sub dbuckhal {
my @array = @main::orig_array;
my @y;
for ( @array ) {
( $_ ) ? push @y, $_ : unshift @y, $_;
}
}
Results
Rate kennethk_2 kennethk_3 kennethk_1 anilmwr Anonymo
+us_Monk kcott Cristoforo roboticus_1 SuicideJunkie dbuckhal Random_Wa
+lk roboticus_2 GrandFather
kennethk_2 1115/s -- -7% -11% -39%
+ -40% -47% -58% -60% -60% -61% -6
+2% -62% -63%
kennethk_3 1205/s 8% -- -4% -34%
+ -35% -43% -55% -56% -57% -58% -5
+9% -59% -60%
kennethk_1 1252/s 12% 4% -- -31%
+ -32% -40% -53% -55% -55% -57% -5
+8% -58% -58%
anilmwr 1821/s 63% 51% 46% --
+ -1% -13% -31% -34% -35% -37% -3
+8% -38% -39%
Anonymous_Monk 1845/s 65% 53% 47% 1%
+ -- -12% -30% -33% -34% -36% -3
+8% -38% -38%
kcott 2101/s 88% 74% 68% 15%
+ 14% -- -21% -24% -25% -27% -2
+9% -29% -30%
Cristoforo 2653/s 138% 120% 112% 46%
+ 44% 26% -- -4% -6% -8% -1
+0% -10% -11%
roboticus_1 2755/s 147% 129% 120% 51%
+ 49% 31% 4% -- -2% -4% -
+7% -7% -8%
SuicideJunkie 2809/s 152% 133% 124% 54%
+ 52% 34% 6% 2% -- -3% -
+5% -5% -6%
dbuckhal 2882/s 159% 139% 130% 58%
+ 56% 37% 9% 5% 3% -- -
+3% -3% -4%
roboticus_2 2959/s 165% 146% 136% 62%
+ 60% 41% 12% 7% 5% 3%
+0% -- -1%
GrandFather 2994/s 169% 149% 139% 64%
+ 62% 43% 13% 9% 7% 4%
+1% 1% --
Cheers,
R.
Pereant, qui ante nos nostra dixerunt!