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
}
A word spoken in Mind will reach its own level, in the objective world, by its own wei
ght