CloudFlare suffered a massive security issue affecting all of its customers, including Rosetta Code. All passwords not changed since February 19th 2017 have been expired, and session cookie longevity will be reduced until late March.--Michael Mol (talk) 05:15, 25 February 2017 (UTC)

Permutations/Derangements

From Rosetta Code
Task
Permutations/Derangements
You are encouraged to solve this task according to the task description, using any language you may know.

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
  1. Create a named function/method/subroutine/... to generate derangements of the integers 0..n-1, (or 1..n if you prefer).
  2. Generate and show all the derangements of 4 integers using the above routine.
  3. Create a function that calculates the subfactorial of n, !n.
  4. Print and show a table of the counted number of derangements of n vs. the calculated !n for n from 0..9 inclusive.


Optional stretch goal
  •   Calculate    !20


Related tasks



Ada[edit]

Translation of: C
with Ada.Text_IO; use Ada.Text_IO;
procedure DePermute is
type U64 is mod 2**64;
type Num is range 0 .. 20;
type NumList is array (Natural range <>) of Num;
type PtNumList is access all NumList;
package IO is new Ada.Text_IO.Integer_IO (Num);
package UIO is new Ada.Text_IO.Modular_IO (U64);
 
function deranged (depth : Natural; list : PtNumList;
show : Boolean) return U64 is
tmp : Num; count : U64 := 0;
begin
if depth = list'Length then
if show then
for i in list'Range loop IO.Put (list (i), 2); end loop;
New_Line;
end if; return 1;
end if;
for i in reverse depth .. list'Last loop
if Num (i + 1) /= list (depth) then
tmp := list (i); list (i) := list (depth); list (depth) := tmp;
count := count + deranged (depth + 1, list, show);
tmp := list (i); list (i) := list (depth); list (depth) := tmp;
end if;
end loop;
return count;
end deranged;
 
function gen_n (len : Natural; show : Boolean) return U64 is
list : PtNumList;
begin
list := new NumList (0 .. len - 1);
for i in list'Range loop list (i) := Num (i + 1); end loop;
return deranged (0, list, show);
end gen_n;
 
function sub_fact (n : Natural) return U64 is begin
if n < 2 then return U64 (1 - n);
else return (sub_fact (n - 1) + sub_fact (n - 2)) * U64 (n - 1);
end if;
end sub_fact;
 
count : U64;
begin
Put_Line ("Deranged 4:");
count := gen_n (4, True);
Put_Line ("List vs. calc:");
for i in Natural range 0 .. 9 loop
IO.Put (Num (i), 1); UIO.Put (gen_n (i, False), 7);
UIO.Put (sub_fact (i), 7); New_Line;
end loop;
Put_Line ("!20 = " & U64'Image (sub_fact (20)));
end DePermute;
Output:
Deranged 4:
 4 1 2 3
 4 3 1 2
 4 3 2 1
 3 4 2 1
 3 4 1 2
 3 1 4 2
 2 4 1 3
 2 3 4 1
 2 1 4 3
List vs. calc:
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

AutoHotkey[edit]

Works with: AutoHotkey_L

Note that the permutations are generated in lexicographic order, from http://www.autohotkey.com/forum/topic77959.html

#NoEnv
SetBatchLines -1
Process, Priority,, high
 
output := "Derangements for 1, 2, 3, 4:`n"
 
obj := [1, 2, 3, 4], objS := obj.Clone()
Loop ; permute 4
{
obj := perm_NextObj(Obj)
If !obj
break
For k, v in obj
if ( objS[k] = v )
continue 2
output .= ObjDisp(obj) "`n"
}
output .= "`nTable of n, counted, calculated derangements:`n"
 
Loop 10 ; Count !n
{
obj := []
count := 0
output .= A_Tab . (i := A_Index-1) . A_Tab
Loop % i
obj[A_Index] := A_Index
objS := obj.Clone()
Loop
{
obj := perm_NextObj(Obj)
If !obj
break
For k, v in obj
if ( objS[k] = v )
continue 2
count++
}
output .= count . A_Tab . cd(i) . "`n"
}
output .= "`nApproximation of !20: " . cd(20)
MsgBox % Clipboard := output
 
perm_NextObj(obj){ ; next lexicographic permutation
p := 0, objM := ObjMaxIndex(obj)
Loop % objM
{
If A_Index=1
continue
t := obj[objM+1-A_Index]
n := obj[objM+2-A_Index]
If ( t < n )
{
p := objM+1-A_Index, pC := obj[p]
break
}
}
If !p
return false
Loop
{
t := obj[objM+1-A_Index]
If ( t > pC )
{
n := objM+1-A_Index, nC := obj[n]
break
}
}
 
obj[n] := pC, obj[p] := nC
return ObjReverse(obj, objM-p)
}
 
ObjReverse(Obj, tail){
o := ObjClone(Obj), ObjM := ObjMaxIndex(O)
Loop % tail
o[ObjM-A_Index+1] := Obj[ObjM+A_Index-tail]
return o
}
 
ObjDisp(obj){
For k, v in obj
s .= v ", "
return SubStr(s, 1, strLen(s)-2)
}
 
 
cd(n){ ; Count Derangements
static e := 2.71828182845904523536028747135
return n ? floor(ft(n)/e + 1/2) : 1
}
ft(n){ ; FacTorial
a := 1
Loop % n
a *= A_Index
return a
}
Output:
Derangements for 1, 2, 3, 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

Table of n, counted, calculated derangements:
	0	0	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

Approximation of !20: 895014631192902144

BBC BASIC[edit]

      PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
 
PRINT'"Table of n, counted derangements, calculated derangements :"
 
FOR I% = 0 TO 9
PRINT I%, FN_Derangement_Generate(I%,FALSE), FN_SubFactorial(I%)
NEXT
 
PRINT'"There is no long int in BBC BASIC!"
PRINT"!20 = ";FN_SubFactorial(20)
 
END
 
DEF FN_Derangement_Generate(N%, fPrintOut)
LOCAL A%(), O%(), C%, D%, I%, J%
IF N% = 0 THEN = 1
DIM A%(N%-1), O%(N%-1)
FOR I% = 0 TO N%-1 : A%(I%) = I% : NEXT
O%() = A%()
FOR I% = 0 TO FN_Factorial(DIM(A%(),1)+1)-1
PROC_NextPermutation(A%())
D% = TRUE
FOR J%=0 TO N%-1
IF A%(J%) = O%(J%) THEN D% = FALSE
NEXT
IF D% THEN
C% += 1
IF fPrintOut THEN
FOR K% = 0 TO N%-1
PRINT ;A%(K%);" ";
NEXT
PRINT
ENDIF
ENDIF
NEXT
= C%
 
DEF PROC_NextPermutation(A%())
LOCAL first, last, elementcount, pos
elementcount = DIM(A%(),1)
IF elementcount < 1 THEN ENDPROC
pos = elementcount-1
WHILE A%(pos) >= A%(pos+1)
pos -= 1
IF pos < 0 THEN
PROC_Permutation_Reverse(A%(), 0, elementcount)
ENDPROC
ENDIF
ENDWHILE
last = elementcount
WHILE A%(last) <= A%(pos)
last -= 1
ENDWHILE
SWAP A%(pos), A%(last)
PROC_Permutation_Reverse(A%(), pos+1, elementcount)
ENDPROC
 
DEF PROC_Permutation_Reverse(A%(), firstindex, lastindex)
LOCAL first, last
first = firstindex
last = lastindex
WHILE first < last
SWAP A%(first), A%(last)
first += 1
last -= 1
ENDWHILE
ENDPROC
 
DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN =1 ELSE = N * FN_Factorial(N-1)
 
DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE =N*FN_SubFactorial(N-1)+-1^N
 
REM Or you could use:
REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))
Output:
Derangements for the numbers 0,1,2,3 are:
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, counted derangements, 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

