Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Re: Re: Re: Re: random elements from array - new twist

by petral (Curate)
on Nov 08, 2002 at 19:48 UTC ( #211518=note: print w/replies, xml ) Need Help??


in reply to Re: Re: Re: random elements from array - new twist
in thread random elements from array - new twist

"MAKEUP!", er, I mean, "Did somebody say 'Benchmark'?":
use vars '@r'; sub supffl (\@) { local *r = pop; my $sz = @r; my $i = -1; while ($sz) { $a = ++$i + rand $sz--; @r[$i, $a] = @r[$a, $i]; } } =pod $ supshfl.pl Benchmark:running FAQ_FY, shuffl, supffl, each for at least 2 CPU sec FAQ_FY: 2 wc secs(2.19 usr + 0.00 sys = 2.19 CPU) @ 19.63/s (n=43) shuffl: 2 wc secs(2.13 usr + 0.00 sys = 2.13 CPU) @ 21.60/s (n=46) supffl: 2 wc secs(2.16 usr + 0.00 sys = 2.16 CPU) @ 23.15/s (n=50) Rate FAQ_FY shuffl supffl FAQ_FY 19.6/s -- -9% -15% shuffl 21.6/s 10% -- -7% supffl 23.1/s 18% 7% -- permutation | FAQ_FY | shuffl | supffl ------------------------------------------- ------------------------------------------- Std. Dev. | 6.404 | 6.397 | 5.746 =cut
Though 20% hardly seems worth it.

Basically, it's their efficiently checking for  $i == $j which slows down FAQ_FY!    mumble, mumble . . . premature optimization . . . mumble, mumble . . .
sub FAQ_FY { my $array = shift; my $i; for ($i = @$array; --$i; ) { my $j = int rand ($i+1); # next if $i == $j; @$array[$i,$j] = @$array[$j,$i]; } } =pod $ supshfl.pl Benchmark:running FAQ_FY, shuffl, supffl, each for at least 1 CPU sec FAQ_FY: 1 wc secs(1.05 usr + 0.00 sys = 1.05 CPU) @ 21.90/s (n=23) shuffl: 1 wc secs(1.07 usr + 0.00 sys = 1.07 CPU) @ 21.50/s (n=23) supffl: 1 wc secs(1.04 usr + 0.00 sys = 1.04 CPU) @ 23.08/s (n=24) Rate shuffl FAQ_FY supffl shuffl 21.5/s -- -2% -7% FAQ_FY 21.9/s 2% -- -5% supffl 23.1/s 7% 5% -- permutation | FAQ_FY | shuffl | supffl -------------------------------------------- -------------------------------------------- Std. Dev. | 7.305 | 6.105 | 5.998 =cut
#!/usr/bin/perl -ws use strict; use vars qw/$size $iter/; use Benchmark qw(cmpthese); use Data::Dumper; $size ||= 1000; $iter ||= 1000; sub FAQ_FY { my $array = shift; my $i; for ($i = @$array; --$i; ) { my $j = int rand ($i+1); next if $i == $j; @$array[$i,$j] = @$array[$j,$i]; } } sub shuffl (\@) { my $r=pop; $a = $_ + rand @{$r} - $_ and @$r[$_, $a] = @$r[$a, $_] for (0..$#{$r}); } use vars '@r'; sub supffl (\@) { local *r = pop; my $sz = @r; my $i = -1; while ($sz) { $a = ++$i + rand $sz--; @r[$i, $a] = @r[$a, $i]; } } my @array = 1 .. $size; cmpthese(-2, { FAQ_FY => sub { FAQ_FY \@array }, shuffl => sub { shuffl @array }, supffl => sub { supffl @array }, }); my (%buckets, %d, @temp);; my @set = qw(A B C D);# E F G); for (1 .. $iter ) { @temp=@set; FAQ_FY \@temp; $buckets{"@temp"}{FAQ_FY}++; @temp=@set; shuffl @temp; $buckets{"@temp"}{shuffl}++; @temp=@set; supffl @temp; $buckets{"@temp"}{supffl}++; } print "\npermutation | FAQ_FY | shuffl | supffl \n"; print "--------------------------------------------\n"; for my $key (sort keys %buckets) { # printf "%8.8s: | %4d | %4d | %4d \n", $key, # $buckets{$key}{FAQ_FY}, # $buckets{$key}{shuffl}, # $buckets{$key}{supffl}, $d{FAQ_FY}{Ex} += $buckets{$key}{FAQ_FY}||=0; $d{FAQ_FY}{Ex2} += $buckets{$key}{FAQ_FY}**2; $d{shuffl}{Ex} += $buckets{$key}{shuffl}||=0; $d{shuffl}{Ex2} += $buckets{$key}{shuffl}**2; $d{supffl}{Ex} += $buckets{$key}{supffl}||=0; $d{supffl}{Ex2} += $buckets{$key}{supffl}**2; } print "----------------------------------------\n"; printf "Std. Dev. | %0.3f | %0.3f | %0.3f \n", sqrt( ($d{FAQ_FY}{Ex2} - ($d{FAQ_FY}{Ex}**2/24))/23 ), sqrt( ($d{shuffl}{Ex2} - ($d{shuffl}{Ex}**2/24))/23 ), sqrt( ($d{supffl}{Ex2} - ($d{supffl}{Ex}**2/24))/23 ); # sqrt( ($d{FAQ_FY}{Ex2} - ($d{FAQ_FY}{Ex}**2/120))/119 ), # sqrt( ($d{shuffl}{Ex2} - ($d{shuffl}{Ex}**2/120))/119 ), # sqrt( ($d{supffl}{Ex2} - ($d{supffl}{Ex}**2/120))/119 ); # sqrt( ($d{FAQ_FY}{Ex2} - ($d{FAQ_FY}{Ex}**2/5040))/5039 ), # sqrt( ($d{shuffl}{Ex2} - ($d{shuffl}{Ex}**2/5040))/5039 ), # sqrt( ($d{supffl}{Ex2} - ($d{supffl}{Ex}**2/5040))/5039 );

  p

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://211518]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2020-05-25 09:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If programming languages were movie genres, Perl would be:















    Results (144 votes). Check out past polls.

    Notices?