in reply to move all 0s in an array to the beginning keeping other elements order same

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!
  • Comment on Re: move all 0s in an array to the beginning keeping other elements order same - Benchmarks
  • Select or Download Code

Replies are listed 'Best First'.
Re^2: move all 0s in an array to the beginning keeping other elements order same - Benchmarks
by davido (Cardinal) on May 02, 2014 at 15:38 UTC

    This benchmark seems reasonable. I made a couple small changes: set the count to a negative interval, which makes it run each for "n" seconds, and increased the array size.

    I do have List::MoreUtils, so I added mine to the benchmark test. My solution fell square in the middle of the pack. Here are the results I get:

    ...and the code...

    I still like the semantic purity of the List::MoreUtils 'part'; solution, but beauty is probably in the eye of the beholder. ;)


    Dave