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.