Rosetta Code

Permutations/Derangements: Difference between revisions

Page Discussion

Permutations/Derangements (view source)

Revision as of 00:14, 17 April 2024

66,710 bytes added ,  1 month ago
m
→‎{{header|Raku}}: Add a version using subfactorials
(→‎{{header|Kotlin}}: Updated example see https://github.com/dkandalov/rosettacode-kotlin for details)
m (→‎{{header|Raku}}: Add a version using subfactorials)
 
(50 intermediate revisions by 27 users not shown)
Line 24:
*   [[Best shuffle]]
*   [[Left_factorials]]
 
 
{{Template:Strings}}
<br><br>
 
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="11l">F derangements(n)
[[Int]] r
V perm = Array(0 .< n)
L
I all(enumerate(perm).map((indx, p) -> indx != p))
r [+]= perm
I !perm.next_permutation()
L.break
R r
 
F subfact(n) -> Int64
R I n < 2 {1 - n} E (subfact(n - 1) + subfact(n - 2)) * (n - 1)
 
V n = 4
print(‘Derangements of ’Array(0 .< n))
L(d) derangements(n)
print(‘ ’d)
 
print("\nTable of n vs counted vs calculated derangements")
L(n) 10
print(‘#2 #<6 #.’.format(n, derangements(n).len, subfact(n)))
 
n = 20
print("\n!#. = #.".format(n, subfact(n)))</syntaxhighlight>
 
{{out}}
<pre>
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
</pre>
 
=={{header|360 Assembly}}==
{{trans|BBC BASIC}}
Due to 32 bit integers !12 is the limit.
<syntaxhighlight lang="360asm">* Permutations/Derangements 01/04/2017
DERANGE CSECT
USING DERANGE,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
XPRNT PG1,L'PG1 print title
LA R1,4 4
LA R2,1 1 : combinations print
BAL R14,DERGEN call dergen
STH R0,COUNT count=dergen(4,1)
XPRNT PG2,L'PG2 print table headings
XPRNT PG3,L'PG3 print hyphens
SR R4,R4
STH R4,II ii=0
DO WHILE=(CH,R4,LE,=H'9') do ii=0 to 9
MVC PG,=CL80' ' clear buffer
XDECO R4,PG edit ii
LR R1,R4 ii
LA R2,0 0 : no combination print
BAL R14,DERGEN dergen(ii,0)
XDECO R0,PG+12 edit
LH R1,II ii
BAL R14,SUBFACT subfact(ii)
XDECO R0,PG+24 edit
XPRNT PG,L'PG print
LH R4,II ii
LA R4,1(R4) i+1
STH R4,II i=i+1
ENDDO , enddo i
LA R0,12 12
STH R0,II ii=12
MVC PG,=CL16'!xx=' init buffer
XDECO R0,XDEC edit ii
MVC PG+1(2),XDEC+10 output
LH R1,II ii
BAL R14,SUBFACT subfact(ii)
XDECO R0,PG+4 edit subfact(ii)
XPRNT PG,16 print
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
*------- ---- -------------------------------------------
DERGEN EQU * dergen(n,fprt)
ST R14,SAVEDG
ST R1,N n
ST R2,FPRT fprt
IF LTR,R1,Z,R1 THEN if n=0 then
LA R0,1 1
B RETDG return(1)
ENDIF , endif
MVC C,=F'0' c=0
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) do i=1 to 2
LR R1,R6 i
SLA R1,1
STH R6,A-2(R1) a(i)=i
STH R6,AO-2(R1) ao(i)=i
LA R6,1(R6) i++
ENDDO , enddo i
L R1,N n
BAL R14,FACT
ST R0,FACTNM1 fact(n)-1
SR R6,R6 i=0
DO WHILE=(C,R6,LE,FACTNM1) do i=0 to fact(n)-1
L R1,N n
BAL R14,NEXTPER call nextper(n)
MVI D,X'01' d=true
LA R7,1
DO WHILE=(C,R7,LE,N) do j=1 to n
LR R1,R7 j
SLA R1,1
LH R2,A-2(R1) a(j)
LH R3,AO-2(R1) ao(j)
IF CR,R2,EQ,R3 THEN if a(j)=ao(j) then
MVI D,X'00' d=false
ENDIF , endif
LA R7,1(R7) j++
ENDDO , enddo j
IF CLI,D,EQ,X'01' THEN if d then
L R2,C c
LA R2,1(R2) c+1
ST R2,C c=c+1
IF CLI,FPRT+3,EQ,X'01' THEN if fprt=1 then
MVC PG,=CL80' ' clear buffer
LA R10,PG pgi=0
LA R7,1 j=1
DO WHILE=(C,R7,LE,N) do j=1 to n
LR R1,R7 j
SLA R1,1
LH R2,A-2(R1) a(j)
XDECO R2,XDEC edit
MVC 0(1,R10),XDEC+11 output
LA R10,2(R10) pgi=pgi+2
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print
ENDIF , endif
ENDIF , endif
LA R6,1(R6) i++
ENDDO , enddo i
L R0,C c
B RETDG return(c)
RETDG L R14,SAVEDG
BR R14
SAVEDG DS A
*------- ---- -------------------------------------------
NEXTPER EQU * nextper(nk)
ST R14,SAVENP
ST R1,NK nk
BCTR R1,0 nk-1
ST R1,NELEM nelem=nk-1
IF C,R1,LT,=F'1' THEN if nelem<1 then
LA R0,0 return(0)
B RETNP
ENDIF , endif
L R8,NELEM nelem
BCTR R8,0 pos=nelem-1
LOOPW1 EQU * while a(pos+1)>=a(pos+2)
LR R1,R8 pos
SLA R1,1
LH R2,A(R1) a(pos+1)
CH R2,A+2(R1) if a(pos+1)<a(pos+2)
BL ELOOPW1 then exit while
BCTR R8,0 pos=pos-1
IF LTR,R8,M,R8 THEN if pos<0 then
LA R1,0 0
L R2,NELEM nelem
BAL R14,PERMREV call permrev(0,nelem)
LA R0,0 return(0)
B RETNP
ENDIF , endif
B LOOPW1 endwhile
ELOOPW1 L R9,NELEM last=nelem
LOOPW2 EQU * do while a(last+1)<=a(pos+1)
LR R1,R9 last
SLA R1,1
LH R2,A(R1) a(last+1)
LR R1,R8 pos
SLA R1,1
CH R2,A(R1) if a(last+1)>a(pos+1)
BH ELOOPW2 then exit while
BCTR R9,0 last=last-1
B LOOPW2 endwhile
ELOOPW2 LR R1,R8 pos
SLA R1,1 *2
LA R2,A(R1) @a(pos+1)
LR R1,R9 last
SLA R1,1
LA R3,A(R1) @a(last+1)
LH R0,0(R2) w=a(pos+1)
MVC 0(2,R2),0(R3) a(pos+1)=a(last+1)
STH R0,0(R3) a(last+1)=w
LA R1,1(R8) pos+1
L R2,NELEM nelem
BAL R14,PERMREV call permrev(pos+1,nelem)
RETNP L R14,SAVENP
BR R14
SAVENP DS A
*------- ---- -------------------------------------------
PERMREV EQU * permrev(firstix,lastix)
LR R4,R1 xfirst
LR R5,R2 xlast
DO WHILE=(CR,R4,LT,R5) do while(xfirst<xlast)
LR R1,R4 xfirst
SLA R1,1 *2
LA R2,A(R1) @a(xfirst+1)
LR R1,R5 xlast
SLA R1,1 *2
LA R3,A(R1) @a(xlast+1)
LH R0,0(R2) w=a(xfirst+1)
MVC 0(2,R2),0(R3) a(xfirst+1)=a(xlast+1)
STH R0,0(R3) a(xlast+1)=w
LA R4,1(R4) xfirst=xfirst+1
BCTR R5,0 xlast=xlast-1
ENDDO , enddo
BR R14
*------- ---- ----------------------------------------
FACT EQU * fact(n)
IF C,R1,LE,=F'1' THEN if n<=1 then
LA R0,1 return(1)
ELSE , else
LA R5,1 f=1
LA R2,1 i=1
DO WHILE=(CR,R2,LE,R1) do i=1 to n
MR R4,R2 f*i
LA R2,1(R2) i++
ENDDO , enddo
LR R0,R5 return(f)
ENDIF , endif
BR R14
*------- ---- -------------------------------------------
SUBFACT EQU * subfact(n)
ST R1,NY n
IF LTR,R1,Z,R1 THEN if n=0 then
LA R0,1 return(1)
ELSE , else
LA R4,1 1
ST R4,TT tt(0)=1
ST R4,IY i=1
DO WHILE=(C,R4,LE,NY) do i=1 to n
L R4,IY i
SRDA R4,32
D R4,=F'2' i/2
IF LTR,R4,Z,R4 THEN if i//2=0 then
LA R0,1 nn=1
ELSE , else
L R0,=F'-1' nn=-1
ENDIF , endif
L R1,IY i
SLA R1,2
L R3,TT-4(R1) tt(i-1)
M R2,IY *i
AR R3,R0 +nn
L R1,IY i
SLA R1,2
ST R3,TT(R1) tt(i)=i*tt(i-1)+nn
L R4,IY i
LA R4,1(R4) i++
ST R4,IY i
ENDDO , enddo
L R1,NY n
SLA R1,2
L R0,TT(R1) return(tt(n))
ENDIF , endif
BR R14
* ---- -------------------------------------------
A DS 12H A work
AO DS 12H A origin
II DS H
COUNT DS H
N DS F
FPRT DS F flag for printing
C DS F
D DS X boolean : a(i) different ao(i)
FACTNM1 DS F fact(n)-1
NK DS F n in nextper
NELEM DS F n elements in nextper
NY DS F n in subfact
IY DS F i in subfact
TT DS 13F tt(0:12)
PG1 DC CL44'derangements for the numbers : 1 2 3 4 are :'
PG2 DC CL38' table of n counted calculated :'
PG3 DC CL36' ----------- ----------- -----------'
XDEC DS CL12 temp for xdeco
PG DC CL80' ' buffer
YREGS
END DERANGE</syntaxhighlight>
{{out}}
<pre>
derangements for the numbers : 1 2 3 4 are :
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 :
----------- ----------- -----------
0 1 1
1 0 0
2 2 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
!12= 176214841
</pre>
 
=={{header|Acornsoft Lisp}}==
 
Memory limits on machines like the [[wp:BBC_Micro|BBC Micro]] mean that we'd run out of memory if we tried to make a list of all permutations of a list longer than 6 or so elements. Permutations are therefore generated recursively one at a time and given to a ''visitor'' function. The recursion is effectively ''n'' nested loops for a list of length ''n'' and so is not a major obstacle in itself.
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((eq n 0) 1)
((eq n 1) 0)
(t (times (sub1 n)
(plus (subfact (sub1 n))
(subfact (sub1 (sub1 n))))))))
 
