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 } ```