Data commit

Task/Permutations-Derangements/Perl/permutations-derangements-1.pl

@@ -0,0 +1,66 @@
+sub d {
+        # compare this with the deranged() sub to see how to turn procedural
+        # code into functional one ('functional' as not in 'understandable')
+        $#_ ? map d([ @{$_[0]}, $_[$_] ], @_[1 .. $_-1, $_+1 .. $#_ ]),
+                        grep { $_[$_] != @{$_[0]} } 1 .. $#_
+            : $_[0]
+}
+
+sub deranged {  # same as sub d above, just a readable version to explain method
+        my ($result, @avail) = @_;
+        return $result if !@avail;              # no more elements to pick from, done
+
+        my @list;                               # list of permutations to return
+        for my $i (0 .. $#avail) {              # try to add each element to result in turn
+                next if $avail[$i] == @$result; # element n at n-th position, no-no
+                my $e = splice @avail, $i, 1;   # move the n-th element from available to result
+                push @list, deranged([ @$result, $e ], @avail);
+                                                # and recurse down, keep what's returned
+                splice @avail, $i, 0, $e;       # put that element back, try next
+        }
+        return @list;
+}
+
+sub choose {    # choose k among n, i.e. n! / k! (n-k)!
+        my ($n, $k) = @_;
+        factorial($n) / factorial($k) / factorial($n - $k)
+}
+
+my @fact = (1);
+sub factorial {
+        # //= : standard caching technique.  If cached value available,
+        #       return it; else compute, cache and return.
+        #       For this specific task not really necessary.
+        $fact[ $_[0] ] //= $_[0] * factorial($_[0] - 1)
+}
+
+my @subfact;
+sub sub_factorial {
+        my $n = shift;
+        $subfact[$n] //= do     # same caching stuff, try comment out this line
+        {
+                # computes deranged without formula, using recursion
+                my $total = factorial($n);      # total permutations
+                for my $k (1 .. $n) {
+                        # minus the permutations where k items are fixed
+                        # to original location, and the rest deranged
+                        $total -= choose($n, $k) * sub_factorial($n - $k)
+                }
+                $total
+        }
+}
+
+print "Derangements for 4 elements:\n";
+my @deranged = d([], 0 .. 3);
+for (1 .. @deranged) {
+        print "$_: @{$deranged[$_-1]}\n"
+}
+
+print "\nCompare list length and calculated table\n";
+for (0 .. 9) {
+        my @x = d([], 0 .. $_-1);
+        print $_, "\t", scalar(@x), "\t", sub_factorial($_), "\n"
+}
+
+print "\nNumber of derangements:\n";
+print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;

Task/Permutations-Derangements/Perl/permutations-derangements-2.pl

@@ -0,0 +1,25 @@
+use ntheory ":all";
+
+# Count derangements using derangement iterator
+sub countderange {
+  my($n,$s) = (shift,0);
+  forderange { $s++ } $n;
+  $s;
+}
+# Count derangements using inclusion-exclusion
+sub subfactorial1 {
+  my $n = shift;
+  vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n);
+}
+# Count derangements using simple recursion without special functions
+sub subfactorial2 {
+  my $n = shift;
+  use bigint;  no warnings 'recursion';
+  ($n < 1)  ?  1  :  $n * subfactorial2($n-1) + (-1)**$n;
+}
+
+print "Derangements of 4 items:\n";
+forderange { print "@_\n" } 4;
+printf "\n%3s %15s %15s\n","N","List count","!N";
+printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9;
+printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;