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.