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

in reply to Random Derangement Of An Array

```sub random_derangement
{
my @i = shuffle( 0 .. \$#_ );
my @r;
@r[ @i ] = @_[ @i[1..\$#i], \$i[0] ];
@r
}
If you want it to derange the list in place, it's even simpler:
```sub derange
{
my @i = shuffle( 0 .. \$#_ );
@_[ @i ] = @_[ @i[1..\$#i], \$i[0] ];
}

Update: I just realized that this is essentially the idea tye suggested in Re^2: Random Derangement Of An Array (rotate). The difference is that I rotate the entire list of (shuffled) indices. I don't believe breaking up the list into smaller chunks is necessary, and, depending on how that was done, could actually hurt the randomization a bit.

Update Again: Upon further reflection, I believe tye is right. In my algorithm above, some derangements are impossible. I had originally had the same idea — subdividing the set of indices — before I (incorrectly, I now believe) made the above oversimplification. The problem is that I don't know how to partition the set fairly. I did come up with an algorithm, but my intuition says it's not exactly fair either. Here it is; perhaps someone can say how fair it is:

```sub random_derangement
{
my @i = shuffle( 0 .. \$#_ );
my @j = @i;

my @part; # aoa; will contain the partitions
# distribute the elements of @j across the existing partitions ran
+domly.
# but if there are N partitions, there is a 1/(N+1) chance that th
+e element
# will be distributed to a new (N+1)th partition.
# if the number of existing partitions containing only a single el
+ement
# is equal to the number of remaining elements of @j, we can't cho
+ose
# just any partition; we have to distribute the remaining elements
+ of
# @j to each of those existing partitions having a single element.
# furthermore, we take a precaution against getting into a situati
+on
# where we'll have more "singleton" partitions than we have remain
+ing
# elements in @j
while (@j)
{
my @d = grep { @\$_ == 1 } @part;
@d = shuffle( @d );
if ( @d == @j )
{
push @{  \$d[0]  }, shift @j;
}
elsif ( @d+1 >= @j )
{
push @{ \$part[ rand( @part ) ] }, shift @j;
}
else
{
push @{ (\$part[ rand( 1 + @part ) ]||=[]) }, shift @j;
}
}
# now do the rotations, re-using @i and @j.
@i=();
foreach my \$part ( @part )
{
push @i, @\$part;
push @j, @{\$part}[ 1 .. \$#{\$part}, 0 ];
}

my @r;
@r[ @i ] = @_[ @j ];
@r
}