sub random_derangement
{
my @i = shuffle( 0 .. $#_ );
my @r;
@r[ @i ] = @_[ @i[1..$#i], $i[0] ];
@r
}
####
sub derange
{
my @i = shuffle( 0 .. $#_ );
@_[ @i ] = @_[ @i[1..$#i], $i[0] ];
}
##
##
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 randomly.
# but if there are N partitions, there is a 1/(N+1) chance that the element
# will be distributed to a new (N+1)th partition.
# if the number of existing partitions containing only a single element
# is equal to the number of remaining elements of @j, we can't choose
# 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 situation
# where we'll have more "singleton" partitions than we have remaining
# 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
}