Re: Fisher-Yates Shuffle

I may have found another optimisation here, but, lest I broke the algorithm, I would love the input of monks wiser than I. Why decrement $i in the while, only to have to add 1 to it immediately afterwards? See IFIDDLE in the following update to the OP's benchmark

use strict;
use warnings;
use Benchmark qw(cmpthese);

my @array = (1..10_000); # An array to be shuffled. 
$_ = int rand (52) for @array;

# Rather then pass in a ref to the array, just shuffle the array in pl
+ace.
cmpthese( 10000, {
    'BRANCH'  => sub {
            my $i=@array; 
            while($i--){
                my $j=int rand(1+$i);
                next if $i==$j;  ### This is the line being tested.
                @array[$i, $j]=@array[$j, $i]
            }},
    'WITHOUT' => sub {
            my $i=@array; 
            while($i--){
                my $j=int rand(1+$i); 
                @array[$i, $j]=@array[$j, $i]
            }},
    'IFIDDLE' => sub {
            my $i=@array; 
            while($i){
                my $j=int rand($i--); 
                @array[$i, $j]=@array[$j, $i]
            }},
    'MY_J_OUT' => sub {
            my $i=@array; 
            my $j;
            while($i){
                $j=int rand($i--); 
                @array[$i, $j]=@array[$j, $i]
            }},
    'FOR_LOOP' => sub {
            my $j;
            $j = int rand ($_), 
            @array[$_, $j] = @array[$j, $_]
            for reverse 1 .. $#array;
    },
    'BUK' => sub {
            my( $r, $t );
            $r = $_ + rand( @array - $_ ),
            $t =           $array[ $_ ],
            $array[ $_ ] = $array[ $r ],
            $array[ $r ] = $t
            for 0 .. $#array;
    },
} );

# Benchmark: timing 10000 iterations of BRANCH, BUK, FOR_LOOP, IFIDDLE
+, MY_J_OUT, WITHOUT...
#    BRANCH: 64 wallclock secs (62.72 usr +  0.00 sys = 62.72 CPU) @ 1
+59.44/s (n=10000)
#       BUK: 62 wallclock secs (59.58 usr +  0.00 sys = 59.58 CPU) @ 1
+67.85/s (n=10000)
#  FOR_LOOP: 55 wallclock secs (53.22 usr +  0.00 sys = 53.22 CPU) @ 1
+87.91/s (n=10000)
#   IFIDDLE: 54 wallclock secs (52.61 usr +  0.00 sys = 52.61 CPU) @ 1
+90.08/s (n=10000)
#  MY_J_OUT: 50 wallclock secs (46.81 usr +  0.00 sys = 46.81 CPU) @ 2
+13.62/s (n=10000)
#   WITHOUT: 55 wallclock secs (53.11 usr +  0.00 sys = 53.11 CPU) @ 1
+88.29/s (n=10000)

#          Rate   BRANCH      BUK FOR_LOOP  WITHOUT  IFIDDLE MY_J_OUT
# BRANCH   158/s       --      -4%     -16%     -16%     -17%     -27%
# BUK      164/s       4%       --     -12%     -13%     -13%     -24%
# FOR_LOOP 187/s      19%      14%       --      -0%      -1%     -14%
# WITHOUT  188/s      19%      14%       0%       --      -1%     -14%
# IFIDDLE  190/s      20%      15%       1%       1%       --     -13%
# MY_J_OUT 218/s      38%      32%      16%      16%      15%       --
[download]

Update

added BrowserUK, my own optimisation taking the 'my' out the loop, and another version using a for loop.

Cheers,
R.

Pereant, qui ante nos nostra dixerunt!

Comment on Re: Fisher-Yates Shuffle Download Code

