Data update

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

@@ -0,0 +1,14 @@
+import Data.Ratio ((%), numerator)
+
+infixl 7 *.
+(*.) :: Num a => a -> [a] -> [a]
+x *. (p:ps) = x*p : x*.ps
+
+instance Num a => Num [a] where
+    negate = map negate
+    (+) = zipWith (+)
+    (*) (p:ps) (q:qs) = p*q : ((p*.qs) + ps*(q:qs))
+    fromInteger n = fromInteger n:repeat 0
+
+expseq :: [Rational] -> [Rational]
+expseq ps = zipWith (\p q -> p*fromInteger q) ps (scanl (*) 1 [1..])

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

@@ -0,0 +1,8 @@
+derangements :: [Integer]
+derangements = map numerator
+    (expseq (invexp/(1:(-1):repeat 0)))
+
+invexp :: [Rational]
+invexp = zipWith (%) (cycle [1,-1]) factorials
+  where
+    factorials = scanl (*) 1 [1..]

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

@@ -0,0 +1,4 @@
+ghci> take 10 derangements
+[1,0,1,2,9,44,265,1854,14833,133496]
+ghci> derangements !! 20
+895014631192902121

Task/Permutations-Derangements/PascalABC.NET/permutations-derangements.pas

@@ -0,0 +1,23 @@
+function derangements<T>(a: array of T) :=
+    a.Permutations.where(p -> p.where((x, i) -> x = a[i]).Count = 0);
+
+function subFactorial(n: integer): int64;
+begin
+  if n <= 1 then result := 1 - n
+  else result := (n - 1) * (subfactorial(n - 1) + subfactorial(n - 2));
+end;
+
+begin
+  println('Derangements of 1 2 3 4:');
+  foreach var d in derangements(|1, 2, 3, 4|) do
+    d.println;
+
+  println(#10, 'Number of derangements:');
+  println('n   counted   calculated');
+  println('-   -------   ----------');
+  for var n := 1 to 10 do
+    writeln(n:2, derangements(range(1, n).ToArray).count:9, subfactorial(n):10);
+
+  println;
+    println('!20 = ', subfactorial(20));
+end.