There is no long int in BBC BASIC!
!20 = 8.95014632E17
>

Bracmat[edit]

The function calculated-!n has a local variable mem that memoizes already found counts. This is done by actually updating the function's definition. The output of the expression lst$calculated-!n demonstrates this.

The function counted-!n is also special: it is designed to always fail, forcing the match operation on the subject !H to assign each element in !H in turn to the sub-pattern (%@?h:~!p), except the element that is equal to !p. The derangements are built up in the last argument and accumulated in the global variable D. Also the counter count is a global variable.

( ( calculated-!n
= memo answ
. (memo==)
& ( !arg:0&1
| !arg:1&0
| !(memo.):? (!arg.?answ) ?&!answ
| (!arg+-1)
* (calculated-!n$(!arg+-1)+calculated-!n$(!arg+-2))
 : ?answ
& (!arg.!answ) !(memo.):?(memo.)
& !answ
)
)
& ( counted-!n
= p P h H A Z L
.  !arg:(%?p ?P.?H.?L)
&  !H
 :  ?A
(%@?h:~!p)
(?Z&counted-!n$(!P.!A !Z.!h !L))
|  !arg:(..?L)
& 1+!count:?count
& (!count.!L) !D:?D
& ~
)
& out$"Derangements of 1 2 3 4"
& :?D
& 0:?count
& ( counted-!n$(4 3 2 1.4 3 2 1.)
| out$!D
)
& ( pad
= len w
. @(!arg:? [?len)
& @(" ":? [!len ?w)
& !w !arg
)
& :?K
& -1:?N
& out$(str$(N pad$List pad$Calc))
& whl
' ( !N+1:<10:?N
& ( 0:?count
& :?D
& counted-!n$(!K.!K.)
| out$(str$(!N pad$!count pad$(calculated-!n$!N)))
)
& !N !K:?K
)
& out$("!20 =" calculated-!n$20)
& lst$calculated-!n
)
Output:
Derangements of 1 2 3 4
  (9.4 3 2 1)
  (8.3 4 2 1)
  (7.2 3 4 1)
  (6.4 3 1 2)
  (5.3 4 1 2)
  (4.3 1 4 2)
  (3.2 4 1 3)
  (2.4 1 2 3)
  (1.2 1 4 3)
N   List   Calc
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
(calculated-!n=
  memo answ
.   ( memo
    =
    =   (20.895014631192902121)
        (19.44750731559645106)
        (18.2355301661033953)
        (17.130850092279664)
        (16.7697064251745)
        (15.481066515734)
        (14.32071101049)
        (13.2290792932)
        (12.176214841)
        (11.14684570)
        (10.1334961)
        (9.133496)
        (8.14833)
        (7.1854)
        (6.265)
        (5.44)
        (4.9)
        (3.2)
        (2.1)
    )
  & ( !arg:0&1
    | !arg:1&0
    | !(memo.):? (!arg.?answ) ?&!answ
    |     (!arg+-1)*(calculated-!n$(!arg+-1)+calculated-!n$(!arg+-2))
        : ?answ
      & (!arg.!answ) !(memo.):?(memo.)
      & !answ
    )
);

C[edit]

#include <stdio.h>
typedef unsigned long long LONG;
 
LONG deranged(int depth, int len, int *d, int show)
{
int i;
char tmp;
LONG count = 0;
 
if (depth == len) {
if (show) {
for (i = 0; i < len; i++) putchar(d[i] + 'a');
putchar('\n');
}
return 1;
}
for (i = len - 1; i >= depth; i--) {
if (i == d[depth]) continue;
 
tmp = d[i]; d[i] = d[depth]; d[depth] = tmp;
count += deranged(depth + 1, len, d, show);
tmp = d[i]; d[i] = d[depth]; d[depth] = tmp;
}
return count;
}
 
LONG gen_n(int n, int show)
{
LONG i;
int a[1024]; /* 1024 ought to be big enough for anybody */
 
for (i = 0; i < n; i++) a[i] = i;
return deranged(0, n, a, show);
}
 
LONG sub_fact(int n)
{
return n < 2 ? 1 - n : (sub_fact(n - 1) + sub_fact(n - 2)) * (n - 1);
}
 
int main()
{
int i;
 
printf("Deranged Four:\n");
gen_n(4, 1);
 
printf("\nCompare list vs calc:\n");
for (i = 0; i < 10; i++)
printf("%d:\t%llu\t%llu\n", i, gen_n(i, 0), sub_fact(i));
 
printf("\nfurther calc:\n");
for (i = 10; i <= 20; i++)
printf("%d: %llu\n", i, sub_fact(i));
 
return 0;
}
Output:
Deranged Four:
dabc
dcab
dcba
cdba
cdab
cadb
bdac
bcda
badc

Compare list vs calc:
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

further calc:
10: 1334961
11: 14684570
12: 176214841
13: 2290792932
14: 32071101049
15: 481066515734
16: 7697064251745
17: 130850092279664
18: 2355301661033953
19: 44750731559645106
20: 895014631192902121

D[edit]

Iterative Version[edit]

import std.stdio, std.algorithm, std.typecons, std.conv,
std.range, std.traits;
 
T factorial(T)(in T n) pure nothrow @safe @nogc {
Unqual!T result = 1;
foreach (immutable i; 2 .. n + 1)
result *= i;
return result;
}
 
T subfact(T)(in T n) pure nothrow @safe @nogc {
if (0 <= n && n <= 2)
return n != 1;
return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
 
auto derangements(in size_t n, in bool countOnly=false)
pure nothrow @safe {
size_t[] seq = n.iota.array;
auto ori = seq.idup;
size_t[][] all;
size_t cnt = n == 0;
 
foreach (immutable tot; 0 .. n.factorial - 1) {
size_t j = n - 2;
while (seq[j] > seq[j + 1])
j--;
size_t k = n - 1;
while (seq[j] > seq[k])
k--;
seq[k].swap(seq[j]);
 
size_t r = n - 1;
size_t s = j + 1;
while (r > s) {
seq[s].swap(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);
}
 
void main() @safe {
"Derangements for n = 4:".writeln;
foreach (const d; 4.derangements[0])
d.writeln;
 
"\nTable of n vs counted vs calculated derangements:".writeln;
foreach (immutable i; 0 .. 10)
writefln("%s  %-7s%-7s", i, derangements(i, 1)[1], i.subfact);
 
writefln("\n!20 = %s", 20L.subfact);
}
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

Recursive Version[edit]

Slightly slower but more compact recursive version of the derangements function, based on the D entry of the permutations task. Same output.

import std.stdio, std.algorithm, std.typecons, std.conv, std.range;
 
T factorial(T)(in T n) pure nothrow {
Unqual!T result = 1;
foreach (immutable i; 2 .. n + 1)
result *= i;
return result;
}
 
T subfact(T)(in T n) pure nothrow {
if (0 <= n && n <= 2)
return n != 1;
return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
 
auto derangementsR(in size_t n, in bool countOnly=false) pure
/*nothrow*/ {
auto seq = n.iota.array;
immutable ori = seq.idup;
const(size_t[])[] res;
size_t cnt;
 
void perms(in size_t[] s, in size_t[] pre=null) /*nothrow*/ {
if (s.length) {
foreach (immutable i, immutable c; s)
perms(s[0 .. i] ~ s[i + 1 .. $], pre ~ c);
} else if (zip(pre, ori).all!(po => po[0] != po[1])) {
if (countOnly) cnt++;
else res ~= pre;
}
}
 
perms(seq);
return tuple(res, cnt);
}
 
void main() {
"Derangements for n = 4:".writeln;
foreach (const d; 4.derangementsR[0])
d.writeln;
 
"\nTable of n vs counted vs calculated derangements:".writeln;
foreach (immutable i; 0 .. 10)
writefln("%s  %-7s%-7s", i, derangementsR(i, 1)[1], i.subfact);
 
writefln("\n!20 = %s", 20L.subfact);
}

EchoLisp[edit]

 
(lib 'list) ;; in-permutations
(lib 'bigint)
 
;; generates derangements by filtering out permutations
(define (derangement? nums) ;; predicate
(for/and ((n nums) (i (length nums))) (!= n i)))
 
(define (derangements n)
(for/list ((p (in-permutations n))) #:when (derangement? p) p))
 
(define (count-derangements n)
(for/sum ((p (in-permutations n))) #:when (derangement? p) 1))
 
;;
;;  !n = (n - 1) (!(n-1) + !(n-2))
 
(define (!n n)
(* (1- n) (+ (!n (1- n)) (!n (- n 2)))))
(remember '!n #(1 0))
 
 
Output:
 
(derangements 4)
((3 0 1 2) (2 0 3 1) (2 3 0 1) (3 2 0 1) (3 2 1 0) (2 3 1 0) (1 2 3 0) (1 3 0 2) (1 0 3 2))
 
;; generated versus computed
 
(for ((i 10)) (writeln i '| (count-derangements i) (!n 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
 
(!n 20)
895014631192902121
 

Elixir[edit]

Translation of: Ruby
defmodule Permutation do
def derangements(n) do
list = Enum.to_list(1..n)
Enum.filter(permutation(list), fn perm ->
Enum.zip(list, perm) |> Enum.all?(fn {a,b} -> a != b end)
end)
end
 
def subfact(0), do: 1
def subfact(1), do: 0
def subfact(n), do: (n-1) * (subfact(n-1) + subfact(n-2))
 
def permutation([]), do: [[]]
def permutation(list) do
for x <- list, y <- permutation(list -- [x]), do: [x|y]
end
end
 
IO.puts "derangements for n = 4"
Enum.each(Permutation.derangements(4), &IO.inspect &1)
 
IO.puts "\nNumber of derangements"
IO.puts " n derange subfact"
Enum.each(0..9, fn n ->
 :io.format "~2w :~9w,~9w~n", [n, length(Permutation.derangements(n)), Permutation.subfact(n)]
end)
Enum.each(10..20, fn n ->
 :io.format "~2w :~19w~n", [n, Permutation.subfact(n)]
end)
Output:
derangements for n = 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]

Number of derangements
 n    derange   subfact
 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
10 :            1334961
11 :           14684570
12 :          176214841
13 :         2290792932
14 :        32071101049
15 :       481066515734
16 :      7697064251745
17 :    130850092279664
18 :   2355301661033953
19 :  44750731559645106
20 : 895014631192902121

GAP[edit]

# All of this is built-in
Derangements([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 ] ]
Size(last);
# 9
 
NrDerangements([1 .. 4]);
# 9
 
# An implementation using formula D(n + 1) = n*(D(n) + D(n - 1))
NrDerangementsAlt_memo := [1, 0];
NrDerangementsAlt := function(n)
if not IsBound(NrDerangementsAlt_memo[n + 1]) then
NrDerangementsAlt_memo[n + 1] := (n - 1)*(NrDerangementsAlt(n - 1) + NrDerangementsAlt(n - 2));
fi;
return NrDerangementsAlt_memo[n + 1];
end;
 
L := List([0 .. 9]);
 
PrintArray(TransposedMat([L,
List(L, n -> Size(Derangements([1 .. n]))),
List(L, n -> NrDerangements([1 .. n])),
List(L, NrDerangementsAlt)]));
# [ [ 0, 1, 1, 1 ],
# [ 1, 0, 0, 0 ],
# [ 2, 1, 1, 1 ],
# [ 3, 2, 2, 2 ],
# [ 4, 9, 9, 9 ],
# [ 5, 44, 44, 44 ],
# [ 6, 265, 265, 265 ],
# [ 7, 1854, 1854, 1854 ],
# [ 8, 14833, 14833, 14833 ],
# [ 9, 133496, 133496, 133496 ] ]

Go[edit]

package main
 
import (
"fmt"
"math/big"
)
 
// task 1: function returns list of derangements of n integers
func dList(n int) (r [][]int) {
a := make([]int, n)
for i := range a {
a[i] = i
}
// recursive closure permutes a
var recurse func(last int)
recurse = func(last int) {
if last == 0 {
// bottom of recursion. you get here once for each permutation.
// test if permutation is deranged.
for j, v := range a {
if j == v {
return // no, ignore it
}
}
// yes, save a copy
r = append(r, append([]int{}, a...))
return
}
for i := last; i >= 0; i-- {
a[i], a[last] = a[last], a[i]
recurse(last - 1)
a[i], a[last] = a[last], a[i]
}
}
recurse(n - 1)
return
}
 
// task 3: function computes subfactorial of n
func subFact(n int) *big.Int {
if n == 0 {
return big.NewInt(1)
} else if n == 1 {
return big.NewInt(0)
}
d0 := big.NewInt(1)
d1 := big.NewInt(0)
f := new(big.Int)
for i, n64 := int64(1), int64(n); i < n64; i++ {
d0, d1 = d1, d0.Mul(f.SetInt64(i), d0.Add(d0, d1))
}
return d1
}
 
func main() {
// task 2:
fmt.Println("Derangements of 4 integers")
for _, d := range dList(4) {
fmt.Println(d)
}
 
// task 4:
fmt.Println("\nNumber of derangements")
fmt.Println("N Counted Calculated")
for n := 0; n <= 9; n++ {
fmt.Printf("%d %8d %11s\n", n, len(dList(n)), subFact(n).String())
}
 
// stretch (sic)
fmt.Println("\n!20 =", subFact(20))
}
Output:
Derangements of 4 integers
[1 0 3 2]
[3 0 1 2]
[1 3 0 2]
[2 0 3 1]
[2 3 0 1]
[3 2 0 1]
[3 2 1 0]
[2 3 1 0]
[1 2 3 0]

Number of derangements
N  Counted  Calculated
0        0           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

Groovy[edit]

Solution:

def fact = { n -> [1,(1..<(n+1)).inject(1) { prod, i -> prod * i }].max() }
def subfact
subfact = { BigInteger n -> (n == 0) ? 1 : (n == 1) ? 0 : ((n-1) * (subfact(n-1) + subfact(n-2))) }
 
def derangement = { List l ->
def d = []
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p }
d
}

Test:

def d = derangement([1,2,3,4])
assert d.size() == subfact(4)
d.each { println it }
 
println """
n # derangements subfactorial
= ============== ============"""

(0..9). each { n ->
def dr = derangement((1..<(n+1)) as List)
def sf = subfact(n)
printf('%1d  %14d  %12d\n', n, dr.size(), sf)
}
 
println """
!20 == ${subfact(20)}
"""
Output:
[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]

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

!20 == 895014631192902121

Haskell[edit]

import Control.Monad
import Data.List
 
-- Compute all derangements of a list
derangements xs = filter (and . zipWith (/=) xs) $ permutations xs
 
-- Compute the number of derangements of n elements
subfactorial 0 = 1
subfactorial 1 = 0
subfactorial n = (n-1) * (subfactorial (n-1) + subfactorial (n-2))
 
main = do
-- Generate and show all the derangements of four integers
print $ derangements [1..4]
putStrLn ""
 
-- Print the count of derangements vs subfactorial
forM_ [1..9] $ \i ->
putStrLn $ show (length (derangements [1..i])) ++ " " ++
show (subfactorial i)
putStrLn ""
 
-- Print the number of derangements in a list of 20 items
print $ subfactorial 20
Output:
[[4,3,2,1],[3,4,2,1],[2,3,4,1],[4,1,2,3],[2,4,1,3],[2,1,4,3],[4,3,1,2],[3,4,1,2],[3,1,4,2]]

0 0
1 1
2 2
9 9
44 44
265 265
1854 1854
14833 14833
133496 133496

895014631192902121

Alternatively, this is a backtracking method:

derangements xs = loop xs xs
where loop [] [] = [[]]
loop (h:hs) xs = [x:ys | x <- xs, x /= h, ys <- loop hs (delete x xs)]

Since the value i cannot occur in position i, we prefix i on all other derangements from 1 to n that do not include i. The first method of filtering permutations is significantly faster, in practice, however.

J[edit]

Note: !n in J denotes factorial (or gamma n+1), and not subfactorial.

derangement=: (A.&i.~ !)~ (*/ .~: # [) i.  NB. task item 1
subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3

Requested examples:

   derangement 4 NB. task item 2
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
(,subfactorial,[email protected])"0 i.10 NB. task item 4
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
subfactorial 20 NB. stretch task
8.95015e17
subfactorial 20x NB. using extended precision
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 seems like an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).

Java[edit]

Translation of: D
import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
 
public class Derangement {
 
public static void main(String[] args) {
System.out.println("derangements for n = 4\n");
for (Object d : (ArrayList)(derangements(4, false)[0])) {
System.out.println(Arrays.toString((int[])d));
}
 
System.out.println("\ntable of n vs counted vs calculated derangements\n");
for (int i = 0; i < 10; i++) {
int d = ((Integer)derangements(i, true)[1]).intValue();
System.out.printf("%d  %-7d %-7d\n", i, d, subfact(i));
}
 
System.out.printf ("\n!20 = %20d\n", subfact(20L));
}
 
static Object[] derangements(int n, boolean countOnly) {
int[] seq = iota(n);
int[] ori = Arrays.copyOf(seq, n);
long tot = fact(n);
 
List<int[]> all = new ArrayList<int[]>();
int cnt = n == 0 ? 1 : 0;
 
while (--tot > 0) {
int j = n - 2;
while (seq[j] > seq[j + 1]) {
j--;
}
int k = n - 1;
while (seq[j] > seq[k]) {
k--;
}
swap(seq, k, j);
 
int r = n - 1;
int s = j + 1;
while (r > s) {
swap(seq, s, r);
r--;
s++;
}
 
j = 0;
while (j < n && seq[j] != ori[j]) {
j++;
}
if (j == n) {
if (countOnly) {
cnt++;
} else {
all.add(Arrays.copyOf(seq, n));
}
}
}
return new Object[]{all, cnt};
}
 
static long fact(long n) {
long result = 1;
for (long i = 2; i <= n; i++) {
result *= i;
}
return result;
}
 
static long subfact(long n) {
if (0 <= n && n <= 2) {
return n != 1 ? 1 : 0;
}
return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
 
static void swap(int[] arr, int lhs, int rhs) {
int tmp = arr[lhs];
arr[lhs] = arr[rhs];
arr[rhs] = tmp;
}
 
static int[] iota(int n) {
if (n < 0) {
throw new IllegalArgumentException("iota cannot accept < 0");
}
int[] r = new int[n];
for (int i = 0; i < n; i++) {
r[i] = i;
}
return r;
}
}
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

jq[edit]

Works with: jq version 1.4

The following implementation of "derangements" generates the derangements directly, without generating all permutations. Since recent versions of jq have tail-call optimization (TCO) for arity-0 recursive functions, the workhorse inner function (deranged/0) is implemented as an arity-0 function.

def derangements:
 
# In order to reference the original array conveniently, define _derangements(ary):
def _derangements(ary):
# We cannot put the i-th element in the i-th place:
def deranged: # state: [i, available]
.[0] as $i | .[1] as $in
| if $i == (ary|length) then []
else
($in[] | select (. != ary[$i])) as $j
| [$j] + ([$i+1, ($in - [$j])] | deranged)
end
 ;
[0,ary]|deranged;
. as $in | _derangements($in);
 
def subfact:
if . == 0 then 1
elif . == 1 then 0
else (.-1) * (((.-1)|subfact) + ((.-2)|subfact))
end;
 
# Avoid creating an array just to count the items in a stream:
def count(g): reduce g as $i (0; . + 1);

Tasks:

 "Derangements:",
([range(1;5)] | derangements),
"",
"Counted vs Computed Derangments:",
(range(1;10) as $i | "\($i): \(count( [range(0;$i)] | derangements)) vs \($i|subfact)"),
"",
"Computed approximation to !20 (15 significant digits): \(20|subfact)"
Output:
$ jq -n -c -r -f derangements.jq
jq -n -c -r -f derangements.jq
 
Derangements:
[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]
 
Counted vs Computed Derangments:
1: 0 vs 0
2: 1 vs 1
3: 2 vs 2
4: 9 vs 9
5: 44 vs 44
6: 265 vs 265
7: 1854 vs 1854
8: 14833 vs 14833
9: 133496 vs 133496
 
Computed approximation to !20 (15 significant digits): 895014631192902000

Lua[edit]

-- 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))
Output:
Derangements of [1,2,3,4]
        2       3       4       1
        3       4       2       1
        4       3       2       1
        4       3       1       2
        3       4       1       2
        3       1       4       2
        2       4       1       3
        4       1       2       3
        2       1       4       3


Subfactorial vs counted derangements

        n       | subFact(n)    | 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


The subfactorial of 20 is 8.950146311929e+17

Mathematica[edit]

 
Needs["Combinatorica`"]
derangements[n_] := Derangements[Range[n]]
derangements[4]
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm
Subfactorial[20]
Output:
{{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}}
 
0	0
1	1
2	2
9	9
44	44
265	265
1854	1854
14833	14833
133496	133496

895014631192902121

PARI/GP[edit]

derangements(n)=if(n,round(n!/exp(1)),1);
derange(n)={
my(v=[[]],tmp);
for(level=1,n,
tmp=List();
for(i=1,#v,
for(k=1,n,
if(k==level, next);
for(j=1,level-1,if(v[i][j]==k, next(2)));
listput(tmp, concat(v[i],k))
)
);
v=Vec(tmp)
);
v
};
derange(4)
for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n)))
derangements(20)
Output:
%1 = [[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]]

!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

%2 = 895014631192902121

Perl[edit]

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;
Output:
Derangements for 4 elements:
1: 1 0 3 2
2: 1 2 3 0
3: 1 3 0 2
4: 2 0 3 1
5: 2 3 0 1
6: 2 3 1 0
7: 3 0 1 2
8: 3 2 0 1
9: 3 2 1 0

Compare list length and calculated table
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

Number of derangements:
1:      0
2:      1
3:      2
4:      9
5:      44
6:      265
7:      1854
8:      14833
9:      133496
10:     1334961
11:     14684570
12:     176214841
13:     2290792932
14:     32071101049
15:     481066515734
16:     7697064251745
17:     130850092279664
18:     2355301661033953
19:     44750731559645106
20:     895014631192902121

Perl 6[edit]

Translation of: Perl
Works with: Rakudo version 2016.10
 
sub is-derangement(List $l) {
return not grep { $l[$_] == $_ }, 0..($l.elems - 1);
}
 
# task 1
sub derangements(Range $x) {
$x.permutations.grep( *.&is-derangement )
}
 
# task 2
.say for (0..4).&derangements;
 
# task 3
sub prefix:<!>(Int $x) {
return +derangements(^$x);
}
 
# task 4
for ^9 -> $n {
say "number: " ~ $n;
say "count: " ~ !$n;
say "derangements: ";
.say for (0..$n-1).&derangements;
}
 

Phix[edit]

function deranged(sequence s1, sequence s2)
for i=1 to length(s1) do
if s1[i]==s2[i] then return 0 end if
end for
return 1
end function
 
function derangements(integer n)
sequence ts = tagset(n)
sequence res = {}
for i=1 to factorial(n) do
sequence s = permute(i,ts)
if deranged(s,ts) then
res = append(res,s)
end if
end for
return res
end function
 
function subfactorial(integer n)
if n<=0 then return 1 end if
if n=1 then return 0 end if
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
end function
 
?derangements(4)
for n=0 to 9 do
printf(1,"%d: counted:%d, calculated:%d\n",{n,length(derangements(n)),subfactorial(n)})
end for
printf(1,"!20=%d (incorrect!)\n",{subfactorial(20)})
include builtins\bigatom.e
function ba_subfactorial(integer n)
if n<=0 then return 1 end if
if n=1 then return 0 end if
return ba_multiply(n-1,ba_add(ba_subfactorial(n-1),ba_subfactorial(n-2)))
end function
ba_printf(1,"!20=%B (bigatom)\n",ba_subfactorial(20))
Output:
{{2,3,4,1},{4,3,1,2},{2,4,1,3},{3,4,2,1},{3,1,4,2},{4,1,2,3},{2,1,4,3},{3,4,1,2},{4,3,2,1}}
0: counted:1, calculated:1
1: counted:0, calculated:0
2: counted:1, calculated:1
3: counted:2, calculated:2
4: counted:9, calculated:9
5: counted:44, calculated:44
6: counted:265, calculated:265
7: counted:1854, calculated:1854
8: counted:14833, calculated:14833
9: counted:133496, calculated:133496
!20=895014631192902186 (incorrect!)
!20=895014631192902121 (bigatom)

PicoLisp[edit]

(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))) ) ) )
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

PureBasic[edit]

This example is incomplete. Missing the subfactorial !n. Please ensure that it meets all task requirements and remove this message.

Brute Force: Tested up to n=10

 
 
Procedure.q perm(n)
if n=0:ProcedureReturn 1:endif
if n=1:ProcedureReturn 0:endif
ProcedureReturn (perm(n-1)+perm(n-2))*(n-1)
EndProcedure
 
factFile.s="factorials.txt"
tempFile.s="temp.txt"
drngFile.s="derangements.txt"
DeleteFile(factFile.s)
DeleteFile(tempFile.s)
DeleteFile(drngFile.s)
 
n=4
 
; create our storage file
f.s=factFile.s
If CreateFile(2113,f.s)
WriteStringN(2113,"1.2")
WriteStringN(2113,"2.1")
CloseFile(2113)
Else
Debug "not createfile :"+f.s
EndIf
 
showfactorial=#FALSE
 
if showfactorial
; cw("nfactorial n ="+str(n))
Debug "nfactorial n ="+str(n)
endif
 
; build up the factorial combinations
for l=1 to n-2
gosub nfactorial
next
 
; extract the derangements
; cw("derangements["+str(perm(n))+"] for n="+str(n))
Debug "derangements["+str(perm(n))+"] for n="+str(n)
gosub derangements
; cw("")
Debug ""
 
; show the first 20 derangements
for i=0 to 20
; cw("derangements["+str(perm(i))+"] for n="+str(i))
Debug "derangements["+str(perm(i))+"] for n="+str(i)
next
end
 
derangements:
x=0
If ReadFile(2112,factFile.s) and CreateFile(2113,drngFile.s)
repeat
r.s = ReadString(2112)
cs=CountString(r.s,".")
if cs
hit=0
t.s=""
; scan for numbers at their index
for i=1 to cs+1
s.s=StringField(r.s,i,".")
t.s+s.s+"."
if val(s.s)=i:hit+1:endif
next
t.s=rtrim(t.s,".")
; show only those which are valid
if not hit
x+1
; cw(t.s+" "+str(x))
Debug t.s+" "+str(x)
WriteStringN(2113,t.s+" "+str(x))
endif
endif
until eof(2112)
CloseFile(2112)
CloseFile(2113)
Else
Debug "not readfile :"+factFile.s
Debug "not createfile :"+drngFile.s
EndIf
; cw("")
Debug ""
return
 
nfactorial:
x=0
If ReadFile(2112,factFile.s) and CreateFile(2113,tempFile.s)
repeat
r.s = ReadString(2112)
cs=CountString(r.s,".")
if cs
for j=1 to cs+2
t.s=""
for i=1 to cs+1
s.s=StringField(r.s,i,".")
if i=j
t.s+"."+str(cs+2)+"."+s.s
else
t.s+"."+s.s
endif
next
if j=cs+2:t.s+"."+str(cs+2):endif
t.s=trim(t.s,".")
x+1
if cs+2=n and showfactorial
; cw(t.s+" "+str(x))
Debug t.s+" "+str(x)
endif
WriteStringN(2113,t.s)
next
endif
until eof(2112)
CloseFile(2112)
CloseFile(2113)
Else
Debug "not readfile :"+factFile.s
Debug "not createfile :"+tempFile.s
EndIf
CopyFile(tempFile.s,factFile.s)
DeleteFile(tempFile.s)
return
 
Output:
derangements[9] for n=4
4.3.1.2 1
3.4.1.2 2
3.1.4.2 3
4.1.2.3 4
4.3.2.1 5
3.4.2.1 6
2.3.4.1 7
2.4.1.3 8
2.1.4.3 9

derangements[1] for n=0
derangements[0] for n=1
derangements[1] for n=2
derangements[2] for n=3
derangements[9] for n=4
derangements[44] for n=5
derangements[265] for n=6
derangements[1854] for n=7
derangements[14833] for n=8
derangements[133496] for n=9
derangements[1334961] for n=10
derangements[14684570] for n=11
derangements[176214841] for n=12
derangements[2290792932] for n=13
derangements[32071101049] for n=14
derangements[481066515734] for n=15
derangements[7697064251745] for n=16
derangements[130850092279664] for n=17
derangements[2355301661033953] for n=18
derangements[44750731559645106] for n=19
derangements[895014631192902121] for n=20
Translation of: C
Procedure.i deranged(depth, lenn, Array d(1), show)
Protected count, tmp, i
If depth = lenn
If show
For i = 0 To lenn - 1: Print(Chr(d(i) + 'a')): Next
PrintN("")
EndIf
ProcedureReturn 1
EndIf
 
For i = lenn - 1 To depth Step -1
If i = d(depth): Continue: EndIf
 
tmp = d(i): d(i) = d(depth): d(depth) = tmp
count + deranged(depth + 1, lenn, d(), show)
tmp = d(i): d(i) = d(depth): d(depth) = tmp
Next
 
ProcedureReturn count
EndProcedure
 
Procedure.q sub_fact(n)
If n = 0: ProcedureReturn 1: EndIf
If n = 1: ProcedureReturn 0: EndIf
ProcedureReturn (sub_fact(n - 1) + sub_fact(n - 2)) * (n - 1)
EndProcedure
 
Procedure.i gen_n(n, show)
Protected r.i
Dim a(1024)
For i = 0 To n - 1: a(i) = i: Next
ProcedureReturn deranged(0, n, a(), show)
EndProcedure
 
If OpenConsole()
PrintN("Deranged Four:")
gen_n(4, 1)
 
PrintN(#CRLF$ + "Compare list vs calc:")
For i = 0 To 9
PrintN(Str(i) + ":" + #TAB$ + Str(gen_n(i, 0)) + #TAB$ + Str(sub_fact(i)))
Next
 
PrintN(#CRLF$ + "further calc:")
For i = 10 To 20
PrintN(Str(i) + ": " + Str(sub_fact(i)))
Next
 
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf
Output:
Deranged Four:
dabc
dcab
dcba
cdba
cdab
cadb
bdac
bcda
badc

Compare list vs calc:
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

further calc:
10: 1334961
11: 14684570
12: 176214841
13: 2290792932
14: 32071101049
15: 481066515734
16: 7697064251745
17: 130850092279664
18: 2355301661033953
19: 44750731559645106
20: 895014631192902121

Python[edit]

Includes stretch goal.

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)))
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

Racket[edit]

 
#lang racket
 
(define (all-misplaced? l)
(for/and ([x (in-list l)] [n (in-naturals 1)]) (not (= x n))))
 
;; 1. Create a named function to generate derangements of the integers 0..n-1.
(define (derangements n)
(define (all-misplaced? l1 l2)
(or (null? l1)
(and (not (eq? (car l1) (car l2)))
(all-misplaced? (cdr l1) (cdr l2)))))
(define l (range n))
(for/list ([p (permutations l)] #:when (all-misplaced? p l))
p))
 
;; 2. Generate and show all the derangements of 4 integers using the above
;; routine.
(derangements 4)
;; -> '((1 0 3 2) (3 0 1 2) (1 3 0 2) (2 0 3 1) (2 3 0 1)
;; (3 2 0 1) (1 2 3 0) (2 3 1 0) (3 2 1 0))
 
;; 3. Create a function that calculates the subfactorial of n, !n.
(define (sub-fact n)
(if (< n 2) (- 1 n)
(* (+ (sub-fact (- n 1)) (sub-fact (- n 2))) (sub1 n))))
 
;; 4. Print and show a table of the counted number of derangements of n vs. the
;; calculated !n for n from 0..9 inclusive.
(for ([i 10])
(printf "~a ~a ~a\n" i
(~a #:width 7 #:align 'right (length (derangements i)))
(sub-fact i)))
;; Output:
;; 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
 
;; Extra: !20
(sub-fact 20)
;; -> 895014631192902121
 

REXX[edit]

/*REXX pgm generates all permutations of N derangements & subfactorial #*/
numeric digits 1000 /*be able to handle big subfacts.*/
parse arg N .; if N=='' then N=4 /*Not specified? Assume default*/
d=derangementsSet(N) /*go & build the derangements set*/
say d 'derangements for' N "items are:"
say
do i=1 for d /*show derangements for N items.*/
say right('derangement',22) right(i,length(d)) '───►' $.i
end /*i*/
say /* [↓] count and calculate  !L. */
do L=0 to 9; d=derangementsSet(L)
say L 'items: derangement count='right(d,6)",  !"L'='right(!s(L),6)
end /*L*/
say
say right('!20=' , 40)  !s( 20)
say right('!100=', 40)  !s(100)
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────!S subroutine───────────────────────*/
!s: _=1; do j=1 for arg(1);if j//2 then _=-1+j*_;else _=1+j*_;end;return _
/*──────────────────────────────────DERANGEMENTSSET subroutine──────────*/
derangementsSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
if x==0 then return 1; if x==1 then return 0
/*populate the first derangement.*/
@.1=2; @.2=1; do i=3 to x; @.i=i; end
parse value @.p @.x with @.x @.p; call .buildD x /*swap & build.*/
/*build others.*/
do while .nextD(x,0); call .buildD x; end
return #
/*──────────────────────────────────.BUILDD subroutine──────────────────*/
.buildD: do j=1 for arg(1); if @.j==j then return; end
#=#+1; do j=1 for arg(1); $.#=$.# @.j; end; return
/*──────────────────────────────────.NEXTD subroutine───────────────────*/
.nextD: procedure expose @.; parse arg n,i; nm=n-1
 
do k=nm by -1 for nm; kp=k+1; if @.k<@.kp then do; i=k; leave; end
end /*k*/
 
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
 
if i==0 then return 0
do j=i+1 while @.j<@.i; end
parse value @.j @.i with @.i @.j
return 1
Output:
9 derangements for 4 items are:

           derangement 1 ───►  2 1 4 3
           derangement 2 ───►  2 3 4 1
           derangement 3 ───►  2 4 1 3
           derangement 4 ───►  3 1 4 2
           derangement 5 ───►  3 4 1 2
           derangement 6 ───►  3 4 2 1
           derangement 7 ───►  4 1 2 3
           derangement 8 ───►  4 3 1 2
           derangement 9 ───►  4 3 2 1

0 items:  derangement count=     1,  !0=     1
1 items:  derangement count=     0,  !1=     0
2 items:  derangement count=     1,  !2=     1
3 items:  derangement count=     2,  !3=     2
4 items:  derangement count=     9,  !4=     9
5 items:  derangement count=    44,  !5=    44
6 items:  derangement count=   265,  !6=   265
7 items:  derangement count=  1854,  !7=  1854
8 items:  derangement count= 14833,  !8= 14833
9 items:  derangement count=133496,  !9=133496

                                    !20= 895014631192902121
                                   !200= 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201

Ruby[edit]

def derangements(n)
ary = (1 .. n).to_a
ary.permutation.select do |perm|
ary.zip(perm).all? {|a,b| a != b}
end
end
 
def subfact(n)
case n
when 0 then 1
when 1 then 0
else (n-1)*(subfact(n-1) + subfact(n-2))
end
end
 
puts "derangements for n = 4"
derangements(4).each{|d|p d}
 
puts "\n n derange subfact"
(0..9).each do |n|
puts "%2d :%8d,%8d" % [n, derangements(n).size, subfact(n)]
end
 
puts "\nNumber of derangements"
(10..20).each do |n|
puts "#{n} : #{subfact(n)}"
end
Output:
derangements for n = 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]

 n   derange  subfact
 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

Number of derangements
10 : 1334961
11 : 14684570
12 : 176214841
13 : 2290792932
14 : 32071101049
15 : 481066515734
16 : 7697064251745
17 : 130850092279664
18 : 2355301661033953
19 : 44750731559645106
20 : 895014631192902121

Scala[edit]

Translation of: Ruby
def derangements(n: Int) =
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
 
def subfactorial(n: Long): Long = n match {
case 0 => 1
case 1 => 0
case _ => (n - 1) * (subfactorial(n - 1) + subfactorial(n - 2))
}
 
println(s"Derangements for n = 4")
println(derangements(4) mkString "\n")
 
println("\n%2s%10s%10s".format("n", "derange", "subfact"))
(0 to 9).foreach(n => println("%2d%10d%10d".format(n, derangements(n).size, subfactorial(n))))
(10 to 20).foreach(n => println(f"$n%2d${subfactorial(n)}%20d"))
Output:
Derangements for n = 4
Vector(2, 1, 4, 3)
Vector(2, 3, 4, 1)
Vector(2, 4, 1, 3)
Vector(3, 1, 4, 2)
Vector(3, 4, 1, 2)
Vector(3, 4, 2, 1)
Vector(4, 1, 2, 3)
Vector(4, 3, 1, 2)
Vector(4, 3, 2, 1)

 n   derange   subfact
 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
10             1334961
11            14684570
12           176214841
13          2290792932
14         32071101049
15        481066515734
16       7697064251745
17     130850092279664
18    2355301661033953
19   44750731559645106
20  895014631192902121

SuperCollider[edit]

(
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); "";
)

Answers:

 
[ 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 ]
 
(
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));
};
)

