in reply to Random Derangement Of An Array
Try this.
Update: Corrected the rand() calls. It now produces all the possible derangements.
I'm not sure about the statistical performance. Ie. Whether all derangements are equally probably?
#! perl -slw use strict; use Data::Dump qw[ pp ]; $Data::Dump::MAX_WIDTH = 1000; sub derange { my $n = shift; my @x = 0 .. $n; for my $p ( 0 .. $#x ) { my $q = int( rand @x ); $q = int( rand @x ) while $x[ $q ] == $p or $x[ $p ] == $q; @x[ $p, $q ] = @x[ $q, $p ]; } return @x; } our $N ||= 10; our $S ||= 1e4; my @arrange = 0 .. $N; my %stats; for( 1.. $S ) { my @derange = @arrange[ derange( $#arrange ) ]; $arrange[ $_ ] == $derange[ $_ ] and warn "Bad at $_\n" for 0 .. $ +#arrange; ++$stats{ "@derange" }; # print "@arrange\n@derange"; } print "Unique derangements generated: " . keys %stats; pp \%stats if keys( %stats ) < 50; my %stats2; ++$stats2{ $_ } for values %stats; print "Distribution by number of occurances:\n", pp \%stats2 if keys( %stats2 ) < 50; __END__ c:\test>695750 -S=1e3 -N=2 Unique derangements generated: 2 { "1 2 0" => 651, "2 0 1" => 349 } Distribution by number of occurances: { 349 => 1, 651 => 1 } c:\test>695750 -S=1e4 -N=3 Unique derangements generated: 9 { "1 0 3 2" => 1854, "1 2 3 0" => 1744, "1 3 0 2" => 979, "2 0 3 1" => 1028, "2 3 0 1" => 1109, "2 3 1 0" => 1000, "3 0 1 2" => 585, "3 2 0 1" => 1016, "3 2 1 0" => 685 } Distribution by number of occurances: { 585 => 1, 685 => 1, 979 => 1, 1000 => 1, 1016 => 1, 1028 => 1, 1109 => 1, 1744 => 1, 1854 => 1 } c:\test>695750 -S=1e4 -N=4 Unique derangements generated: 44 { "1 0 3 4 2" => 551, "1 0 4 2 3" => 372, "1 2 0 4 3" => 504, "1 2 3 4 0" => 382, "1 2 4 0 3" => 259, "1 3 0 4 2" => 234, "1 3 4 0 2" => 322, "1 3 4 2 0" => 265, "1 4 0 2 3" => 132, "1 4 3 0 2" => 217, "1 4 3 2 0" => 230, "2 0 1 4 3" => 358, "2 0 3 4 1" => 269, "2 0 4 1 3" => 161, "2 3 0 4 1" => 347, "2 3 1 4 0" => 219, "2 3 4 0 1" => 204, "2 3 4 1 0" => 220, "2 4 0 1 3" => 263, "2 4 1 0 3" => 173, "2 4 3 0 1" => 227, "2 4 3 1 0" => 235, "3 0 1 4 2" => 175, "3 0 4 1 2" => 254, "3 0 4 2 1" => 160, "3 2 0 4 1" => 221, "3 2 1 4 0" => 239, "3 2 4 0 1" => 243, "3 2 4 1 0" => 226, "3 4 0 1 2" => 152, "3 4 0 2 1" => 166, "3 4 1 0 2" => 172, "3 4 1 2 0" => 124, "4 0 1 2 3" => 84, "4 0 3 1 2" => 157, "4 0 3 2 1" => 177, "4 2 0 1 3" => 137, "4 2 1 0 3" => 182, "4 2 3 0 1" => 258, "4 2 3 1 0" => 171, "4 3 0 1 2" => 162, "4 3 0 2 1" => 142, "4 3 1 0 2" => 131, "4 3 1 2 0" => 123 } Distribution by number of occurances: { 84 => 1, 123 => 1, 124 => 1, 131 => 1, 132 => 1, 137 => 1, 142 => 1, 152 => 1, 157 => 1, 160 => 1, 161 => 1, 162 => 1, 166 => 1, 171 => 1, 172 => 1, 173 => 1, 175 => 1, 177 => 1, 182 => 1, 204 => 1, 217 => 1, 219 => 1, 220 => 1, 221 => 1, 226 => 1, 227 => 1, 230 => 1, 234 => 1, 235 => 1, 239 => 1, 243 => 1, 254 => 1, 258 => 1, 259 => 1, 263 => 1, 265 => 1, 269 => 1, 322 => 1, 347 => 1, 358 => 1, 372 => 1, 382 => 1, 504 => 1, 551 => 1 } c:\test>695750 -S=1e5 -N=5 Unique derangements generated: 265 c:\test>695750 -S=1e5 -N=6 Unique derangements generated: 1854 c:\test>695750 -S=1e5 -N=7 Unique derangements generated: 14544 c:\test>695750 -S=1e6 -N=7 Unique derangements generated: 14833 c:\test>695750 -S=5e6 -N=8 Unique derangements generated: 133496 }
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.
In Section
Seekers of Perl Wisdom