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

}