http://qs321.pair.com?node_id=695765

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.