comment on

"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
[download]

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
[download]

#!/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 );
[download]

In reply to Re: Re: Re: Re: random elements from array - new twist by petral
in thread random elements from array - new twist by felwick

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.


Don't ask to ask, just ask
	PerlMonks