derangements

[thealienz1]

Figures out the derangements for an arbitary length of n. A derangement is a word of numbers where the number does not appear in its numbered column. i.e. you cannot have 1234, 3214 but 4321 and 3421 is acceptable. The combinations sub is barrowed from here.

$length = 5; #Set to the size of derangment
my @results = &combinations(1..$length);

$comb = 0;
foreach (@results) {
    $found = 0;
    foreach my $num (1..$length){
        if(@$_[$num-1] == $num) {$found = 1;} #If true then not a dera
+ngement
    }
    if($found == 0) {print "@$_\n";$comb++;}
}
print "Number of derangements: $comb\n";

sub combinations {
  my @array = @_;
  if ($#array == 0) {return [ $array[0] ]; }
  my @results;
  my $element;
  foreach $element (0..$#array) {
    my @leftovers = @array;
    my $chosen_one = splice(@leftovers, $element, 1);
    foreach (&combinations(@leftovers)) {
      push(@results, [ $chosen_one, @{$_} ]);
    }
  }
  return @results;
}