Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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!

In reply to Re: move all 0s in an array to the beginning keeping other elements order same - Benchmarks by Random_Walk
in thread move all 0s in an array to the beginning keeping other elements order same by anilmwr

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2024-03-28 17:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found