Replies are listed 'Best First'.
Re^2: Fisher-Yates Shuffle by BrowserUk (Patriarch) on Jun 02, 2014 at 19:08 UTC
You might also consider this version: `sub bukShuffle { my( $r, $t ); $r = $_ + rand( @array - $_ ), $t = $array[ $_ ], $array[ $_ ] = $array[ $r ], $array[ $r ] = $t for 0 .. $#array; }` [download] And I offer this method (drawing heavily upon a post by Abigail-II) for checking your modifications produce fair results: `my %h; bukShuffle( @array = qw[a b c d ] ), ++$h{ join ' ', @array } for 1 .. + 1e6; pp %h;` [download] Which for the code above produces: `[19:07:24.88] C:\test>junk50 ( "c a d b", 41868, "a d b c", 41833, "b d a c", 41554, "d a c b", 41772, "b c d a", 41671, "c d a b", 41779, "b d c a", 41783, "a b d c", 41724, "c b a d", 42012, "c a b d", 41571, "b c a d", 41270, "b a c d", 41192, "d c a b", 41443, "a b c d", 41669, "a c d b", 41884, "d b a c", 41786, "c b d a", 41608, "a d c b", 41598, "d c b a", 41544, "b a d c", 41578, "d b c a", 41684, "d a b c", 41672, "a c b d", 41622, "c d b a", 41883, )` [download] With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday' Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.	[reply] [d/l] [select]
Re^3: Fisher-Yates Shuffle by Random_Walk (Prior) on Jun 04, 2014 at 14:38 UTC
I added your version to my original benchmark. I saw you took the 'my' out the loop, so I also did the same to my version, which gave me a significant speed up (15% faster). Cheers, R. Pereant, qui ante nos nostra dixerunt!	[reply]
Re^2: Fisher-Yates Shuffle by roboticus (Chancellor) on Jun 02, 2014 at 11:21 UTC
Random Walk: Update: I bungled it. The results were suspiciously fast. When copying a block, I left in one of the --$i statements, so I was skipping every other element. Updated code & results: 'ROBO' => sub { my $i = @array; do { ++$cRO; my $j = int rand $i; @array[$i,$j] = @array[$j,$i]; } while ($i--); }, roboticus@sparky:~$ perl 1088227.pl Benchmark: timing 500 iterations of BRANCH, IFIDDLE, ROBO, WITHOUT... BRANCH: 17 wallclock secs (17.05 usr + 0.00 sys = 17.05 CPU) @ 29 +.33/s (n=500) IFIDDLE: 14 wallclock secs (14.29 usr + 0.00 sys = 14.29 CPU) @ 34 +.99/s (n=500) ROBO: 19 wallclock secs (18.59 usr + 0.00 sys = 18.59 CPU) @ 26 +.90/s (n=500) WITHOUT: 15 wallclock secs (15.69 usr + 0.00 sys = 15.69 CPU) @ 31 +.87/s (n=500) 5000000, 5250000, 5000000, 5125250 [download] My code is still executing the wrong number of loops (the last number on the last line), but not so far out of line. Also, WITHOUT (second) also has an unexpected number of loops. Original node below: You could also move the comparison to the end of the loop to avoid that +1: `'ROBO' => sub { my $i = @array; do { my $j = int rand $i--; @array[$i,$j] = @array[$j,$i]; } while (--$i); },` [download] Doing so gave me: `roboticus@sparky:~$ perl 1088227.pl Benchmark: timing 500 iterations of BRANCH, IFIDDLE, ROBO, WITHOUT... BRANCH: 17 wallclock secs (16.77 usr + 0.00 sys = 16.77 CPU) @ 29 +.82/s (n=500) IFIDDLE: 14 wallclock secs (14.02 usr + 0.00 sys = 14.02 CPU) @ 35 +.66/s (n=500) ROBO: 8 wallclock secs ( 7.85 usr + 0.00 sys = 7.85 CPU) @ 63 +.69/s (n=500) WITHOUT: 15 wallclock secs (15.33 usr + 0.00 sys = 15.33 CPU) @ 32 +.62/s (n=500) roboticus@sparky:~$` [download] It seems to help (unless I bungled it). ...roboticus When your only tool is a hammer, all problems look like your thumb.	[reply] [d/l] [select]
Re^3: Fisher-Yates Shuffle by RichardK (Parson) on Jun 02, 2014 at 13:33 UTC
That doesn't look right, now you're decrementing $i twice in each ROBO loop. Isn't that only doing half the work , hence taking half the time?	[reply]
Re^4: Fisher-Yates Shuffle by roboticus (Chancellor) on Jun 02, 2014 at 14:20 UTC
RichardK: You're right. My code is all screwed up at the moment. I'll try to fix it correctly when I get off work today. <sigh...> ...roboticus When your only tool is a hammer, all problems look like your thumb.	[reply]


Syntactic Confectionery Delight
	PerlMonks