(defun count-derangements (n (count . 0))
(visit-derangements (range 1 n)
'(lambda (d) (setq count (add1 count))))
count)
 
(defun visit-derangements (original-items d-visitor)
(visit-permutations original-items
'(lambda (p)
(cond ((derangement-p original-items p)
(d-visitor p))))))
 
(defun derangement-p (original d (fail . nil))
(map '(lambda (a b) (cond ((eq a b) (setq fail t))))
original
d)
(not fail))
 
(defun visit-permutations (items p-visitor)
(visit-permutations-1 items '()))
 
(defun visit-permutations-1 (items perm)
(cond
((null items) (p-visitor (reverse perm)))
(t
(map '(lambda (i)
(visit-permutations-1
(without i items)
(cons i perm)))
items))))
 
'( Utilities )
 
(defun without (i items)
(cond ((null items) '())
((eq (car items) i) (cdr items))
(t (cons (car items) (without i (cdr items))))))
 
(defun reverse (list (result . ()))
(map '(lambda (e) (setq result (cons e result)))
list)
result)
 
(defun range (from to)
(cond ((greaterp from to) '())
(t (cons from (range (add1 from) to)))))
 
'( Examples )
 
(defun examples ()
(show-derangements '(1 2 3 4))
(printc)
(map '(lambda (i)
(printc i
'! (count-derangements i)
'! (subfact i)))
(range 0 8)))
 
(defun show-derangements (items)
(printc 'Derangements! of! items)
(visit-derangements items print))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> will output:
 
<pre>
Derangements of (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)
 
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
</pre>
 
The comparison table stops at ''n = 8'' because, since numbers are 16-bit integers, the program can't count as high as 133496. It can, however, generate all of those derangements.
 
=={{header|Ada}}==
{{trans|C}}
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO; use Ada.Text_IO;
procedure DePermute is
type U64 is mod 2**64;
Line 81 ⟶ 526:
end loop;
Put_Line ("!20 = " & U64'Image (sub_fact (20)));
end DePermute;</langsyntaxhighlight>
{{out}}
<pre>Deranged 4:
Line 105 ⟶ 550:
9 133496 133496
!20 = 895014631192902121</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">isClean?: function [s,o][
loop.with:'i s 'a [
if a = o\[i] -> return false
]
return true
]
 
derangements: function [n][
original: 1..n
select permutate original 'x ->
isClean? x original
]
 
subfactorial: function [n].memoize[
(n =< 1)? -> 1 - n
-> (n-1) * (add subfactorial n-1 subfactorial n-2)
]
 
print "Derangements of 1 2 3 4:"
loop derangements 4 'x [
print x
]
 
print "\nNumber of derangements:"
print [pad "n" 5 pad "counted" 15 pad "calculated" 15]
print repeat "-" 39
loop 0..9 'z [
counted: size derangements z
calculated: subfactorial z
print [pad to :string z 5 pad to :string counted 15 pad to :string calculated 15]
]
 
print ~"\n!20 = |subfactorial 20|"</syntaxhighlight>
 
{{out}}
 
<pre>Derangements of 1 2 3 4:
4 1 2 3
3 1 4 2
3 4 1 2
4 3 1 2
2 1 4 3
2 4 1 3
2 3 4 1
3 4 2 1
4 3 2 1
 
Number of derangements:
n 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</pre>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
Note that the permutations are generated in lexicographic order, from http://www.autohotkey.com/forum/topic77959.html
<langsyntaxhighlight AHKlang="ahk">#NoEnv
SetBatchLines -1
Process, Priority,, high
Line 204 ⟶ 714:
a *= A_Index
return a
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for 1, 2, 3, 4:
Line 230 ⟶ 740:
 
Approximation of !20: 895014631192902144</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight BBClang="bbc BASICbasic"> PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
Line 306 ⟶ 817:
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))</langsyntaxhighlight>
 
{{out}}
Line 345 ⟶ 856:
Also the counter <code>count</code> is a global variable.
<langsyntaxhighlight lang="bracmat">( ( calculated-!n
= memo answ
. (memo==)
Line 396 ⟶ 907:
& out$("!20 =" calculated-!n$20)
& lst$calculated-!n
)</langsyntaxhighlight>
{{out}}
<pre>Derangements of 1 2 3 4
Line 455 ⟶ 966:
 
=={{header|C}}==
<langsyntaxhighlight Clang="c">#include <stdio.h>
typedef unsigned long long LONG;
 
Line 511 ⟶ 1,022:
 
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>Deranged Four:
Line 548 ⟶ 1,059:
19: 44750731559645106
20: 895014631192902121</pre>
 
=={{header|C sharp|C#}}==
Recursive version
 
<syntaxhighlight lang="csharp">
using System;
class Derangements
{
static int n = 4;
static int [] buf = new int [n];
static bool [] used = new bool [n];
 
static void Main()
{
for (int i = 0; i < n; i++) used [i] = false;
rec(0);
}
 
static void rec(int ind)
{
for (int i = 0; i < n; i++)
{
if (!used [i] && i != ind)
{
used [i] = true;
buf [ind] = i;
if (ind + 1 < n) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
used [i] = false;
}
}
}
}
</syntaxhighlight>
 
=={{header|C++}}==
<syntaxhighlight lang="c++">
#include <cstdint>
#include <iomanip>
#include <iostream>
#include <numeric>
#include <vector>
 
typedef std::pair<std::vector<std::vector<int32_t>>, int32_t> list_or_count;
 
uint64_t factorial(const int32_t& n) {
uint64_t result = 1;
for ( int32_t i = 2; i <= n; ++i ) {
result *= i;
}
return result;
}
 
uint64_t subfactorial(const int32_t& n) {
if ( n >= 0 && n <= 2 ) {
return ( n == 1 ) ? 0 : 1;
}
return ( n - 1 ) * ( subfactorial(n - 1) + subfactorial(n - 2) );
}
 
list_or_count derangements(const int32_t& n, const bool& count_only) {
std::vector<int32_t> sequence(n, 0);
std::iota(sequence.begin() ,sequence.end(), 1);
std::vector<int32_t> original(sequence);
uint64_t permutation_count = factorial(n);
 
std::vector<std::vector<int32_t>> list;
int32_t count = ( n == 0 ) ? 1 : 0;
 
while ( --permutation_count > 0 ) {
int32_t j = n - 2;
while ( sequence[j] > sequence[j + 1] ) {
j--;
}
int32_t k = n - 1;
while ( sequence[j] > sequence[k] ) {
k--;
}
std::swap(sequence[j], sequence[k]);
 
int32_t r = n - 1;
int32_t s = j + 1;
while ( r > s ) {
std::swap(sequence[r], sequence[s]);
r--;
s++;
}
 
j = 0;
while ( j < n && sequence[j] != original[j] ) {
j++;
}
if ( j == n ) {
if ( count_only ) {
count++;
} else {
std::vector<int32_t> copy_sequence(sequence);
list.emplace_back(copy_sequence);
}
}
}
return list_or_count(list, count);
}
 
int main() {
std::cout << "Derangements for n = 4" << std::endl;
list_or_count list_count = derangements(4, false);
for ( std::vector<int32_t> list : list_count.first ) {
std::cout << "[";
for ( uint64_t i = 0; i < list.size() - 1; ++i ) {
std::cout << list[i] << ", ";
}
std::cout << list.back() << "]" << std::endl;
}
std::cout << std::endl;
 
std::cout << "n derangements !n" << std::endl;
std::cout << "------------------------" << std::endl;
for ( int32_t n = 0; n < 10; ++n ) {
int32_t count = derangements(n, true).second;
std::cout << n << ": " << std::setw(9) << count << " " << std::setw(9) << subfactorial(n) << std::endl;
}
std::cout << std::endl;
 
std::cout << "!20 = " << subfactorial(20) << std::endl;
}
</syntaxhighlight>
{{ out }}
<pre>
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 derangements !n
------------------------
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
</pre>
 
=={{header|Clojure}}==
Generating functions with no fixed point
 
<syntaxhighlight lang="clojure">(ns derangements.core
(:require [clojure.set :as s]))
 
(defn subfactorial [n]
(case n
0 1
1 0
(* (dec n) (+ (subfactorial (dec n)) (subfactorial (- n 2))))))
 
(defn no-fixed-point
"f : A -> B must be a biyective function written as a hash-map, returns
all g : A -> B such that (f(a) = b) => not(g(a) = b)"
[f]
(case (count f)
0 [{}]
1 []
(let [g (s/map-invert f)
a (first (keys f))
a' (f a)]
(mapcat
(fn [b'] (let [b (g b')
f' (dissoc f a b)]
(concat (map #(reduce conj % [[a b'] [b a']])
(no-fixed-point f'))
(map #(conj % [a b'])
(no-fixed-point (assoc f' b a'))))))
(filter #(not= a' %) (keys g))))))
 
(defn derangements [xs]
{:pre [(= (count xs) (count (set xs)))]}
(map (fn [f] (mapv f xs))
(no-fixed-point (into {} (map vector xs xs)))))
(defn -main []
(do
(doall (map println (derangements [0,1,2,3])))
(doall (map #(println (str (subfactorial %) " " (count (derangements (range %)))))
(range 10)))
(println (subfactorial 20))))
</syntaxhighlight>
{{Out}}
<pre>[1 0 3 2]
[1 2 3 0]
[1 3 0 2]
[2 3 0 1]
[2 3 1 0]
[2 0 3 1]
[3 2 1 0]
[3 2 0 1]
[3 0 1 2]
1 1
0 0
1 1
2 2
9 9
44 44
265 265
1854 1854
14833 14833
133496 133496
895014631192902121</pre>
 
=={{header|Common Lisp}}==
{{trans|Acornsoft Lisp}}
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((= n 0) 1)
((= n 1) 0)
(t (* (- n 1)
(+ (subfact (- n 1))
(subfact (- n 2)))))))
 
(defun count-derangements (n)
(let ((count 0))
(visit-derangements (range 1 n)
(lambda (d) (declare (ignore d)) (incf count)))
count))
 
(defun visit-derangements (items visitor)
(visit-permutations items
(lambda (p)
(when (derangement-p items p)
(funcall visitor p)))))
 
(defun derangement-p (original d)
(notany #'equal original d))
 
(defun visit-permutations (items visitor)
(labels
((vp (items perm)
(cond ((null items)
(funcall visitor (reverse perm)))
(t
(mapc (lambda (i)
(vp (remove i items)
(cons i perm)))
items)))))
(vp items '())))
 
(defun range (start end)
(loop for i from start to end collect i))
 
(defun examples ()
(show-derangements '(1 2 3 4))
(format t "~%n counted !n~%")
(dotimes (i 10)
(format t "~S ~7@S ~7@S~%"
i
(count-derangements i)
(subfact i)))
(format t "~%!20 = ~S~2%" (subfact 20)))
 
(defun show-derangements (items)
(format t "~%Derangements of ~S~%" items)
(visit-derangements items
(lambda (d)
(format t " ~S~%" d))))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> would output:
 
<pre>
Derangements of (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)
 
n counted !n
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
</pre>
 
=={{header|D}}==
===Iterative Version===
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.conv,
std.range, std.traits;
 
Line 615 ⟶ 1,436:
 
writefln("\n!20 = %s", 20L.subfact);
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4:
Line 645 ⟶ 1,466:
Slightly slower but more compact recursive version of the derangements function, based on the [[Permutations#D|D entry]] of the permutations task.
Same output.
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.conv, std.range;
 
T factorial(T)(in T n) pure nothrow {
Line 691 ⟶ 1,512:
 
writefln("\n!20 = %s", 20L.subfact);
}</langsyntaxhighlight>
 
=={{header|EasyLang}}==
 
<syntaxhighlight lang=easylang>
global list[] rlist[][] .
proc permlist k . .
if k >= len list[]
for i to len list[]
if i = list[i]
return
.
.
rlist[][] &= list[]
return
.
for i = k to len list[]
swap list[i] list[k]
permlist k + 1
swap list[k] list[i]
.
.
#
proc derang n . r[][] .
rlist[][] = [ ]
list[] = [ ]
for i to n
list[] &= i
.
permlist 1
r[][] = rlist[][]
.
r[][] = [ ]
derang 4 r[][]
print r[][]
#
func subfac n .
if n < 2
return 1 - n
.
return (subfac (n - 1) + subfac (n - 2)) * (n - 1)
.
#
print "counted / calculated"
for n = 0 to 9
derang n r[][]
print n & ": " & len r[][] & " " & subfac n
.
</syntaxhighlight>
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
(lib 'list) ;; in-permutations
(lib 'bigint)
Line 715 ⟶ 1,584:
(remember '!n #(1 0))
 
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(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))
Line 738 ⟶ 1,607:
(!n 20)
→ 895014631192902121
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="elixir">defmodule Permutation do
def derangements(n) do
list = Enum.to_list(1..n)
Line 770 ⟶ 1,639:
Enum.each(10..20, fn n ->
:io.format "~2w :~19w~n", [n, Permutation.subfact(n)]
end)</langsyntaxhighlight>
 
{{out}}
Line 809 ⟶ 1,678:
20 : 895014631192902121
</pre>
 
=={{header|F_Sharp|F#}}==
===The Function===
<syntaxhighlight lang="fsharp">
// Generate derangements. Nigel Galloway: July 9th., 2019
let derange n=
let fG n i g=let e=Array.copy n in e.[i]<-n.[g]; e.[g]<-n.[i]; e
let rec derange n g α=seq{
match (α>0,n&&&(1<<<α)=0) with
(true,true)->for i in [0..α-1] do if n&&&(1<<<i)=0 then let g=(fG g α i) in yield! derange (n+(1<<<i)) g (α-1); yield! derange n g (α-1)
|(true,false)->yield! derange n g (α-1)
|(false,false)->yield g
|_->()}
derange 0 [|1..n|] (n-1)
</syntaxhighlight>
===The Task===
<syntaxhighlight lang="fsharp">
derange 4 |> Seq.iter(printfn "%A")
</syntaxhighlight>
{{out}}
<pre>
[|4; 3; 2; 1|]
[|2; 3; 4; 1|]
[|3; 4; 2; 1|]
[|3; 4; 1; 2|]
[|4; 3; 1; 2|]
[|3; 1; 4; 2|]
[|2; 1; 4; 3|]
[|2; 4; 1; 3|]
[|4; 1; 2; 3|]
</pre>
<syntaxhighlight lang="fsharp">
let subFact n=let rec fN n g=match n with 0m->int64(round(g/2.7182818284590452353602874713526624978m))|_->fN (n-1m) (g*n) in if n=0 then 1L else fN (decimal n) 1m
[1..9] |> Seq.iter(fun n->printfn "items=%d !n=%d derangements=%d" n (subFact n) (derange n|>Seq.length))
</syntaxhighlight>
{{out}}
<pre>
items=1 !n=0 derangements=0
items=2 !n=1 derangements=1
items=3 !n=2 derangements=2
items=4 !n=9 derangements=9
items=5 !n=44 derangements=44
items=6 !n=265 derangements=265
items=7 !n=1854 derangements=1854
items=8 !n=14833 derangements=14833
items=9 !n=133496 derangements=133496
</pre>
 
=={{header|Factor}}==
{{works with|Factor|0.98}}
<syntaxhighlight lang="factor">USING: combinators formatting io kernel math math.combinatorics
prettyprint sequences ;
IN: rosetta-code.derangements
 
: !n ( n -- m )
{
{ 0 [ 1 ] }
{ 1 [ 0 ] }
[ [ 1 - !n ] [ 2 - !n + ] [ 1 - * ] tri ]
} case ;
 
: derangements ( n -- seq )
<iota> dup [ [ = ] 2map [ f = ] all? ] with
filter-permutations ;
 
"4 derangements" print 4 derangements . nl
"n count calc\n= ====== ======" print
10 <iota> [
dup [ derangements length ] [ !n ] bi
"%d%8d%8d\n" printf
] each nl
"!20 = " write 20 !n .</syntaxhighlight>
{{out}}
<pre>
4 derangements
V{
{ 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 }
}
 
n count 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
</pre>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">' version 08-04-2017
' compile with: fbc -s console
 
Sub Subfactorial(a() As ULongInt)
 
Dim As ULong i
Dim As ULongInt num
 
For i = 0 To UBound(a)
num = num * i
If (i And 1) = 1 Then
num -= 1
Else
num += 1
End If
a(i) = num
Next
 
End Sub
 
' Heap's algorithm non-recursive
Function perms_derange(n As ULong, flag As Long = 0) As ULongInt
' fast upto n < 12
If n = 0 Then Return 1
 
Dim As ULong i, j, c1, count
Dim As ULong a(0 To n -1), c(0 To n -1)
 
For j = 0 To n -1
a(j) = j
Next
 
While i < n
If c(i) < i Then
If (i And 1) = 0 Then
Swap a(0), a(i)
Else
Swap a(c(i)), a(i)
End If
For j = 0 To n -1
If a(j) = j Then j = 99
Next
If j < 99 Then
count += 1
If flag = 0 Then
c1 += 1
For j = 0 To n -1
Print a(j);
Next
If c1 > 12 Then
Print : c1 = 0
Else
Print " ";
End If
End If
End If
c(i) += 1
i = 0
Else
c(i) = 0
i += 1
End If
Wend
If flag = 0 AndAlso c1 <> 0 Then Print
Return count
 
End Function
 
' ------=< MAIN >=------
 
Dim As ULong i, n = 4
Dim As ULongInt subfac(20)
 
Subfactorial(subfac())
 
Print "permutations derangements for n = "; n
i = perms_derange(n)
Print "count returned = "; i; " , !"; n; " calculated = "; subfac(n)
 
Print
Print "count counted subfactorial"
Print "---------------------------"
For i = 0 To 9
Print Using " ###: ######## ########"; i; perms_derange(i, 1); subfac(i)
Next
For i = 10 To 20
Print Using " ###: ###################"; i; subfac(i)
Next
 
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>permutations derangements for n = 4
1302 3012 1032 2031 2301 3201 3210 2310 1230
count returned = 9 , !4 calculated = 9
 
count counted 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
10: 1334961
11: 14684570
12: 176214841
13: 2290792932
14: 32071101049
15: 481066515734
16: 7697064251745
17: 130850092279664
18: 2355301661033953
19: 44750731559645106
20: 895014631192902121</pre>
 
=={{header|GAP}}==
<langsyntaxhighlight lang="gap"># 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 ],
Line 845 ⟶ 1,940:
# [ 7, 1854, 1854, 1854 ],
# [ 8, 14833, 14833, 14833 ],
# [ 9, 133496, 133496, 133496 ] ]</langsyntaxhighlight>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 917 ⟶ 2,013:
// stretch (sic)
fmt.Println("\n!20 =", subFact(20))
}</langsyntaxhighlight>
{{out}}
<pre>
Line 949 ⟶ 2,045:
=={{header|Groovy}}==
Solution:
<langsyntaxhighlight lang="groovy">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))) }
Line 957 ⟶ 2,053:
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p }
d
}</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="groovy">def d = derangement([1,2,3,4])
assert d.size() == subfact(4)
d.each { println it }
Line 975 ⟶ 2,071:
println """
!20 == ${subfact(20)}
"""</langsyntaxhighlight>
 
{{out}}
Line 1,005 ⟶ 2,101:
=={{header|Haskell}}==
 
<langsyntaxhighlight Haskelllang="haskell">import Control.Monad (forM_)
 
import Data.List (permutations)
Line 1,037 ⟶ 2,133:
putStrLn ""
-- Print the number of derangements in a list of 20 items
print $ subfactorial 20</langsyntaxhighlight>
{{Out}}
<pre>[[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]]
Line 1,055 ⟶ 2,151:
Alternatively, this is a backtracking method:
 
<langsyntaxhighlight lang="haskell">derangements xs = loop xs xs
where loop [] [] = [[]]
loop (h:hs) xs = [x:ys | x <- xs, x /= h, ys <- loop hs (delete x xs)]</langsyntaxhighlight>
 
Since the value <i>i</I> cannot occur in position <i>i</i>, we prefix <i>i</i> on all other derangements from 1 to <i>n</i> that do not include <i>i</i>. The first method of filtering permutations is significantly faster, in practice, however.
Line 1,064 ⟶ 2,160:
Note: <code>!n</code> in J denotes factorial (or gamma n+1), and not subfactorial.
 
<langsyntaxhighlight lang="j">derangement=: (A.&i.~ !)~ (*/ .~: # [) i. NB. task item 1
subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</langsyntaxhighlight>
 
Requested examples:
 
<langsyntaxhighlight lang="j"> derangement 4 NB. task item 2
1 0 3 2
1 2 3 0
Line 1,093 ⟶ 2,189:
8.95015e17
subfactorial 20x NB. using extended precision
895014631192902121</langsyntaxhighlight>
 
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).
Line 1,099 ⟶ 2,195:
=={{header|Java}}==
{{trans|D}}
<langsyntaxhighlight lang="java">import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
Line 1,193 ⟶ 2,289:
return r;
}
}</langsyntaxhighlight>
 
<pre>derangements for n = 4
Line 1,225 ⟶ 2,321:
{{works with|jq|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.
<langsyntaxhighlight lang="jq">def derangements:
 
# In order to reference the original array conveniently, define _derangements(ary):
Line 1,248 ⟶ 2,344:
 
# Avoid creating an array just to count the items in a stream:
def count(g): reduce g as $i (0; . + 1);</langsyntaxhighlight>
'''Tasks''':
<langsyntaxhighlight lang="jq"> "Derangements:",
([range(1;5)] | derangements),
"",
Line 1,256 ⟶ 2,352:
(range(1;10) as $i | "\($i): \(count( [range(0;$i)] | derangements)) vs \($i|subfact)"),
"",
"Computed approximation to !20 (15 significant digits): \(20|subfact)"</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight lang="sh">$ jq -n -c -r -f derangements.jq
jq -n -c -r -f derangements.jq
 
Line 1,283 ⟶ 2,379:
9: 133496 vs 133496
 
Computed approximation to !20 (15 significant digits): 895014631192902000</langsyntaxhighlight>
 
=={{header|Julia}}==
<syntaxhighlight lang="julia">using Printf, Combinatorics
 
derangements(n::Int) = (perm for perm in permutations(1:n)
if all(indx != p for (indx, p) in enumerate(perm)))
 
function subfact(n::Integer)::Integer
if n in (0, 2)
return 1
elseif n == 1
return 0
elseif 1 ≤ n ≤ 18
return round(Int, factorial(n) / e)
elseif n > 0
return (n - 1) * ( subfact(n - 1) + subfact(n - 2) )
else
error()
end
end
 
println("Derangements of [1, 2, 3, 4]")
for perm in derangements(4)
println(perm)
end
 
@printf("\n%5s%13s%13s\n", "n", "derangements", "!n")
for n in 1:10
ders = derangements(n)
subf = subfact(n)
@printf("%5i%13i%13i\n", n, length(collect(ders)), subf)
end
 
println("\n!20 = ", subfact(20))</syntaxhighlight>
 
{{out}}
<pre>Derangements of [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]
 
n derangements !n
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 1334961
 
!20 = 895014631192902121</pre>
 
=={{header|Kotlin}}==
<syntaxhighlight lang ="scala">// version 1.1.12
 
fun <T> permute(input: List<T>): List<List<T>> {
Line 1,330 ⟶ 2,487:
}
println("\n!20 = ${subFactorial(20)}")
}</langsyntaxhighlight>
 
{{out}}
Line 1,363 ⟶ 2,520:
 
=={{header|Lua}}==
<langsyntaxhighlight Lualang="lua">-- Return an iterator to produce every permutation of list
function permute (list)
local function perm (list, n)
Line 1,431 ⟶ 2,588:
print("\t| " .. #derangements(listOneTo(i)))
end
print("\n\nThe subfactorial of 20 is " .. subFact(20))</langsyntaxhighlight>
{{out}}
<pre>Derangements of [1,2,3,4]
Line 1,463 ⟶ 2,620:
The subfactorial of 20 is 8.950146311929e+17</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
<lang Mathematica>
Needs["Combinatorica`"]
derangements[n_] := Derangements[Range[n]]
derangements[4]
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm
Subfactorial[20]</langsyntaxhighlight>
{{out}}
<pre>
Line 1,486 ⟶ 2,643:
 
895014631192902121</pre>
 
=={{header|Nim}}==
<syntaxhighlight lang="nim">import algorithm, sequtils, strformat, strutils, tables
 
iterator derangements[T](a: openArray[T]): seq[T] =
var perm = @a
while true:
if not perm.nextPermutation():
break
block checkDerangement:
for i, val in a:
if perm[i] == val: break checkDerangement
yield perm
 
proc `!`(n: Natural): Natural =
if n <= 1: return 1 - n
result = (n - 1) * (!(n - 1) + !(n - 2))
 
echo "Derangements of 1 2 3 4:"
for d in [1, 2, 3, 4].derangements():
echo d.join(" ")
 
echo "\nNumber of derangements:"
echo "n counted calculated"
echo "- ------- ----------"
for n in 0..9:
echo &"{n} {toSeq(derangements(toSeq(1..n))).len:>6} {!n:>6}"
 
echo "\n!20 = ", !20</syntaxhighlight>
 
{{out}}
<pre>Derangements of 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
 
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</pre>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">derangements(n)=if(n,round(n!/exp(1)),1);
derange(n)={
my(v=[[]],tmp);
Line 1,506 ⟶ 2,720:
derange(4)
for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n)))
derangements(20)</langsyntaxhighlight>
{{out}}
<pre>%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]]
Line 1,522 ⟶ 2,736:
 
%2 = 895014631192902121</pre>
 
=={{header|Pascal}}==
<syntaxhighlight lang="pascal">
program Derangements_RC;
(*
Pascal solution for Rosetta Code task "Permutations/Derangements"
Console program written in Free Pascal (Lazarus)
*)
// Returns first derangement in lexicographic order.
// Function return is false if there are no derangements.
function FirstDerangement( var val : array of integer) : boolean;
var
n, j : integer;
begin
n := Length( val);
result := (n <> 1);
if n < 2 then exit;
if Odd(n) then begin
val[n - 3] := n - 2;
val[n - 2] := n - 1;
val[n - 1] := n - 3;
dec( n, 3);
end;
j := 0;
while (j < n) do begin
val[j] := j + 1;
val[j + 1] := j;
inc( j, 2);
end;
end;
 
// Returns next derangement in lexicographic order.
// Function return is false if there are no more derangements.
// Finds next derangement directly, i.e. not by generating
// permutations until a derangement is found.
function NextDerangement( var val : array of integer) : boolean;
var
i, j, n : integer;
backward, done : boolean;
free : array of boolean;
begin
n := Length( val);
if (n < 3) then begin
result := false;
exit;
end;
SetLength( free, n);
for j := 0 to n - 1 do free[j] := false;
i := n - 1;
free[val[i]] := true;
backward := true;
done := false;
repeat
if backward then begin
dec(i); j := val[i]; free[j] := true;
end
else begin
inc(i); j := -1;
end;
repeat
inc(j)
until (j >= n) or (free[j] and (j <> i));
if (j < n) then begin // found a suitable free value
val[i] := j; free[j] := false;
if (i = n - 1) then done := true // found the next derangement
else backward := false;
end
else if (i = 0) then done := true // no more derangements
else backward := true;
until done;
result := (i > 0);
end;
 
// Finds all derangements of integers 0..(n - 1) and
// returns the number of derangements.
// if boolean "show" is true, writes derangments to standard output.
function FindDerangements( n : integer;
show : boolean) : integer;
var
int_array : array of integer;
j : integer;
ok : boolean;
begin
result := 0;
if (n < 0) then exit;
SetLength( int_array, n);
ok := FirstDerangement( int_array);
while ok do begin
inc( result);
if show then begin
for j := 0 to n - 1 do Write( ' ', int_array[j]);
WriteLn();
end;
ok := NextDerangement( int_array);
end;
end;
 
// Returns subfactorial of passed-in integer.
function Subfactorial( n : integer) : uint64;
var
j : integer;
begin
result := 1;
for j := 1 to n do begin
result := result*j;
if Odd(j) then dec(result) else inc(result);
end;
end;
 
// Main routine for Rosetta Code task.
var
n, nrFound, nrCalc : integer;
begin
WriteLn( 'Derangements of 4 integers');
nrFound := FindDerangements( 4, true);
WriteLn( 'Number of derangements found = ', nrFound);
WriteLn();
WriteLn( 'Number of derangements');
WriteLn( ' n Found Subfactorial');
for n := 0 to 9 do begin
nrFound := FindDerangements( n, false);
nrCalc := Subfactorial( n);
WriteLn( n:3, nrFound:8, nrCalc:8);
end;
WriteLn();
WriteLn( 'Subfactorial(20) = ', Subfactorial(20));
end.
</syntaxhighlight>
{{out}}
<pre>
Derangements of 4 integers
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
Number of derangements found = 9
 
Number of derangements
n Found 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
 
Subfactorial(20) = 895014631192902121
</pre>
 
=={{header|Perl}}==
===Traditional verbose version===
<lang Perl>sub d {
<syntaxhighlight lang="perl">sub d {
# compare this with the deranged() sub to see how to turn procedural
# code into functional one ('functional' as not in 'understandable')
Line 1,589 ⟶ 2,961:
 
print "\nNumber of derangements:\n";
print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</langsyntaxhighlight>
 
{{out}}
Line 1,637 ⟶ 3,009:
20: 895014631192902121</pre>
 
===Using a module===
=={{header|Perl 6}}==
{{libheader|ntheory}}
<syntaxhighlight lang="perl">use ntheory ":all";
 
# Count derangements using derangement iterator
{{trans|Perl}}
sub countderange {
{{works with|Rakudo|2016.10}}
my($n,$s) = (shift,0);
<lang perl6>
forderange { $s++ } $n;
sub is-derangement(List $l) {
$s;
return not grep { $l[$_] == $_ }, 0..($l.elems - 1);
}
# Count derangements using inclusion-exclusion
 
sub subfactorial1 {
# task 1
my $n = shift;
sub derangements(Range $x) {
vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n);
$x.permutations.grep( *.&is-derangement )
}
# Count derangements using simple recursion without special functions
 
sub subfactorial2 {
# task 2
my $n = shift;
.say for (0..4).&derangements;
use bigint; no warnings 'recursion';
 
($n < 1) ? 1 : $n * subfactorial2($n-1) + (-1)**$n;
# task 3
sub prefix:<!>(Int $x) {
return +derangements(^$x);
}
 
print "Derangements of 4 items:\n";
# task 4
forderange { print "@_\n" } 4;
for ^9 -> $n {
printf "\n%3s %15s %15s\n","N","List count","!N";
say "number: " ~ $n;
printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9;
say "count: " ~ !$n;
printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;</syntaxhighlight>
say "derangements: ";
{{out}}
.say for (0..$n-1).&derangements;
<pre>
}
Derangements of 4 items:
</lang>
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
 
N List count !N (binomial) !N (recursion)
=={{header|Phix}}==
0 1 1 1
<lang Phix>function deranged(sequence s1, sequence s2)
1 0 0 0
for i=1 to length(s1) do
2 1 1 1
if s1[i]==s2[i] then return 0 end if
3 2 2 2
end for
4 9 9 9
return 1
5 44 44 44
end function
6 265 265 265
7 1854 1854 1854
8 14833 14833 14833
9 133496 133496 133496
20 895014631192902121
200 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
</pre>
 
=={{header|Phix}}==
function derangements(integer n)
{{libheader|Phix/mpfr}}
sequence ts = tagset(n)
<!--<syntaxhighlight lang="phix">(phixonline)-->
sequence res = {}
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
for i=1 to factorial(n) do
<span style="color: #008080;">function</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">s2</span><span style="color: #0000FF;">)</span>
sequence s = permute(i,ts)
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if deranged(s,ts) then
<span style="color: #008080;">if</span> <span style="color: #000000;">s1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]==</span><span style="color: #000000;">s2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
res = append(res,s)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end if
<span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
return res
end function
<span style="color: #008080;">function</span> <span style="color: #000000;">derangements</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
 
<span style="color: #004080;">sequence</span> <span style="color: #000000;">ts</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
function subfactorial(integer n)
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
if n<=0 then return 1 end if
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if n=1 then return 0 end if
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ts</span><span style="color: #0000FF;">)</span>
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
<span style="color: #008080;">if</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ts</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
end function
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
?derangements(4)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
for n=0 to 9 do
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
printf(1,"%d: counted:%d, calculated:%d\n",{n,length(derangements(n)),subfactorial(n)})
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
end for
printf(1,"!20=%d (incorrect!)\n",{subfactorial(20)})
<span style="color: #008080;">function</span> <span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
include builtins\bigatom.e
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">n</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
function ba_subfactorial(integer n)
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*(</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))</span>
if n<=0 then return 1 end if
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
if n=1 then return 0 end if
return ba_multiply(n-1,ba_add(ba_subfactorial(n-1),ba_subfactorial(n-2)))
<span style="color: #0000FF;">?</span><span style="color: #000000;">derangements</span><span style="color: #0000FF;">(</span><span style="color: #000000;">4</span><span style="color: #0000FF;">)</span>
end function
<span style="color: #008080;">for</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">to</span> <span style="color: #000000;">9</span> <span style="color: #008080;">do</span>
ba_printf(1,"!20=%B (bigatom)\n",ba_subfactorial(20))</lang>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d: counted:%d, calculated:%d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">derangements</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)),</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">msg</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">machine_bits</span><span style="color: #0000FF;">()=</span><span style="color: #000000;">32</span><span style="color: #0000FF;">?</span><span style="color: #008000;">" (incorrect on 32-bit!)"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">""</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (fine on 64-bit)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"!20=%d%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">),</span><span style="color: #000000;">msg</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">include</span> <span style="color: #004080;">mpfr</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">mpz_sub_factorial</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- probably not the most efficient way to do this!</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">n</span><span style="color: #0000FF;">})</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">mpz</span> <span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_init</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mpz_sub_factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)),</span>
<span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_init</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mpz_sub_factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">))</span>
<span style="color: #7060A8;">mpz_add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">g</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">mpz_mul_si</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_get_str</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">g</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_free</span><span style="color: #0000FF;">({</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">g</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"!20=%s (mpfr)\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">mpz_sub_factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">)})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,719 ⟶ 3,126:
8: counted:14833, calculated:14833
9: counted:133496, calculated:133496
!20=895014631192902186 (incorrect on 32-bit!)
!20=895014631192902121 (bigatommpfr)
</pre>
<small>(under pwa/p2js you get a trailing "000" instead of "186" for the incorrect result)</small>
{{trans|FreeBASIC}}
A more efficient method of calculating subfactorials (0 should be handled separately, or obviously prepend a 1 and extract with idx+1).<br>
Should you instead of string results want an array of mpz for further calculations, use the mpz_init_set() call as shown:
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">include</span> <span style="color: #004080;">mpfr</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">mpz</span> <span style="color: #000000;">num</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_init</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">mpz_mul_si</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">mpz_odd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">mpz_sub_ui</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #7060A8;">mpz_add_ui</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_get_str</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- res[i] = mpz_init_set(num)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">extract</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">)&</span><span style="color: #000000;">20</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>{"0","1","2","9","44","265","1854","14833","133496","895014631192902121"}</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">import util.
 
go =>
foreach(N in 0..9)
println([N,num_derangements=num_derangements(N), subfactorial=subfactorial(N), subfactorial2=subfactorial2(N)])
end,
println(["!20", subfactorial(20)]),
println(["!20 approx", subfactorial2(20)]),
println("subfactorial0..30"=[subfactorial(N) : N in 0..30 ]),
println("subfactorial2_0..30"=[subfactorial2(N) : N in 0..30 ]),
println(["!200", subfactorial(200)]),
nl,
println("Syntax sugar:"),
println("'!'(20)"='!'(20)),
println("200.'!'()"=200.'!'()),
println("'!!'(20)"='!!'(20)),
println("'!-!!'(10)"='!-!!'(10)),
nl.
 
num_derangements(N) = derangements(N).length.
 
derangements(N) = D =>
D = [P : P in permutations(1..N), nofixpoint(P)].
 
% subfactorial: tabled recursive function
table
subfactorial(0) = 1.
subfactorial(1) = 0.
subfactorial(N) = (N-1)*(subfactorial(N-1)+subfactorial(N-2)).
 
% approximate version of subfactorial
subfactorial2(0) = 1.
subfactorial2(N) = floor(1.0*floor(factorial(N)/2.71828 + 1/2.0)).
 
% Factorial
fact(N) = F =>
F1 = 1,
foreach(I in 1..N)
F1 := F1 * I
end,
F = F1.
 
% No fixpoint in L
nofixpoint(L) =>
foreach(I in 1..L.length)
L[I] != I
end.
 
% Some syntax sugar. Note: the function must be an atom.
'!'(N) = fact(N).
'!!'(N) = subfactorial(N).
 
'!-!!'(N) = fact(N) - subfactorial(N).</syntaxhighlight>
 
{{out}}
<pre>[0,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[1,num_derangements = 0,subfactorial = 0,subfactorial2 = 0]
[2,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[3,num_derangements = 2,subfactorial = 2,subfactorial2 = 2]
[4,num_derangements = 9,subfactorial = 9,subfactorial2 = 9]
[5,num_derangements = 44,subfactorial = 44,subfactorial2 = 44]
[6,num_derangements = 265,subfactorial = 265,subfactorial2 = 265]
[7,num_derangements = 1854,subfactorial = 1854,subfactorial2 = 1854]
[8,num_derangements = 14833,subfactorial = 14833,subfactorial2 = 14833]
[9,num_derangements = 133496,subfactorial = 133496,subfactorial2 = 133496]
[!20,895014631192902121]
[!20 approx,895015233227128960]
subfactorial0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334961,14684570,176214841,2290792932,32071101049,481066515734,7697064251745,130850092279664,2355301661033953,44750731559645106,895014631192902121,18795307255050944540,413496759611120779881,9510425471055777937262,228250211305338670494289,5706255282633466762357224,148362637348470135821287825,4005791208408693667174771274,112162153835443422680893595673,3252702461227859257745914274516,97581073836835777732377428235481]
subfactorial2_0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334962,14684580,176214959,2290794473,32071122622,481066839325,7697069429198,130850180296364,2355303245334550,44750761661356448,895015233227128960,18795319897769705472,413497037750933585920,9510431868271472934912,228250364838515316883456,5706259120962883593175040,148362737145034969127583744,4005793902915943736948031488,112162229281646435629661159424,3252704649167746668444545712128,97581139475032389920237209780224]
[!200,290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201]
 
Syntax sugar:
'!'(20) = 2432902008176640000
200.'!'() = 788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000
'!!'(20) = 895014631192902121
'!-!!'(10) = 2293839</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l") # For 'permute'
 
(de derangements (Lst)
Line 1,736 ⟶ 3,250:
(*
(dec N)
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</langsyntaxhighlight>
{{out}}
<pre>: (derangements (range 1 4))
Line 1,762 ⟶ 3,276:
 
=={{header|PureBasic}}==
Brute Force
{{incomplete|PureBasic|Missing the subfactorial !n.}}
<syntaxhighlight lang="purebasic">
Brute Force: Tested up to n=10
Procedure.q Subfactoral(n)
<lang PureBasic>
If n=0:ProcedureReturn 1:EndIf
 
If n=1:ProcedureReturn 0:EndIf
Procedure.q perm(n)
if n=0:ProcedureReturn (Subfactoral(n-1)+Subfactoral(n-2))*(n-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"
Line 1,778 ⟶ 3,290:
DeleteFile(tempFile.s)
DeleteFile(drngFile.s)
 
n=4
 
; create our storage file
f.s=factFile.s
If CreateFile(21130,f.s)
WriteStringN(21130,"1.2")
WriteStringN(21130,"2.1")
CloseFile(21130)
Else
Debug "not createfile :"+f.s
EndIf
 
showfactorial=#FALSEFalse
 
ifIf showfactorial
; cw("nfactorial n ="+str(n))
Debug "nfactorial n ="+strStr(n)
EndIf
endif
 
; build up the factorial combinations
forFor l=1 toTo n-2
gosubGosub nfactorial
Next
next
 
; extract the derangements
; cw("derangements["+str(perm(n))+"] for n="+str(n))
Debug "derangements["+strStr(permSubfactoral(n))+"] for n="+strStr(n)
gosubGosub derangements
; cw("")
Debug ""
 
; show the first 20 derangements
forFor i=0 toTo 20
;Debug cw("derangements["+strStr(permSubfactoral(i))+"] for n="+strStr(i))
Next
Debug "derangements["+str(perm(i))+"] for n="+str(i)
next
End
end
 
derangements:
x=0
If ReadFile(21120,factFile.s) andAnd CreateFile(21131,drngFile.s)
Repeat
repeat
r.s = ReadString(21120)
cs=CountString(r.s,".")
ifIf cs
hit=0
t.s=""
; scan for numbers at their index
forFor i=1 toTo cs+1
s.s=StringField(r.s,i,".")
t.s+s.s+"."
ifIf valVal(s.s)=i:hit+1:endifEndIf
Next
next
t.s=rtrimRTrim(t.s,".")
; show only those which are valid
ifIf notNot hit
x+1
; cw(t.s+" "+str(x))
Debug t.s+" "+strStr(x)
WriteStringN(21131,t.s+" "+strStr(x))
EndIf
endif
EndIf
endif
Until Eof(0)
until eof(2112)
CloseFile(21120)
CloseFile(21131)
Else
Debug "not readfile :"+factFile.s
Line 1,850 ⟶ 3,362:
; cw("")
Debug ""
Return
return
 
nfactorial:
x=0
If ReadFile(21120,factFile.s) andAnd CreateFile(21131,tempFile.s)
Repeat
repeat
r.s = ReadString(21120)
cs=CountString(r.s,".")
ifIf cs
forFor j=1 toTo cs+2
t.s=""
forFor i=1 toTo cs+1
s.s=StringField(r.s,i,".")
ifIf i=j
t.s+"."+strStr(cs+2)+"."+s.s
Else
else
t.s+"."+s.s
EndIf
endif
Next
next
ifIf j=cs+2:t.s+"."+strStr(cs+2):endifEndIf
t.s=trimTrim(t.s,".")
x+1
ifIf cs+2=n andAnd showfactorial
; cw(t.s+" "+str(x))
Debug t.s+" "+strStr(x)
EndIf
endif
WriteStringN(21131,t.s)
Next
next
EndIf
endif
Until Eof(0)
until eof(2112)
CloseFile(21120)
CloseFile(21131)
Else
Debug "not readfile :"+factFile.s
Line 1,888 ⟶ 3,400:
CopyFile(tempFile.s,factFile.s)
DeleteFile(tempFile.s)
Return
return
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,928 ⟶ 3,440:
 
{{trans|C}}
<langsyntaxhighlight PureBasiclang="purebasic">Procedure.i deranged(depth, lenn, Array d(1), show)
Protected count, tmp, i
If depth = lenn
Line 1,978 ⟶ 3,490:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
 
{{out}}
Line 2,019 ⟶ 3,531:
=={{header|Python}}==
Includes stretch goal.
<langsyntaxhighlight lang="python">from itertools import permutations
import math
 
Line 2,059 ⟶ 3,571:
 
n = 20
print("\n!%i = %i" % (n, subfact(n)))</langsyntaxhighlight>
 
{{out}}
Line 2,086 ⟶ 3,598:
 
!20 = 895014631192902121</pre>
 
=={{header|QBasic}}==
{{works with|QBasic|1.1}}
{{trans|FreeBASIC}}
Error "Subscript out of scope" for n > 7
<syntaxhighlight lang="qbasic">' Heap's algorithm non-recursive
FUNCTION permsderange (n!, flag!)
IF n = 0 THEN permsderange = 1
DIM a!(0 TO n), c!(0 TO n)
FOR j = 0 TO n - 1: a(j) = j: NEXT j
WHILE i < n
IF c(i) < i THEN
IF (i AND 1) = 0 THEN
SWAP a(0), a(i)
ELSE
SWAP a(c(i)), a(i)
END IF
FOR j = 0 TO n - 1
IF a(j) = j THEN j = 99
NEXT j
IF j < 99 THEN
count = count + 1
IF flag = 0 THEN
c1 = c1 + 1
FOR j = 0 TO n - 1
PRINT a(j);
NEXT j
IF c1 > 12 THEN
PRINT : c1 = 0
ELSE
PRINT
END IF
END IF
END IF
c(i) = c(i) + 1
i = 0
ELSE
c(i) = 0
i = i + 1
END IF
WEND
IF flag = 0 AND c1 <> 0 THEN PRINT
permsderange = count
END FUNCTION
 
SUB Subfactorial (a!())
FOR i = 0 TO UBOUND(a)
num = num * i
IF (i AND 1) = 1 THEN
num = num - 1
ELSE
num = num + 1
END IF
a(i) = num
NEXT i
END SUB
 
n! = 4
DIM subfac!(7)
 
CALL Subfactorial(subfac())
 
PRINT "permutations derangements for n = "; n
i! = permsderange(n, 0)
PRINT "count returned ="; i; " , !"; n; " calculated ="; subfac(n)
 
PRINT
PRINT "count counted subfactorial"
PRINT "---------------------------"
FOR i = 0 TO 7
PRINT USING " ###: ######## ########"; i; permsderange(i, 1); subfac(i)
NEXT i</syntaxhighlight>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="quackery">
[ stack ] is deranges.num ( --> [ )
 
forward is (deranges)
[ over size
deranges.num share = iff
[ over temp take
swap nested join
temp put ]
else
[ dup size times
[ 2dup i^ pluck
dip [ over size ]
tuck != iff
[ rot swap
nested join
swap (deranges) ]
else
[ drop 2drop ] ] ]
2drop ] resolves (deranges) ( [ [ --> )
 
[ dup deranges.num put
[] swap times [ i^ join ]
[] temp put
[] swap (deranges)
temp take
deranges.num release ] is derangements ( n --> [ )
 
[ dup 0 = iff [ drop 1 ] done
1 0 rot
1 - times
[ swap over + i^ 1+ * ]
nip ] is sub! ( n --> n )
 
4 derangements witheach [ echo cr ]
cr
10 times
[ i^ echo sp
i^ derangements size echo sp
i^ sub! echo cr ]
cr
20 sub! echo</syntaxhighlight>
 
{{out}}
 
<pre>[ 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 ]
 
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
 
895014631192902121</pre>
 
=={{header|Racket}}==
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 2,136 ⟶ 3,793:
(sub-fact 20)
;; -> 895014631192902121
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
 
{{trans|Perl}}
{{works with|Rakudo|2016.10}}
 
 
Generate <code>List.permutations</code> and keep the ones where no elements are in their original position. This is done by zipping each permutation with the original list, and keeping the ones where none of the zipped pairs are equal.
 
I am using the <code>Z</code> infix zip operator with the <code>eqv</code> equivalence infix operator, all wrapped inside a <code>none()</code> Junction.
 
Although not necessary for this task, I have used <code>eqv</code> instead of <code>==</code> so that the <code>derangements()</code> function also works with any set of arbitrary objects (eg. strings, lists, etc.)
 
<syntaxhighlight lang="raku" line>sub derangements(@l) {
@l.permutations.grep(-> @p { none(@p Zeqv @l) })
}
 
sub prefix:<!>(Int $n) {
(1, 0, 1, -> $a, $b { ($++ + 2) × ($b + $a) } ... *)[$n]
}
 
say 'derangements([1, 2, 3, 4])';
say derangements([1, 2, 3, 4]), "\n";
 
say 'n == !n == derangements(^n).elems';
for 0 .. 9 -> $n {
say "!$n == { !$n } == { derangements(^$n).elems }"
}</syntaxhighlight>
{{out}}
<pre>
derangements([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))
 
n == !n == derangements(^n).elems
!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
</pre>
 
Much faster to just calculate the subfactorial.
<syntaxhighlight lang="raku" line>my @subfactorial = 1,0,{++$ × ($^a + $^b)}…*;
 
say "!$_: ",@subfactorial[$_] for |^10, 20, 200;</syntaxhighlight>
{{out}}
<pre>!0: 1
!1: 0
!2: 1
!3: 2
!4: 9
!5: 44
!6: 265
!7: 1854
!8: 14833
!9: 133496
!20: 895014631192902121
!200: 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201</pre>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX pgmprogram generates all permutations of N derangements & and subfactorial # */
numeric digits 1000 /*be able to handle biglarge subfacts.subfactorials*/
parse arg N .; if N=='' then| N=4="," then N=4 /*Not specified? Then use Assumethe default.*/
d=derangementsSet derangeSet(N) /*go &and build the derangements set. */
say d 'derangements for' N "items are:"
say
do i=1 for d /*showdisplay the derangements for N items.*/
say right('derangement', 22) right(i, length(d) ) '───►' $.i
end /*i*/
say /* [↓] count and calculate subfact !L. */
do L=0 to 92; d=derangementsSet derangeSet(L)
say L 'items: derangement count='right(d, 6)", !"L'='right( !s(L), 6)
end /*L*/
say
say right('!20=' , 4022) !s( 20)
say right('!100200=', 4022) !s(100200)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────!S subroutine───────────────────────*/
!s: _=1; do j=1 for arg(1); if j//2 then _=-1+ j*_ - 1; else _=1+j*_;end;return _ + 1
end /*j*/; return _
/*──────────────────────────────────DERANGEMENTSSET subroutine──────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
derangementsSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
derangeSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
if x==0 then return 1; if x==1 then return 0
if x==0 then return 1; if x==1 then return /*populate the first derangement.*/0
@.1=2; @.2=1; do i=3 to x; @.i=i; end /*populate 1st derangement.*/
parse value @.p @.x with @. do i=3 to x; @.pi=i; end /*i*/ call .buildD x /*swap & build " the rest of 'em.*/
parse value @.p @.x with @.x @.p; call .buildD x /*swap & /*build others.*/
do while .nextD(x,0); call .buildD x; end /*build others.*/
do while .nextD(x, 0); call .buildD x; end; return #
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=nmn-1 by -1 for nmn-1; 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
end /*j*/
 
if i==0 then return 0
do m=i+1 while @.m<@.i; end /*m*/ /* [↓] swap two do j=i+1 while @values.j<@.i; end*/
parse value @.jm @.i with @.i @.jm; return 1</syntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
return 1</lang>
{{out}}
<pre>
9 derangements for 4 items are:
Line 2,199 ⟶ 3,919:
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
</pre>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">def derangements(n)
ary = (1 .. n).to_a
ary.permutation.select do |perm|
Line 2,238 ⟶ 3,951:
(10..20).each do |n|
puts "#{n} : #{subfact(n)}"
end</langsyntaxhighlight>
 
{{out}}
Line 2,280 ⟶ 3,993:
=={{header|Scala}}==
{{trans|Ruby}}
<langsyntaxhighlight Scalalang="scala">def derangements(n: Int) =
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
 
Line 2,294 ⟶ 4,007:
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"))</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4
Line 2,331 ⟶ 4,044:
 
=={{header|SuperCollider}}==
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
d = { |array, n|
Routine {
Line 2,346 ⟶ 4,059:
x = f.(4);
x.all.do(_.postln); "";
)</langsyntaxhighlight>
 
Answers:
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
[ 3, 2, 1, 0 ]
[ 2, 3, 0, 1 ]
Line 2,359 ⟶ 4,072:
[ 2, 3, 1, 0 ]
[ 3, 0, 1, 2 ]
</syntaxhighlight>
</lang>
 
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
z = { |n|
case
Line 2,375 ⟶ 4,088:
"% % %\n".postf(i, p.(derangements.size), p.(subfactorial));
};
)</langsyntaxhighlight>
 
Answers:
 
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
n derangements subfactorial
0 1 1
Line 2,391 ⟶ 4,104:
8 14833 14833
9 133496 133496
</syntaxhighlight>
</lang>
 
=={{header|Tcl}}==
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5; # for arbitrary-precision integers
package require struct::list; # for permutation enumerator
 
Line 2,431 ⟶ 4,144:
}
return $s
}</langsyntaxhighlight>
Demonstrating with the display parts of the task:
<langsyntaxhighlight lang="tcl">foreach d [deranged1to 4] {
puts "derangement of 1..4: $d"
}
Line 2,443 ⟶ 4,156:
 
# Stretch goal
puts "\n!20 = [subfact 20]"</langsyntaxhighlight>
{{out}}
<pre>
Line 2,467 ⟶ 4,180:
!8 14833 14833
!9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
{{libheader|Wren-big}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
import "./big" for BigInt
 
var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
var perms = []
var toInsert = input[0]
for (perm in permute.call(input[1..-1])) {
for (i in 0..perm.count) {
var newPerm = perm.toList
newPerm.insert(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
 
var derange = Fn.new { |input|
if (input.isEmpty) return [input]
var perms = permute.call(input)
var derangements = []
for (perm in perms) {
var deranged = true
for (i in 0...perm.count) {
if (perm[i] == i) {
deranged = false
break
}
}
if (deranged) derangements.add(perm)
}
return derangements
}
 
var subFactorial // recursive
subFactorial = Fn.new { |n|
if (n == 0) return BigInt.one
if (n == 1) return BigInt.zero
return (subFactorial.call(n-1) + subFactorial.call(n-2)) * (n - 1)
}
 
var input = [0, 1, 2, 3]
var derangements = derange.call(input)
System.print("There are %(derangements.count) derangements of %(input), namely:\n")
System.print(derangements.join("\n"))
 
System.print("\nN Counted Calculated")
System.print("- ------- ----------")
for (n in 0..9) {
var list = List.filled(n, 0)
for (i in 0...n) list[i] = i
var counted = derange.call(list).count
Fmt.print("$d $-9d $-9i", n, counted, subFactorial.call(n))
}
System.print("\n!20 = %(subFactorial.call(20))")</syntaxhighlight>
 
{{out}}
<pre>
There are 9 derangements of [0, 1, 2, 3], namely:
 
[1, 2, 3, 0]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[1, 0, 3, 2]
[1, 3, 0, 2]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]
 
N 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
Line 2,473 ⟶ 4,277:
=={{header|zkl}}==
{{trans|Python}} mostly
<langsyntaxhighlight lang="zkl">fcn subFact(n){
if(n==0) return(1);
if(n==1) return(0);
Line 2,491 ⟶ 4,295:
sum + (perm.zipWith('==,enum).sum(0) == 0)
},0);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">println("Derangements of 0,1,2,3:\n",derangements(4));
println("\nTable of n vs counted vs calculated derangements:");
foreach n in (10){
Line 2,498 ⟶ 4,302:
}
 
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));</langsyntaxhighlight>
{{out}}
<pre>
Line 2,520 ⟶ 4,324:
</pre>
Lazy/iterators version:
<langsyntaxhighlight lang="zkl">fcn derangements(n){ //-->Walker
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
Line 2,529 ⟶ 4,333:
fcn derangers(n){ // just count # of derangements, w/o saving them
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">foreach d in (derangements(4)){ println(d) }
//rest of test code remains the same</langsyntaxhighlight>
Thundergnat
10,333

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/180702...363736"