2016 Update

Task/Permutations-Derangements/00DESCRIPTION

@@ -5,17 +5,20 @@ For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0
 The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''.
 There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''.
 
-;Task
-The task is to:
+
+;Task:
 # Create a named function/method/subroutine/... to generate derangements of the integers ''0..n-1'', (or ''1..n'' if you prefer).
 # Generate ''and show'' all the derangements of 4 integers using the above routine.
 # Create a function that calculates the subfactorial of ''n'', !''n''.
 # Print and show a table of the ''counted'' number of derangements of ''n'' vs. the calculated !''n'' for n from 0..9 inclusive.
 
-As an optional stretch goal:
-:* Calculate !''20''.
 
-;Cf.
-* [[Anagrams/Deranged anagrams]]
-* [[Best shuffle]]
-* [[Left_factorials]]
+;Optional stretch goal:
+* &nbsp; Calculate &nbsp; <big><big> !''20'' </big></big>
+
+
+;Related tasks:
+* &nbsp; [[Anagrams/Deranged anagrams]]
+* &nbsp; [[Best shuffle]]
+* &nbsp; [[Left_factorials]]
+<br><br>

Task/Permutations-Derangements/Haskell/permutations-derangements-1.hs

@@ -5,9 +5,8 @@ import Data.List
 derangements xs = filter (and . zipWith (/=) xs) $ permutations xs
 
 -- Compute the number of derangements of n elements
-subfactorial 0 = 0
+subfactorial 0 = 1
 subfactorial 1 = 0
-subfactorial 2 = 1
 subfactorial n = (n-1) * (subfactorial (n-1) + subfactorial (n-2))
 
 main = do

Task/Permutations-Derangements/Lua/permutations-derangements.lua