Answers:

 
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
 

Tcl[edit]

Library: Tcllib (Package: struct::list)
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
}

Demonstrating with the display parts of the task:

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]"
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

zkl[edit]

Translation of: Python
mostly
fcn subFact(n){
if(n==0) return(1);
if(n==1) return(0);
(n-1)*(self.fcn(n-1) + self.fcn(n-2));
}
 
fcn derangements(n){
// All deranged permutations of the integers 0..n-1 inclusive
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).filter('wrap(perm){
perm.zipWith('==,enum).sum(0) == 0
});
}
fcn derangers(n){ // just count # of derangements
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).reduce('wrap(sum,perm){
sum + (perm.zipWith('==,enum).sum(0) == 0)
},0);
}
println("Derangements of 0,1,2,3:\n",derangements(4));
println("\nTable of n vs counted vs calculated derangements:");
foreach n in (10){
println("%2d %-6d %-6d".fmt(n, derangers(n), subFact(n)));
}
 
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));
Output:
Derangements of 0,1,2,3: 
L(L(3,0,1,2),L(2,0,3,1),L(2,3,0,1),L(3,2,0,1),L(3,2,1,0),
L(2,3,1,0),L(1,2,3,0),L(1,3,0,2),L(1,0,3,2))

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

Lazy/iterators version:

fcn derangements(n){ //-->Walker
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
if(perm.zipWith('==,enum).sum(0)) Void.Skip
else perm
});
}
fcn derangers(n){ // just count # of derangements, w/o saving them
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
}
foreach d in (derangements(4)){ println(d) }
//rest of test code remains the same