Permutations/Derangements

A derangement is a permutation of the order of distinct items in which no item appears in its original place.

For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0), and (2, 0, 1).

The number of derangements of n distinct items is known as the subfactorial of n, sometimes written as !n. There are various ways to calculate !n.

Task

The task is to:

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.

D

Works with: D version 2

<lang d>import std.stdio, std.algorithm, std.typecons, std.array, std.conv, std.range;

auto derangements(size_t n, bool countonly = 0) {

   auto seq = array(iota(n));
   auto ori = seq.dup;
   auto tot = fact(n);

   size_t[][] all;
   size_t cnt = n == 0;

   while (--tot > 0) {
       size_t j = n - 2;
       while (seq[j] > seq[j + 1]) {
           j--;
       }
       size_t k = n - 1;
       while (seq[j] > seq[k]) {
           k--;
       }   
       swap(seq[k], seq[j]);
   
       size_t r = n - 1;
       size_t s = j + 1;
       while (r > s) {
           swap(seq[s], seq[r]);
           r--;
           s++;
       }

       j = 0;
       while (j < n && seq[j] != ori[j]) {
           j++;
       }
       if (j == n) {
           if (countonly) cnt++;
           else all ~= seq.dup;
       }
   }
   return tuple(all, cnt);

}

pure T fact(T)(T n) {

   T result = 1;
   for (T i = 2; i <= n; i++) {
       result *= i;
   }
   return result;

}

pure T subfact(T)(T n) {

   if (0 <= n && n <= 2) {
       return n != 1;
   }
   return (n - 1) * (subfact(n - 1) + subfact(n - 2));

}

void main() {

   writeln("derangements for n = 4\n");
   foreach (d; derangements(4)[0]) {
       writeln(d);
   }

   writeln("\ntable of n vs counted vs calculated derangements\n");
   foreach (i; 0 .. 10) {
       writefln("%s  %-7s%-7s", i, derangements(i, 1)[1], subfact(i));
   }

   writefln("\n!20 = %s", subfact(20L));

}</lang>

Output:

derangements for n = 4

[1, 0, 3, 2]
[1, 2, 3, 0]
[1, 3, 0, 2]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]

table of n vs counted vs calculated derangements

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

!20 = 895014631192902121

Note that derangement 10 was painfully slow (almost 3 seconds, about 10 times slower than derangement 9 and 100 times slower than derangement 8) -- this is a brute force approach. But brute force is an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).

PicoLisp

<lang PicoLisp>(load "@lib/simul.l") # For 'permute'

(de derangements (Lst)

  (filter
     '((L) (not (find = L Lst)))
     (permute Lst) ) )

(de subfact (N)

  (if (>= 2 N)
     (if (= 1 N) 0 1)
     (*
        (dec N)
        (+ (subfact (dec N)) (subfact (- N 2))) ) ) )</lang>

Output:

: (derangements (range 1 4))
-> ((2 1 4 3) (2 3 4 1) (2 4 1 3) (3 1 4 2) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 3 1 2) (4 3 2 1))

: (for I (range 0 9)
   (tab (2 8 8)
      I
      (length (derangements (range 1 I)))
      (subfact I) ) )
 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
-> NIL

: (subfact 20)
-> 895014631192902121

Python

Includes stretch goal. <lang python>from itertools import permutations import math

def derangements(n):

   'All deranged permutations of the integers 0..n-1 inclusive'
   return ( perm for perm in permutations(range(n))
            if all(indx != p for indx, p in enumerate(perm)) )

def subfact(n):

   if n == 2 or n == 0:
       return 1
   elif n == 1:
       return 0
   elif  1 <= n <=18:
       return round(math.factorial(n) / math.e)
   elif n.imag == 0 and n.real == int(n.real) and n > 0:
       return (n-1) * ( subfact(n - 1) + subfact(n - 2) )
   else:
       raise ValueError()

def _iterlen(iter):

   'length of an iterator without taking much memory'
   l = 0
   for x in iter:
       l += 1
   return l

if __name__ == '__main__':

   n = 4
   print("Derangements of %s" % (tuple(range(n)),))
   for d in derangements(n):
       print("  %s" % (d,))

   print("\nTable of n vs counted vs calculated derangements")
   for n in range(10):
       print("%2i %-5i %-5i" %
             (n, _iterlen(derangements(n)), subfact(n)))

   n = 20
   print("\n!%i = %i" % (n, subfact(n)))</lang>

Sample output

Derangements of (0, 1, 2, 3)
  (1, 0, 3, 2)
  (1, 2, 3, 0)
  (1, 3, 0, 2)
  (2, 0, 3, 1)
  (2, 3, 0, 1)
  (2, 3, 1, 0)
  (3, 0, 1, 2)
  (3, 2, 0, 1)
  (3, 2, 1, 0)

Table of n vs counted vs calculated derangements
 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

!20 = 895014631192902121

Tcl

Library: Tcllib (Package: struct::list)

<lang tcl>package require Tcl 8.5; # for arbitrary-precision integers package require struct::list; # for permutation enumerator

proc derangements lst {

   # Special case
   if {![llength $lst]} {return {{}}}
   set result {}
   for {set perm [struct::list firstperm $lst]} {[llength $perm]} \

{set perm [struct::list nextperm $perm]} { set skip 0 foreach a $lst b $perm { if {[set skip [string equal $a $b]]} break } if {!$skip} {lappend result $perm}

   }
   return $result

}

proc deranged1to n {

   for {set i 1;set r {}} {$i <= $n} {incr i} {lappend r $i}
   return [derangements $r]

}

proc countDeranged1to n {

   llength [deranged1to $n]

}

proc subfact n {

   if {$n == 0} {return 1}
   if {$n == 1} {return 0}
   set o 1
   set s 0
   for {set i 1} {$i < $n} {incr i} {

set s [expr {$i * ($o + [set o $s])}]

   }
   return $s

}</lang> Demonstrating with the display parts of the task: <lang tcl>foreach d [deranged1to 4] {

   puts "derangement of 1..4: $d"

}

puts "\n\tcounted\tcalculated" for {set i 0} {$i <= 9} {incr i} {

   puts "!$i\t[countDeranged1to $i]\t[subfact $i]"

}

Stretch goal

puts "\n!20 = [subfact 20]"</lang> Output:

derangement of 1..4: 2 1 4 3
derangement of 1..4: 2 3 4 1
derangement of 1..4: 2 4 1 3
derangement of 1..4: 3 1 4 2
derangement of 1..4: 3 4 1 2
derangement of 1..4: 3 4 2 1
derangement of 1..4: 4 1 2 3
derangement of 1..4: 4 3 1 2
derangement of 1..4: 4 3 2 1

	counted	calculated
!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

!20 = 895014631192902121

D

J

PicoLisp

Python

Tcl