@@ -0,0 +1,69 @@
+-- Return an iterator to produce every permutation of list
+function permute (list)
+    local function perm (list, n)
+        if n == 0 then coroutine.yield(list) end
+        for i = 1, n do
+            list[i], list[n] = list[n], list[i]
+            perm(list, n - 1)
+            list[i], list[n] = list[n], list[i]
+        end
+    end
+    return coroutine.wrap(function() perm(list, #list) end)
+end
+
+-- Return a copy of table t (wouldn't work for a table of tables)
+function copy (t)
+    if not t then return nil end
+    local new = {}
+    for k, v in pairs(t) do new[k] = v end
+    return new
+end
+
+-- Return true if no value in t1 can be found at the same index of t2
+function noMatches (t1, t2)
+    for k, v in pairs(t1) do
+        if t2[k] == v then return false end
+    end
+    return true
+end
+
+-- Return a table of all derangements of table t
+function derangements (t)
+    local orig = copy(t)
+    local nextPerm, deranged = permute(t), {}
+    local numList, keep = copy(nextPerm())
+    while numList do
+        if noMatches(numList, orig) then table.insert(deranged, numList) end
+        numList = copy(nextPerm())
+    end
+    return deranged
+end
+
+-- Return the subfactorial of n
+function subFact (n)
+    if n < 2 then
+        return 1 - n
+    else
+        return (subFact(n - 1) + subFact(n - 2)) * (n - 1)
+    end
+end
+
+-- Return a table of the numbers 1 to n
+function listOneTo (n)
+    local t = {}
+    for i = 1, n do t[i] = i end
+    return t
+end
+
+-- Main procedure
+print("Derangements of [1,2,3,4]")
+for k, v in pairs(derangements(listOneTo(4))) do print("", unpack(v)) end
+print("\n\nSubfactorial vs counted derangements\n")
+print("\tn\t| subFact(n)\t| Derangements")
+print("    " .. string.rep("-", 42))
+for i = 0, 9 do
+    io.write("\t" .. i .. "\t|  " .. subFact(i))
+    if string.len(subFact(i)) < 5 then io.write("\t") end
+    print("\t|  " .. #derangements(listOneTo(i)))
+end
+print("\n\nThe subfactorial of 20 is " .. subFact(20))

Task/Permutations-Derangements/Perl-6/permutations-derangements.pl6

@@ -1,32 +1,24 @@
-sub derange (@result, @avail) {
-    if not @avail { @result.item }
-    else {
-	map {
-	    derange([ @result, @avail[$_] ],
-	      @avail[0 .. $_-1, $_+1 ..^ @avail ])
-	}, grep { @avail[$_] != @result }, 0 .. @avail-1;
-    }
+sub is-derangement(List $l) {
+    return not grep { $l[$_] == $_ }, 0..($l.elems - 1);
 }
 
-constant factorial = 1, [\*] 1...*;
-
-# choose k among n, i.e. n! / k! (n-k)!
-sub choose ($n, $k) { factorial[$n] div factorial[$k] div factorial[$n - $k] }
-
-sub sub-factorial ($n) {
-    (state @)[$n] //=
-	factorial[$n] - [+] gather for 1 .. $n -> $k {
-	    take choose($n, $k) * sub-factorial($n - $k);
-	}
+# task 1
+sub derangements(Range $x) {
+    $x.permutations.grep( *.&is-derangement )
 }
 
-say "Derangements for 4 elements:";
-for derange([], 0 .. 3).kv -> $i, @d {
-    say $i+1, ': ', @d;
+# task 2
+.say for (0..4).&derangements;
+
+# task 3
+sub prefix:<!>(Int $x) {
+    return +derangements(^$x);
 }
 
-say "\nCompare list length and calculated table";
-say "$_\t{+derange([], ^$_)}\t{sub-factorial($_)}" for 0 .. 9;
-
-say "\nNumber of derangements:";
-say "$_:\t{sub-factorial($_)}" for 1 .. 20;
+# task 4
+for ^9 -> $n {
+    say "number: " ~ $n;
+    say "count: " ~ !$n;
+    say "derangements: ";
+    .say for (0..$n-1).&derangements;
+}

Task/Permutations-Derangements/SuperCollider/permutations-derangements-1.supercollider

@@ -0,0 +1,16 @@
+(
+d = { |array, n|
+	Routine {
+		n = n ?? { array.size.factorial };
+		n.do { |i|
+			var permuted = array.permute(i);
+			if(array.every { |each, i| permuted[i] != each }) {
+				permuted.yield
+			};
+		}
+	};
+};
+f = { |n| d.((0..n-1)) };
+x = f.(4);
+x.all.do(_.postln); "";
+)

Task/Permutations-Derangements/SuperCollider/permutations-derangements-2.supercollider

@@ -0,0 +1,9 @@
+[ 3, 2, 1, 0 ]
+[ 2, 3, 0, 1 ]
+[ 1, 0, 3, 2 ]
+[ 1, 2, 3, 0 ]
+[ 2, 0, 3, 1 ]
+[ 3, 2, 0, 1 ]
+[ 1, 3, 0, 2 ]
+[ 2, 3, 1, 0 ]
+[ 3, 0, 1, 2 ]

Task/Permutations-Derangements/SuperCollider/permutations-derangements-3.supercollider

@@ -0,0 +1,15 @@
+(
+z = { |n|
+	case
+	{ n <= 0 } { 1 }
+	{ n == 1 } { 0 }
+	{ (n - 1) * (z.(n - 1) + z.(n - 2)) }
+};
+p = { |i| i.asPaddedString(10, " ") };
+"n    derangements    subfactorial".postln;
+(0..9).do { |i|
+	var derangements = f.(i).all;
+	var subfactorial = z.(i);
+	"%    %    %\n".postf(i, p.(derangements.size), p.(subfactorial));
+};
+)

Task/Permutations-Derangements/SuperCollider/permutations-derangements-4.supercollider

@@ -0,0 +1,11 @@
+n    derangements    subfactorial
+0             1             1
+1             0             0
+2             1             1
+3             2             2
+4             9             9
+5            44            44
+6           265           265
+7          1854          1854
+8         14833         14833
+9        133496        133496