Permutations/Derangements: Difference between revisions
J: brute force implementation |
Thundergnat (talk | contribs) m →{{header|Raku}}: Add a version using subfactorials |
||
(161 intermediate revisions by 65 users not shown) | |||
Line 1: | Line 1: | ||
{{ |
{{task}} |
||
A [http://mathworld.wolfram.com/Derangement.html derangement] is a permutation of the order of distinct items in which ''no item appears in its original place''. |
A [http://mathworld.wolfram.com/Derangement.html 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). |
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 |
The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''. |
||
There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''. |
|||
;Task |
|||
;Task: |
|||
The task is to: |
|||
# Create a named function/method/subroutine/... to generate derangements of the integers ''0..n-1'', (or ''1..n'' if you prefer). |
# Create a named function/method/subroutine/... to generate derangements of the integers ''0..n-1'', (or ''1..n'' if you prefer). |
||
# Generate ''and show'' all the derangements of 4 integers using the above routine. |
# Generate ''and show'' all the derangements of 4 integers using the above routine. |
||
Line 13: | Line 15: | ||
# Print and show a table of the ''counted'' number of derangements of ''n'' vs. the calculated !''n'' for n from 0..9 inclusive. |
# Print and show a table of the ''counted'' number of derangements of ''n'' vs. the calculated !''n'' for n from 0..9 inclusive. |
||
As an optional stretch goal: |
|||
;Optional stretch goal: |
|||
* Calculate !''20''. |
|||
* Calculate <big><big> !''20'' </big></big> |
|||
;Related tasks: |
|||
* [[Anagrams/Deranged anagrams]] |
|||
* [[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}} |
|||
<syntaxhighlight lang="ada">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;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</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 |
|||
<syntaxhighlight lang="ahk">#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 |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|BBC BASIC}}== |
|||
{{works with|BBC BASIC for Windows}} |
|||
<syntaxhighlight lang="bbc basic"> 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))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
></pre> |
|||
=={{header|Bracmat}}== |
|||
The function <code>calculated-!n</code> has a local variable <code>mem</code> that memoizes already found counts. |
|||
This is done by actually updating the function's definition. |
|||
The output of the expression <code>lst$calculated-!n</code> demonstrates this. |
|||
The function <code>counted-!n</code> is also special: it is designed to always fail, forcing the match operation on the subject <code>!H</code> to assign each element in <code>!H</code> in turn to the sub-pattern <code>(%@?h:~!p)</code>, except the element that is equal to <code>!p</code>. |
|||
The derangements are built up in the last argument and accumulated in the global variable <code>D</code>. |
|||
Also the counter <code>count</code> is a global variable. |
|||
<syntaxhighlight lang="bracmat">( ( 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 |
|||
)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
) |
|||
);</pre> |
|||
=={{header|C}}== |
|||
<syntaxhighlight lang="c">#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; |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</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=== |
|||
<syntaxhighlight lang="d">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); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
===Recursive Version=== |
|||
Slightly slower but more compact recursive version of the derangements function, based on the [[Permutations#D|D entry]] of the permutations task. |
|||
Same output. |
|||
<syntaxhighlight lang="d">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); |
|||
}</syntaxhighlight> |
|||
=={{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}}== |
|||
<syntaxhighlight lang="scheme"> |
|||
(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)) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<syntaxhighlight 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)) |
|||
;; 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 |
|||
</syntaxhighlight> |
|||
=={{header|Elixir}}== |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="elixir">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)</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] |
|||
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 |
|||
</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}}== |
|||
<syntaxhighlight 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 ], |
|||
# [ 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 ] ]</syntaxhighlight> |
|||
=={{header|Go}}== |
|||
<syntaxhighlight lang="go">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)) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
=={{header|Groovy}}== |
|||
Solution: |
|||
<syntaxhighlight 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))) } |
|||
def derangement = { List l -> |
|||
def d = [] |
|||
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p } |
|||
d |
|||
}</syntaxhighlight> |
|||
Test: |
|||
<syntaxhighlight lang="groovy">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)} |
|||
"""</syntaxhighlight> |
|||
{{out}} |
|||
<pre>[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</pre> |
|||
=={{header|Haskell}}== |
|||
<syntaxhighlight lang="haskell">import Control.Monad (forM_) |
|||
import Data.List (permutations) |
|||
-- Compute all derangements of a list |
|||
derangements |
|||
:: Eq a |
|||
=> [a] -> [[a]] |
|||
derangements = (\x -> filter (and . zipWith (/=) x)) <*> permutations |
|||
-- Compute the number of derangements of n elements |
|||
subfactorial |
|||
:: (Eq a, Num a) |
|||
=> a -> a |
|||
subfactorial 0 = 1 |
|||
subfactorial 1 = 0 |
|||
subfactorial n = (n - 1) * (subfactorial (n - 1) + subfactorial (n - 2)) |
|||
main :: IO () |
|||
main |
|||
-- Generate and show all the derangements of four integers |
|||
= do |
|||
print $ derangements [1 .. 4] |
|||
putStrLn "" |
|||
-- Print the count of derangements vs subfactorial |
|||
forM_ [1 .. 9] $ |
|||
\i -> |
|||
putStrLn $ |
|||
mconcat |
|||
[show (length (derangements [1 .. i])), " ", show (subfactorial i)] |
|||
putStrLn "" |
|||
-- Print the number of derangements in a list of 20 items |
|||
print $ subfactorial 20</syntaxhighlight> |
|||
{{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]] |
|||
0 0 |
|||
1 1 |
|||
2 2 |
|||
9 9 |
|||
44 44 |
|||
265 265 |
|||
1854 1854 |
|||
14833 14833 |
|||
133496 133496 |
|||
895014631192902121</pre> |
|||
Alternatively, this is a backtracking method: |
|||
<syntaxhighlight 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)]</syntaxhighlight> |
|||
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. |
|||
=={{header|J}}== |
=={{header|J}}== |
||
Note: !n in J denotes factorial (or gamma n+1), and not subfactorial. |
Note: <code>!n</code> in J denotes factorial (or gamma n+1), and not subfactorial. |
||
< |
<syntaxhighlight lang="j">derangement=: (A.&i.~ !)~ (*/ .~: # [) i. NB. task item 1 |
||
subfactorial=: ! * +/@(_1&^ % !)@i.@>: |
subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</syntaxhighlight> |
||
Requested examples: |
|||
< |
<syntaxhighlight lang="j"> 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,#@derangement)"0 i.10 NB. task item 4 |
|||
0 1 1 |
0 1 1 |
||
1 0 0 |
1 0 0 |
||
Line 35: | Line 2,186: | ||
8 14833 14833 |
8 14833 14833 |
||
9 133496 133496 |
9 133496 133496 |
||
subfactorial 20 NB. task |
subfactorial 20 NB. stretch task |
||
8.95015e17 |
8.95015e17 |
||
subfactorial 20x NB. using extended precision |
subfactorial 20x NB. using extended precision |
||
895014631192902121</ |
895014631192902121</syntaxhighlight> |
||
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. |
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). |
||
=={{header|Java}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="java">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; |
|||
} |
|||
}</syntaxhighlight> |
|||
<pre>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</pre> |
|||
=={{header|jq}}== |
|||
{{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. |
|||
<syntaxhighlight lang="jq">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);</syntaxhighlight> |
|||
'''Tasks''': |
|||
<syntaxhighlight lang="jq"> "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)"</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="sh">$ 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</syntaxhighlight> |
|||
=={{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.2 |
|||
fun <T> permute(input: List<T>): List<List<T>> { |
|||
if (input.size == 1) return listOf(input) |
|||
val perms = mutableListOf<List<T>>() |
|||
val toInsert = input[0] |
|||
for (perm in permute(input.drop(1))) { |
|||
for (i in 0..perm.size) { |
|||
val newPerm = perm.toMutableList() |
|||
newPerm.add(i, toInsert) |
|||
perms.add(newPerm) |
|||
} |
|||
} |
|||
return perms |
|||
} |
|||
fun derange(input: List<Int>): List<List<Int>> { |
|||
if (input.isEmpty()) return listOf(input) |
|||
return permute(input).filter { permutation -> |
|||
permutation.filterIndexed { i, index -> i == index }.none() |
|||
} |
|||
} |
|||
fun subFactorial(n: Int): Long = |
|||
when (n) { |
|||
0 -> 1 |
|||
1 -> 0 |
|||
else -> (n - 1) * (subFactorial(n - 1) + subFactorial(n - 2)) |
|||
} |
|||
fun main(args: Array<String>) { |
|||
val input = listOf(0, 1, 2, 3) |
|||
val derangements = derange(input) |
|||
println("There are ${derangements.size} derangements of $input, namely:\n") |
|||
derangements.forEach(::println) |
|||
println("\nN Counted Calculated") |
|||
println("- ------- ----------") |
|||
for (n in 0..9) { |
|||
val list = List(n) { it } |
|||
val counted = derange(list).size |
|||
println("%d %-9d %-9d".format(n, counted, subFactorial(n))) |
|||
} |
|||
println("\n!20 = ${subFactorial(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 |
|||
</pre> |
|||
=={{header|Lua}}== |
|||
<syntaxhighlight lang="lua">-- 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))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
<syntaxhighlight lang="mathematica"> |
|||
Needs["Combinatorica`"] |
|||
derangements[n_] := Derangements[Range[n]] |
|||
derangements[4] |
|||
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm |
|||
Subfactorial[20]</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
{{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</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}}== |
|||
<syntaxhighlight lang="parigp">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)</syntaxhighlight> |
|||
{{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]] |
|||
!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</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=== |
|||
<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') |
|||
$#_ ? 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;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
===Using a module=== |
|||
{{libheader|ntheory}} |
|||
<syntaxhighlight lang="perl">use ntheory ":all"; |
|||
# Count derangements using derangement iterator |
|||
sub countderange { |
|||
my($n,$s) = (shift,0); |
|||
forderange { $s++ } $n; |
|||
$s; |
|||
} |
|||
# Count derangements using inclusion-exclusion |
|||
sub subfactorial1 { |
|||
my $n = shift; |
|||
vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n); |
|||
} |
|||
# Count derangements using simple recursion without special functions |
|||
sub subfactorial2 { |
|||
my $n = shift; |
|||
use bigint; no warnings 'recursion'; |
|||
($n < 1) ? 1 : $n * subfactorial2($n-1) + (-1)**$n; |
|||
} |
|||
print "Derangements of 4 items:\n"; |
|||
forderange { print "@_\n" } 4; |
|||
printf "\n%3s %15s %15s\n","N","List count","!N"; |
|||
printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9; |
|||
printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Derangements of 4 items: |
|||
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) |
|||
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 |
|||
20 895014631192902121 |
|||
200 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201 |
|||
</pre> |
|||
=={{header|Phix}}== |
|||
{{libheader|Phix/mpfr}} |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
<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> |
|||
<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> |
|||
<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> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<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> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</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: #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> |
|||
<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> |
|||
<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> |
|||
<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> |
|||
<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: #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: #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> |
|||
<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> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<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> |
|||
<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> |
|||
<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> |
|||
{{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 on 32-bit!) |
|||
!20=895014631192902121 (mpfr) |
|||
</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}}== |
|||
<syntaxhighlight lang="picolisp">(load "@lib/simul.l") # For 'permute' |
|||
(de derangements (Lst) |
|||
(filter |
|||
'((L) (not (find = L Lst))) |
|||
(permute Lst) ) ) |
|||
(de subfact (N) |
|||
(if (>= 2 N) |
|||
(if (= 1 N) 0 1) |
|||
(* |
|||
(dec N) |
|||
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</syntaxhighlight> |
|||
{{out}} |
|||
<pre>: (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</pre> |
|||
=={{header|PureBasic}}== |
|||
Brute Force |
|||
<syntaxhighlight lang="purebasic"> |
|||
Procedure.q Subfactoral(n) |
|||
If n=0:ProcedureReturn 1:EndIf |
|||
If n=1:ProcedureReturn 0:EndIf |
|||
ProcedureReturn (Subfactoral(n-1)+Subfactoral(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(0,f.s) |
|||
WriteStringN(0,"1.2") |
|||
WriteStringN(0,"2.1") |
|||
CloseFile(0) |
|||
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(Subfactoral(n))+"] for n="+Str(n) |
|||
Gosub derangements |
|||
; cw("") |
|||
Debug "" |
|||
; show the first 20 derangements |
|||
For i=0 To 20 |
|||
Debug "derangements["+Str(Subfactoral(i))+"] for n="+Str(i) |
|||
Next |
|||
End |
|||
derangements: |
|||
x=0 |
|||
If ReadFile(0,factFile.s) And CreateFile(1,drngFile.s) |
|||
Repeat |
|||
r.s = ReadString(0) |
|||
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(1,t.s+" "+Str(x)) |
|||
EndIf |
|||
EndIf |
|||
Until Eof(0) |
|||
CloseFile(0) |
|||
CloseFile(1) |
|||
Else |
|||
Debug "not readfile :"+factFile.s |
|||
Debug "not createfile :"+drngFile.s |
|||
EndIf |
|||
; cw("") |
|||
Debug "" |
|||
Return |
|||
nfactorial: |
|||
x=0 |
|||
If ReadFile(0,factFile.s) And CreateFile(1,tempFile.s) |
|||
Repeat |
|||
r.s = ReadString(0) |
|||
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(1,t.s) |
|||
Next |
|||
EndIf |
|||
Until Eof(0) |
|||
CloseFile(0) |
|||
CloseFile(1) |
|||
Else |
|||
Debug "not readfile :"+factFile.s |
|||
Debug "not createfile :"+tempFile.s |
|||
EndIf |
|||
CopyFile(tempFile.s,factFile.s) |
|||
DeleteFile(tempFile.s) |
|||
Return |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="purebasic">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
Includes stretch goal. |
Includes stretch goal. |
||
< |
<syntaxhighlight lang="python">from itertools import permutations |
||
import math |
import math |
||
Line 84: | Line 3,571: | ||
n = 20 |
n = 20 |
||
print("\n!%i = %i" % (n, subfact(n)))</ |
print("\n!%i = %i" % (n, subfact(n)))</syntaxhighlight> |
||
{{out}} |
|||
;Sample output: |
|||
<pre>Derangements of (0, 1, 2, 3) |
<pre>Derangements of (0, 1, 2, 3) |
||
(1, 0, 3, 2) |
(1, 0, 3, 2) |
||
Line 111: | Line 3,598: | ||
!20 = 895014631192902121</pre> |
!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 |
|||
(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 |
|||
</syntaxhighlight> |
|||
=={{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}}== |
|||
<syntaxhighlight lang="rexx">/*REXX program generates all permutations of N derangements and subfactorial # */ |
|||
numeric digits 1000 /*be able to handle large subfactorials*/ |
|||
parse arg N .; if N=='' | N=="," then N=4 /*Not specified? Then use the default.*/ |
|||
d= derangeSet(N) /*go and build the derangements set. */ |
|||
say d 'derangements for' N "items are:" |
|||
say |
|||
do i=1 for d /*display 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 2; d= derangeSet(L) |
|||
say L 'items: derangement count='right(d, 6)", !"L'='right( !s(L), 6) |
|||
end /*L*/ |
|||
say |
|||
say right('!20=' , 22) !s( 20) |
|||
say right('!200=', 22) !s(200) |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
!s: _=1; do j=1 for arg(1); if j//2 then _= j*_ - 1; else _=j*_ + 1 |
|||
end /*j*/; return _ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
derangeSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1 |
|||
if x==0 then return 1; if x==1 then return 0 |
|||
@.1=2; @.2=1 /*populate 1st derangement.*/ |
|||
do i=3 to x; @.i=i; end /*i*/ /* " the rest of 'em.*/ |
|||
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: do j=1 for arg(1); if @.j==j then return; end |
|||
#=#+1; do j=1 for arg(1); $.#= $.# @.j; end; return |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
.nextD: procedure expose @.; parse arg n,i |
|||
do k=n-1 by -1 for n-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 /*j*/ |
|||
if i==0 then return 0 |
|||
do m=i+1 while @.m<@.i; end /*m*/ /* [↓] swap two values. */ |
|||
parse value @.m @.i with @.i @.m; return 1</syntaxhighlight> |
|||
{{out|output|text= when using the default inputs:}} |
|||
<pre> |
|||
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 |
|||
!20= 895014631192902121 |
|||
!200= 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201 |
|||
</pre> |
|||
=={{header|Ruby}}== |
|||
<syntaxhighlight lang="ruby">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</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 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 |
|||
</pre> |
|||
=={{header|Scala}}== |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="scala">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"))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|SuperCollider}}== |
|||
<syntaxhighlight lang="supercollider">( |
|||
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); ""; |
|||
)</syntaxhighlight> |
|||
Answers: |
|||
<syntaxhighlight lang="supercollider"> |
|||
[ 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 ] |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="supercollider">( |
|||
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)); |
|||
}; |
|||
)</syntaxhighlight> |
|||
Answers: |
|||
<syntaxhighlight lang="supercollider"> |
|||
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 |
|||
</syntaxhighlight> |
|||
=={{header|Tcl}}== |
|||
{{tcllib|struct::list}} |
|||
<syntaxhighlight lang="tcl">package require Tcl 8.5; # for arbitrary-precision integers |
|||
package require struct::list; # for permutation enumerator |
|||
proc derangements lst { |
|||
# Special case |
|||
if {![llength $lst]} {return {{}}} |
|||
set result {} |
|||
for {set perm [struct::list firstperm $lst]} {[llength $perm]} \ |
|||
{set perm [struct::list nextperm $perm]} { |
|||
set skip 0 |
|||
foreach a $lst b $perm { |
|||
if {[set skip [string equal $a $b]]} break |
|||
} |
|||
if {!$skip} {lappend result $perm} |
|||
} |
|||
return $result |
|||
} |
|||
proc deranged1to n { |
|||
for {set i 1;set r {}} {$i <= $n} {incr i} {lappend r $i} |
|||
return [derangements $r] |
|||
} |
|||
proc countDeranged1to n { |
|||
llength [deranged1to $n] |
|||
} |
|||
proc subfact n { |
|||
if {$n == 0} {return 1} |
|||
if {$n == 1} {return 0} |
|||
set o 1 |
|||
set s 0 |
|||
for {set i 1} {$i < $n} {incr i} { |
|||
set s [expr {$i * ($o + [set o $s])}] |
|||
} |
|||
return $s |
|||
}</syntaxhighlight> |
|||
Demonstrating with the display parts of the task: |
|||
<syntaxhighlight lang="tcl">foreach d [deranged1to 4] { |
|||
puts "derangement of 1..4: $d" |
|||
} |
|||
puts "\n\tcounted\tcalculated" |
|||
for {set i 0} {$i <= 9} {incr i} { |
|||
puts "!$i\t[countDeranged1to $i]\t[subfact $i]" |
|||
} |
|||
# Stretch goal |
|||
puts "\n!20 = [subfact 20]"</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</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 |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
{{trans|Python}} mostly |
|||
<syntaxhighlight lang="zkl">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); |
|||
}</syntaxhighlight> |
|||
<syntaxhighlight 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){ |
|||
println("%2d %-6d %-6d".fmt(n, derangers(n), subFact(n))); |
|||
} |
|||
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
Lazy/iterators version: |
|||
<syntaxhighlight lang="zkl">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)... |
|||
}</syntaxhighlight> |
|||
<syntaxhighlight lang="zkl">foreach d in (derangements(4)){ println(d) } |
|||
//rest of test code remains the same</syntaxhighlight> |
Latest revision as of 00:14, 17 April 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
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
- Create a named function/method/subroutine/... to generate derangements of the integers 0..n-1, (or 1..n if you prefer).
- Generate and show all the derangements of 4 integers using the above routine.
- Create a function that calculates the subfactorial of n, !n.
- Print and show a table of the counted number of derangements of n vs. the calculated !n for n from 0..9 inclusive.
- Optional stretch goal
- Calculate !20
- Related tasks
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contain the most consonants
- Find words which contains more than 3 vowels
- Find words whose first and last three letters are equal
- Find words with alternating vowels and consonants
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 bottles of beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
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)))
- 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
360 Assembly
Due to 32 bit integers !12 is the limit.
* 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
- Output:
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
Acornsoft Lisp
Memory limits on machines like the 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.
(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))
- Output:
Calling (examples)
will output:
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
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.
Ada
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
Arturo
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|"
- Output:
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
AutoHotkey
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
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
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
#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
C#
Recursive version
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;
}
}
}
}
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;
}
- 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 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
Clojure
Generating functions with no fixed point
(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))))
- Output:
[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
Common 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))))
- Output:
Calling (examples)
would output:
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
D
Iterative Version
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
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);
}
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
.
EchoLisp
(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
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
F#
The Function
// 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)
The Task
derange 4 |> Seq.iter(printfn "%A")
- Output:
[|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|]
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))
- Output:
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
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 .
- Output:
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
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
- Output:
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
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 ],
# [ 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
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
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
import Control.Monad (forM_)
import Data.List (permutations)
-- Compute all derangements of a list
derangements
:: Eq a
=> [a] -> [[a]]
derangements = (\x -> filter (and . zipWith (/=) x)) <*> permutations
-- Compute the number of derangements of n elements
subfactorial
:: (Eq a, Num a)
=> a -> a
subfactorial 0 = 1
subfactorial 1 = 0
subfactorial n = (n - 1) * (subfactorial (n - 1) + subfactorial (n - 2))
main :: IO ()
main
-- Generate and show all the derangements of four integers
= do
print $ derangements [1 .. 4]
putStrLn ""
-- Print the count of derangements vs subfactorial
forM_ [1 .. 9] $
\i ->
putStrLn $
mconcat
[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
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,#@derangement)"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
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
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
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))
- Output:
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
Kotlin
// version 1.1.2
fun <T> permute(input: List<T>): List<List<T>> {
if (input.size == 1) return listOf(input)
val perms = mutableListOf<List<T>>()
val toInsert = input[0]
for (perm in permute(input.drop(1))) {
for (i in 0..perm.size) {
val newPerm = perm.toMutableList()
newPerm.add(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
fun derange(input: List<Int>): List<List<Int>> {
if (input.isEmpty()) return listOf(input)
return permute(input).filter { permutation ->
permutation.filterIndexed { i, index -> i == index }.none()
}
}
fun subFactorial(n: Int): Long =
when (n) {
0 -> 1
1 -> 0
else -> (n - 1) * (subFactorial(n - 1) + subFactorial(n - 2))
}
fun main(args: Array<String>) {
val input = listOf(0, 1, 2, 3)
val derangements = derange(input)
println("There are ${derangements.size} derangements of $input, namely:\n")
derangements.forEach(::println)
println("\nN Counted Calculated")
println("- ------- ----------")
for (n in 0..9) {
val list = List(n) { it }
val counted = derange(list).size
println("%d %-9d %-9d".format(n, counted, subFactorial(n)))
}
println("\n!20 = ${subFactorial(20)}")
}
- Output:
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
Lua
-- 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 /Wolfram Language
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
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
- Output:
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
PARI/GP
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
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.
- Output:
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
Perl
Traditional verbose version
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
Using a module
use ntheory ":all";
# Count derangements using derangement iterator
sub countderange {
my($n,$s) = (shift,0);
forderange { $s++ } $n;
$s;
}
# Count derangements using inclusion-exclusion
sub subfactorial1 {
my $n = shift;
vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n);
}
# Count derangements using simple recursion without special functions
sub subfactorial2 {
my $n = shift;
use bigint; no warnings 'recursion';
($n < 1) ? 1 : $n * subfactorial2($n-1) + (-1)**$n;
}
print "Derangements of 4 items:\n";
forderange { print "@_\n" } 4;
printf "\n%3s %15s %15s\n","N","List count","!N";
printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9;
printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;
- Output:
Derangements of 4 items: 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) 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 20 895014631192902121 200 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
Phix
with javascript_semantics 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<2 then return 1-n 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 string msg = iff(machine_bits()=32?" (incorrect on 32-bit!)":"") -- (fine on 64-bit) printf(1,"!20=%d%s\n",{subfactorial(20),msg}) include mpfr.e function mpz_sub_factorial(integer n) -- probably not the most efficient way to do this! if n<2 then return sprintf("%d",{1-n}) end if mpz f = mpz_init(mpz_sub_factorial(n-1)), g = mpz_init(mpz_sub_factorial(n-2)) mpz_add(f,f,g) mpz_mul_si(f,f,n-1) string res = mpz_get_str(f) {f,g} = mpz_free({f,g}) return res end function printf(1,"!20=%s (mpfr)\n",{mpz_sub_factorial(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 on 32-bit!) !20=895014631192902121 (mpfr)
(under pwa/p2js you get a trailing "000" instead of "186" for the incorrect result)
A more efficient method of calculating subfactorials (0 should be handled separately, or obviously prepend a 1 and extract with idx+1).
Should you instead of string results want an array of mpz for further calculations, use the mpz_init_set() call as shown:
with javascript_semantics include mpfr.e function subfactorial(integer n) sequence res = repeat(0,n) mpz num = mpz_init(1) for i=1 to n do mpz_mul_si(num,num,i) if mpz_odd(num) then mpz_sub_ui(num,num,1) else mpz_add_ui(num,num,1) end if res[i] = mpz_get_str(num) -- res[i] = mpz_init_set(num) end for return res end function ?extract(subfactorial(20),tagset(9)&20)
- Output:
{"0","1","2","9","44","265","1854","14833","133496","895014631192902121"}
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).
- Output:
[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
PicoLisp
(load "@lib/simul.l") # For 'permute'
(de derangements (Lst)
(filter
'((L) (not (find = L Lst)))
(permute Lst) ) )
(de subfact (N)
(if (>= 2 N)
(if (= 1 N) 0 1)
(*
(dec N)
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )
- 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
Brute Force
Procedure.q Subfactoral(n)
If n=0:ProcedureReturn 1:EndIf
If n=1:ProcedureReturn 0:EndIf
ProcedureReturn (Subfactoral(n-1)+Subfactoral(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(0,f.s)
WriteStringN(0,"1.2")
WriteStringN(0,"2.1")
CloseFile(0)
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(Subfactoral(n))+"] for n="+Str(n)
Gosub derangements
; cw("")
Debug ""
; show the first 20 derangements
For i=0 To 20
Debug "derangements["+Str(Subfactoral(i))+"] for n="+Str(i)
Next
End
derangements:
x=0
If ReadFile(0,factFile.s) And CreateFile(1,drngFile.s)
Repeat
r.s = ReadString(0)
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(1,t.s+" "+Str(x))
EndIf
EndIf
Until Eof(0)
CloseFile(0)
CloseFile(1)
Else
Debug "not readfile :"+factFile.s
Debug "not createfile :"+drngFile.s
EndIf
; cw("")
Debug ""
Return
nfactorial:
x=0
If ReadFile(0,factFile.s) And CreateFile(1,tempFile.s)
Repeat
r.s = ReadString(0)
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(1,t.s)
Next
EndIf
Until Eof(0)
CloseFile(0)
CloseFile(1)
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
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
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
QBasic
Error "Subscript out of scope" for n > 7
' 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
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
- Output:
[ 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
Racket
#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
Raku
(formerly Perl 6)
Generate List.permutations
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 Z
infix zip operator with the eqv
equivalence infix operator, all wrapped inside a none()
Junction.
Although not necessary for this task, I have used eqv
instead of ==
so that the derangements()
function also works with any set of arbitrary objects (eg. strings, lists, etc.)
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 }"
}
- Output:
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
Much faster to just calculate the subfactorial.
my @subfactorial = 1,0,{++$ × ($^a + $^b)}…*;
say "!$_: ",@subfactorial[$_] for |^10, 20, 200;
- Output:
!0: 1 !1: 0 !2: 1 !3: 2 !4: 9 !5: 44 !6: 265 !7: 1854 !8: 14833 !9: 133496 !20: 895014631192902121 !200: 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
REXX
/*REXX program generates all permutations of N derangements and subfactorial # */
numeric digits 1000 /*be able to handle large subfactorials*/
parse arg N .; if N=='' | N=="," then N=4 /*Not specified? Then use the default.*/
d= derangeSet(N) /*go and build the derangements set. */
say d 'derangements for' N "items are:"
say
do i=1 for d /*display 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 2; d= derangeSet(L)
say L 'items: derangement count='right(d, 6)", !"L'='right( !s(L), 6)
end /*L*/
say
say right('!20=' , 22) !s( 20)
say right('!200=', 22) !s(200)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!s: _=1; do j=1 for arg(1); if j//2 then _= j*_ - 1; else _=j*_ + 1
end /*j*/; return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
derangeSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
if x==0 then return 1; if x==1 then return 0
@.1=2; @.2=1 /*populate 1st derangement.*/
do i=3 to x; @.i=i; end /*i*/ /* " the rest of 'em.*/
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: do j=1 for arg(1); if @.j==j then return; end
#=#+1; do j=1 for arg(1); $.#= $.# @.j; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.nextD: procedure expose @.; parse arg n,i
do k=n-1 by -1 for n-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 /*j*/
if i==0 then return 0
do m=i+1 while @.m<@.i; end /*m*/ /* [↓] swap two values. */
parse value @.m @.i with @.i @.m; return 1
- output when using the default inputs:
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 !20= 895014631192902121 !200= 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
Ruby
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
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
(
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
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
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))")
- Output:
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
zkl
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
- Programming Tasks
- Solutions by Programming Task
- 11l
- 360 Assembly
- Acornsoft Lisp
- Ada
- Arturo
- AutoHotkey
- BBC BASIC
- Bracmat
- C
- C sharp
- C++
- Clojure
- Common Lisp
- D
- EasyLang
- EchoLisp
- Elixir
- F Sharp
- Factor
- FreeBASIC
- GAP
- Go
- Groovy
- Haskell
- J
- Java
- Jq
- Julia
- Kotlin
- Lua
- Mathematica
- Wolfram Language
- Nim
- PARI/GP
- Pascal
- Perl
- Ntheory
- Phix
- Phix/mpfr
- Picat
- PicoLisp
- PureBasic
- Python
- QBasic
- Quackery
- Racket
- Raku
- REXX
- Ruby
- Scala
- SuperCollider
- Tcl
- Tcllib
- Wren
- Wren-fmt
- Wren-big
- Zkl