Update: Even with the update below, this code is broken. Wait for this message to disappear before accepting the code.

This is a simple modification to the classic Fisher-Yates shuffle algorithm that produces a derangement. I suppose I should contact the authors of the permutation-related modules on CPAN about this. This produces one random derangement; it is not an algorithm to return an ordered list of derangements.

My simple proof is that, since we set $j to a random number less than $i, the element at position $i will always be swapped out of its location, and can never be swapped back into it because $i decreases each time.

Update: I added to the algorithm because it was producing all possible derangements. For example, (1,2,3,4) has a derangement of (3,4,1,2), but the old algorithm couldn't produce this. The real problem is now it requires twice as much memory. :(

sub derangement {
  my $list = shift;
  my $i = @$list;
  my @swapped;

  while (--$i) {
    my $j = int rand ($i+1);
    redo if $i == $j and !$swapped[$i];
    @$list[$i,$j] = @$list[$j,$i];
    @swapped[$i,$j] = (1,1);
  }
}
[download]