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 }