Permutations/Derangements: Difference between revisions

m
→‎{{header|Raku}}: Add a version using subfactorials
m (Phix/mpfr)
m (→‎{{header|Raku}}: Add a version using subfactorials)
 
(20 intermediate revisions by 15 users not shown)
Line 24:
*   [[Best shuffle]]
*   [[Left_factorials]]
 
 
{{Template:Strings}}
<br><br>
 
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="11l">F derangements(n)
[[Int]] r
V perm = Array(0 .< n)
L
I all(enumerate(perm).map((indx, p) -> indx != p))
r [+]= perm
I !perm.next_permutation()
L.break
R r
 
F subfact(n) -> Int64
R I n < 2 {1 - n} E (subfact(n - 1) + subfact(n - 2)) * (n - 1)
 
V n = 4
print(‘Derangements of ’Array(0 .< n))
L(d) derangements(n)
print(‘ ’d)
 
print("\nTable of n vs counted vs calculated derangements")
L(n) 10
print(‘#2 #<6 #.’.format(n, derangements(n).len, subfact(n)))
 
n = 20
print("\n!#. = #.".format(n, subfact(n)))</syntaxhighlight>
 
{{out}}
<pre>
Derangements of [0, 1, 2, 3]
[1, 0, 3, 2]
[1, 2, 3, 0]
[1, 3, 0, 2]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]
 
Table of n vs counted vs calculated derangements
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|360 Assembly}}==
{{trans|BBC BASIC}}
Due to 32 bit integers !12 is the limit.
<langsyntaxhighlight lang="360asm">* Permutations/Derangements 01/04/2017
DERANGE CSECT
USING DERANGE,R13 base register
Line 280 ⟶ 339:
PG DC CL80' ' buffer
YREGS
END DERANGE</langsyntaxhighlight>
{{out}}
<pre>
Line 307 ⟶ 366:
!12= 176214841
</pre>
 
=={{header|Acornsoft Lisp}}==
 
Memory limits on machines like the [[wp:BBC_Micro|BBC Micro]] mean that we'd run out of memory if we tried to make a list of all permutations of a list longer than 6 or so elements. Permutations are therefore generated recursively one at a time and given to a ''visitor'' function. The recursion is effectively ''n'' nested loops for a list of length ''n'' and so is not a major obstacle in itself.
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((eq n 0) 1)
((eq n 1) 0)
(t (times (sub1 n)
(plus (subfact (sub1 n))
(subfact (sub1 (sub1 n))))))))
 
(defun count-derangements (n (count . 0))
(visit-derangements (range 1 n)
'(lambda (d) (setq count (add1 count))))
count)
 
(defun visit-derangements (original-items d-visitor)
(visit-permutations original-items
'(lambda (p)
(cond ((derangement-p original-items p)
(d-visitor p))))))
 
(defun derangement-p (original d (fail . nil))
(map '(lambda (a b) (cond ((eq a b) (setq fail t))))
original
d)
(not fail))
 
(defun visit-permutations (items p-visitor)
(visit-permutations-1 items '()))
 
(defun visit-permutations-1 (items perm)
(cond
((null items) (p-visitor (reverse perm)))
(t
(map '(lambda (i)
(visit-permutations-1
(without i items)
(cons i perm)))
items))))
 
'( Utilities )
 
(defun without (i items)
(cond ((null items) '())
((eq (car items) i) (cdr items))
(t (cons (car items) (without i (cdr items))))))
 
(defun reverse (list (result . ()))
(map '(lambda (e) (setq result (cons e result)))
list)
result)
 
(defun range (from to)
(cond ((greaterp from to) '())
(t (cons from (range (add1 from) to)))))
 
'( Examples )
 
(defun examples ()
(show-derangements '(1 2 3 4))
(printc)
(map '(lambda (i)
(printc i
'! (count-derangements i)
'! (subfact i)))
(range 0 8)))
 
(defun show-derangements (items)
(printc 'Derangements! of! items)
(visit-derangements items print))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> will output:
 
<pre>
Derangements of (1 2 3 4)
(2 1 4 3)
(2 3 4 1)
(2 4 1 3)
(3 1 4 2)
(3 4 1 2)
(3 4 2 1)
(4 1 2 3)
(4 3 1 2)
(4 3 2 1)
 
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
</pre>
 
The comparison table stops at ''n = 8'' because, since numbers are 16-bit integers, the program can't count as high as 133496. It can, however, generate all of those derangements.
 
=={{header|Ada}}==
{{trans|C}}
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO; use Ada.Text_IO;
procedure DePermute is
type U64 is mod 2**64;
Line 363 ⟶ 526:
end loop;
Put_Line ("!20 = " & U64'Image (sub_fact (20)));
end DePermute;</langsyntaxhighlight>
{{out}}
<pre>Deranged 4:
Line 387 ⟶ 550:
9 133496 133496
!20 = 895014631192902121</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">isClean?: function [s,o][
loop.with:'i s 'a [
if a = o\[i] -> return false
]
return true
]
 
derangements: function [n][
original: 1..n
select permutate original 'x ->
isClean? x original
]
 
subfactorial: function [n].memoize[
(n =< 1)? -> 1 - n
-> (n-1) * (add subfactorial n-1 subfactorial n-2)
]
 
print "Derangements of 1 2 3 4:"
loop derangements 4 'x [
print x
]
 
print "\nNumber of derangements:"
print [pad "n" 5 pad "counted" 15 pad "calculated" 15]
print repeat "-" 39
loop 0..9 'z [
counted: size derangements z
calculated: subfactorial z
print [pad to :string z 5 pad to :string counted 15 pad to :string calculated 15]
]
 
print ~"\n!20 = |subfactorial 20|"</syntaxhighlight>
 
{{out}}
 
<pre>Derangements of 1 2 3 4:
4 1 2 3
3 1 4 2
3 4 1 2
4 3 1 2
2 1 4 3
2 4 1 3
2 3 4 1
3 4 2 1
4 3 2 1
 
Number of derangements:
n counted calculated
---------------------------------------
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121</pre>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
Note that the permutations are generated in lexicographic order, from http://www.autohotkey.com/forum/topic77959.html
<langsyntaxhighlight AHKlang="ahk">#NoEnv
SetBatchLines -1
Process, Priority,, high
Line 486 ⟶ 714:
a *= A_Index
return a
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for 1, 2, 3, 4:
Line 515 ⟶ 743:
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight BBClang="bbc BASICbasic"> PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
Line 589 ⟶ 817:
REM Or you could use:
REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))</langsyntaxhighlight>
 
{{out}}
Line 628 ⟶ 856:
Also the counter <code>count</code> is a global variable.
<langsyntaxhighlight lang="bracmat">( ( calculated-!n
= memo answ
. (memo==)
Line 679 ⟶ 907:
& out$("!20 =" calculated-!n$20)
& lst$calculated-!n
)</langsyntaxhighlight>
{{out}}
<pre>Derangements of 1 2 3 4
Line 738 ⟶ 966:
 
=={{header|C}}==
<langsyntaxhighlight Clang="c">#include <stdio.h>
typedef unsigned long long LONG;
 
Line 794 ⟶ 1,022:
 
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>Deranged Four:
Line 835 ⟶ 1,063:
Recursive version
 
<langsyntaxhighlight lang="csharp">
using System;
class Derangements
Line 864 ⟶ 1,092:
}
}
</syntaxhighlight>
</lang>
 
=={{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
 
<langsyntaxhighlight Clojurelang="clojure">(ns derangements.core
(:require [clojure.set :as s]))
 
Line 908 ⟶ 1,257:
(range 10)))
(println (subfactorial 20))))
</syntaxhighlight>
</lang>
{{Out}}
<pre>[1 0 3 2]
Line 930 ⟶ 1,279:
133496 133496
895014631192902121</pre>
 
=={{header|Common Lisp}}==
{{trans|Acornsoft Lisp}}
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((= n 0) 1)
((= n 1) 0)
(t (* (- n 1)
(+ (subfact (- n 1))
(subfact (- n 2)))))))
 
(defun count-derangements (n)
(let ((count 0))
(visit-derangements (range 1 n)
(lambda (d) (declare (ignore d)) (incf count)))
count))
 
(defun visit-derangements (items visitor)
(visit-permutations items
(lambda (p)
(when (derangement-p items p)
(funcall visitor p)))))
 
(defun derangement-p (original d)
(notany #'equal original d))
 
(defun visit-permutations (items visitor)
(labels
((vp (items perm)
(cond ((null items)
(funcall visitor (reverse perm)))
(t
(mapc (lambda (i)
(vp (remove i items)
(cons i perm)))
items)))))
(vp items '())))
 
(defun range (start end)
(loop for i from start to end collect i))
 
(defun examples ()
(show-derangements '(1 2 3 4))
(format t "~%n counted !n~%")
(dotimes (i 10)
(format t "~S ~7@S ~7@S~%"
i
(count-derangements i)
(subfact i)))
(format t "~%!20 = ~S~2%" (subfact 20)))
 
(defun show-derangements (items)
(format t "~%Derangements of ~S~%" items)
(visit-derangements items
(lambda (d)
(format t " ~S~%" d))))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> would output:
 
<pre>
Derangements of (1 2 3 4)
(2 1 4 3)
(2 3 4 1)
(2 4 1 3)
(3 1 4 2)
(3 4 1 2)
(3 4 2 1)
(4 1 2 3)
(4 3 1 2)
(4 3 2 1)
 
n counted !n
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|D}}==
===Iterative Version===
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.conv,
std.range, std.traits;
 
Line 997 ⟶ 1,436:
 
writefln("\n!20 = %s", 20L.subfact);
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4:
Line 1,027 ⟶ 1,466:
Slightly slower but more compact recursive version of the derangements function, based on the [[Permutations#D|D entry]] of the permutations task.
Same output.
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.conv, std.range;
 
T factorial(T)(in T n) pure nothrow {
Line 1,073 ⟶ 1,512:
 
writefln("\n!20 = %s", 20L.subfact);
}</langsyntaxhighlight>
 
=={{header|EasyLang}}==
 
<syntaxhighlight lang=easylang>
global list[] rlist[][] .
proc permlist k . .
if k >= len list[]
for i to len list[]
if i = list[i]
return
.
.
rlist[][] &= list[]
return
.
for i = k to len list[]
swap list[i] list[k]
permlist k + 1
swap list[k] list[i]
.
.
#
proc derang n . r[][] .
rlist[][] = [ ]
list[] = [ ]
for i to n
list[] &= i
.
permlist 1
r[][] = rlist[][]
.
r[][] = [ ]
derang 4 r[][]
print r[][]
#
func subfac n .
if n < 2
return 1 - n
.
return (subfac (n - 1) + subfac (n - 2)) * (n - 1)
.
#
print "counted / calculated"
for n = 0 to 9
derang n r[][]
print n & ": " & len r[][] & " " & subfac n
.
</syntaxhighlight>
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
(lib 'list) ;; in-permutations
(lib 'bigint)
Line 1,097 ⟶ 1,584:
(remember '!n #(1 0))
 
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(derangements 4)
→ ((3 0 1 2) (2 0 3 1) (2 3 0 1) (3 2 0 1) (3 2 1 0) (2 3 1 0) (1 2 3 0) (1 3 0 2) (1 0 3 2))
Line 1,120 ⟶ 1,607:
(!n 20)
→ 895014631192902121
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="elixir">defmodule Permutation do
def derangements(n) do
list = Enum.to_list(1..n)
Line 1,152 ⟶ 1,639:
Enum.each(10..20, fn n ->
:io.format "~2w :~19w~n", [n, Permutation.subfact(n)]
end)</langsyntaxhighlight>
 
{{out}}
Line 1,194 ⟶ 1,681:
=={{header|F_Sharp|F#}}==
===The Function===
<langsyntaxhighlight lang="fsharp">
// Generate derangements. Nigel Galloway: July 9th., 2019
let derange n=
Line 1,205 ⟶ 1,692:
|_->()}
derange 0 [|1..n|] (n-1)
</syntaxhighlight>
</lang>
===The Task===
<langsyntaxhighlight lang="fsharp">
derange 4 |> Seq.iter(printfn "%A")
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,222 ⟶ 1,709:
[|4; 1; 2; 3|]
</pre>
<langsyntaxhighlight 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>
</lang>
{{out}}
<pre>
Line 1,241 ⟶ 1,728:
=={{header|Factor}}==
{{works with|Factor|0.98}}
<langsyntaxhighlight lang="factor">USING: combinators formatting io kernel math math.combinatorics
prettyprint sequences ;
IN: rosetta-code.derangements
Line 1,262 ⟶ 1,749:
"%d%8d%8d\n" printf
] each nl
"!20 = " write 20 !n .</langsyntaxhighlight>
{{out}}
<pre>
Line 1,295 ⟶ 1,782:
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' version 08-04-2017
' compile with: fbc -s console
 
Line 1,388 ⟶ 1,875:
Print : Print "hit any key to end program"
Sleep
End</langsyntaxhighlight>
{{out}}
<pre>permutations derangements for n = 4
Line 1,419 ⟶ 1,906:
 
=={{header|GAP}}==
<langsyntaxhighlight lang="gap"># All of this is built-in
Derangements([1 .. 4]);
# [ [ 2, 1, 4, 3 ], [ 2, 3, 4, 1 ], [ 2, 4, 1, 3 ], [ 3, 1, 4, 2 ], [ 3, 4, 1, 2 ], [ 3, 4, 2, 1 ],
Line 1,453 ⟶ 1,940:
# [ 7, 1854, 1854, 1854 ],
# [ 8, 14833, 14833, 14833 ],
# [ 9, 133496, 133496, 133496 ] ]</langsyntaxhighlight>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,526 ⟶ 2,013:
// stretch (sic)
fmt.Println("\n!20 =", subFact(20))
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,558 ⟶ 2,045:
=={{header|Groovy}}==
Solution:
<langsyntaxhighlight lang="groovy">def fact = { n -> [1,(1..<(n+1)).inject(1) { prod, i -> prod * i }].max() }
def subfact
subfact = { BigInteger n -> (n == 0) ? 1 : (n == 1) ? 0 : ((n-1) * (subfact(n-1) + subfact(n-2))) }
Line 1,566 ⟶ 2,053:
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p }
d
}</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="groovy">def d = derangement([1,2,3,4])
assert d.size() == subfact(4)
d.each { println it }
Line 1,584 ⟶ 2,071:
println """
!20 == ${subfact(20)}
"""</langsyntaxhighlight>
 
{{out}}
Line 1,614 ⟶ 2,101:
=={{header|Haskell}}==
 
<langsyntaxhighlight Haskelllang="haskell">import Control.Monad (forM_)
 
import Data.List (permutations)
Line 1,646 ⟶ 2,133:
putStrLn ""
-- Print the number of derangements in a list of 20 items
print $ subfactorial 20</langsyntaxhighlight>
{{Out}}
<pre>[[4,3,2,1],[3,4,2,1],[2,3,4,1],[4,1,2,3],[2,4,1,3],[2,1,4,3],[4,3,1,2],[3,4,1,2],[3,1,4,2]]
Line 1,664 ⟶ 2,151:
Alternatively, this is a backtracking method:
 
<langsyntaxhighlight lang="haskell">derangements xs = loop xs xs
where loop [] [] = [[]]
loop (h:hs) xs = [x:ys | x <- xs, x /= h, ys <- loop hs (delete x xs)]</langsyntaxhighlight>
 
Since the value <i>i</I> cannot occur in position <i>i</i>, we prefix <i>i</i> on all other derangements from 1 to <i>n</i> that do not include <i>i</i>. The first method of filtering permutations is significantly faster, in practice, however.
Line 1,673 ⟶ 2,160:
Note: <code>!n</code> in J denotes factorial (or gamma n+1), and not subfactorial.
 
<langsyntaxhighlight lang="j">derangement=: (A.&i.~ !)~ (*/ .~: # [) i. NB. task item 1
subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</langsyntaxhighlight>
 
Requested examples:
 
<langsyntaxhighlight lang="j"> derangement 4 NB. task item 2
1 0 3 2
1 2 3 0
Line 1,702 ⟶ 2,189:
8.95015e17
subfactorial 20x NB. using extended precision
895014631192902121</langsyntaxhighlight>
 
Note that derangement 10 was painfully slow (almost 3 seconds, about 10 times slower than derangement 9 and 100 times slower than derangement 8) -- this is a brute force approach. But brute force seems like an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).
Line 1,708 ⟶ 2,195:
=={{header|Java}}==
{{trans|D}}
<langsyntaxhighlight lang="java">import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
Line 1,802 ⟶ 2,289:
return r;
}
}</langsyntaxhighlight>
 
<pre>derangements for n = 4
Line 1,834 ⟶ 2,321:
{{works with|jq|1.4}}
The following implementation of "derangements" generates the derangements directly, without generating all permutations. Since recent versions of jq have tail-call optimization (TCO) for arity-0 recursive functions, the workhorse inner function (deranged/0) is implemented as an arity-0 function.
<langsyntaxhighlight lang="jq">def derangements:
 
# In order to reference the original array conveniently, define _derangements(ary):
Line 1,857 ⟶ 2,344:
 
# Avoid creating an array just to count the items in a stream:
def count(g): reduce g as $i (0; . + 1);</langsyntaxhighlight>
'''Tasks''':
<langsyntaxhighlight lang="jq"> "Derangements:",
([range(1;5)] | derangements),
"",
Line 1,865 ⟶ 2,352:
(range(1;10) as $i | "\($i): \(count( [range(0;$i)] | derangements)) vs \($i|subfact)"),
"",
"Computed approximation to !20 (15 significant digits): \(20|subfact)"</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight lang="sh">$ jq -n -c -r -f derangements.jq
jq -n -c -r -f derangements.jq
 
Line 1,892 ⟶ 2,379:
9: 133496 vs 133496
 
Computed approximation to !20 (15 significant digits): 895014631192902000</langsyntaxhighlight>
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">using Printf, Combinatorics
 
derangements(n::Int) = (perm for perm in permutations(1:n)
Line 1,926 ⟶ 2,413:
end
 
println("\n!20 = ", subfact(20))</langsyntaxhighlight>
 
{{out}}
Line 1,955 ⟶ 2,442:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun <T> permute(input: List<T>): List<List<T>> {
Line 2,000 ⟶ 2,487:
}
println("\n!20 = ${subFactorial(20)}")
}</langsyntaxhighlight>
 
{{out}}
Line 2,033 ⟶ 2,520:
 
=={{header|Lua}}==
<langsyntaxhighlight Lualang="lua">-- Return an iterator to produce every permutation of list
function permute (list)
local function perm (list, n)
Line 2,101 ⟶ 2,588:
print("\t| " .. #derangements(listOneTo(i)))
end
print("\n\nThe subfactorial of 20 is " .. subFact(20))</langsyntaxhighlight>
{{out}}
<pre>Derangements of [1,2,3,4]
Line 2,133 ⟶ 2,620:
The subfactorial of 20 is 8.950146311929e+17</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
<lang Mathematica>
Needs["Combinatorica`"]
derangements[n_] := Derangements[Range[n]]
derangements[4]
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm
Subfactorial[20]</langsyntaxhighlight>
{{out}}
<pre>
Line 2,156 ⟶ 2,643:
 
895014631192902121</pre>
 
=={{header|Nim}}==
<syntaxhighlight lang="nim">import algorithm, sequtils, strformat, strutils, tables
 
iterator derangements[T](a: openArray[T]): seq[T] =
var perm = @a
while true:
if not perm.nextPermutation():
break
block checkDerangement:
for i, val in a:
if perm[i] == val: break checkDerangement
yield perm
 
proc `!`(n: Natural): Natural =
if n <= 1: return 1 - n
result = (n - 1) * (!(n - 1) + !(n - 2))
 
echo "Derangements of 1 2 3 4:"
for d in [1, 2, 3, 4].derangements():
echo d.join(" ")
 
echo "\nNumber of derangements:"
echo "n counted calculated"
echo "- ------- ----------"
for n in 0..9:
echo &"{n} {toSeq(derangements(toSeq(1..n))).len:>6} {!n:>6}"
 
echo "\n!20 = ", !20</syntaxhighlight>
 
{{out}}
<pre>Derangements of 1 2 3 4:
2 1 4 3
2 3 4 1
2 4 1 3
3 1 4 2
3 4 1 2
3 4 2 1
4 1 2 3
4 3 1 2
4 3 2 1
 
Number of derangements:
n counted calculated
- ------- ----------
0 0 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121</pre>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">derangements(n)=if(n,round(n!/exp(1)),1);
derange(n)={
my(v=[[]],tmp);
Line 2,176 ⟶ 2,720:
derange(4)
for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n)))
derangements(20)</langsyntaxhighlight>
{{out}}
<pre>%1 = [[2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1]]
Line 2,192 ⟶ 2,736:
 
%2 = 895014631192902121</pre>
 
=={{header|Pascal}}==
<syntaxhighlight lang="pascal">
program Derangements_RC;
(*
Pascal solution for Rosetta Code task "Permutations/Derangements"
Console program written in Free Pascal (Lazarus)
*)
// Returns first derangement in lexicographic order.
// Function return is false if there are no derangements.
function FirstDerangement( var val : array of integer) : boolean;
var
n, j : integer;
begin
n := Length( val);
result := (n <> 1);
if n < 2 then exit;
if Odd(n) then begin
val[n - 3] := n - 2;
val[n - 2] := n - 1;
val[n - 1] := n - 3;
dec( n, 3);
end;
j := 0;
while (j < n) do begin
val[j] := j + 1;
val[j + 1] := j;
inc( j, 2);
end;
end;
 
// Returns next derangement in lexicographic order.
// Function return is false if there are no more derangements.
// Finds next derangement directly, i.e. not by generating
// permutations until a derangement is found.
function NextDerangement( var val : array of integer) : boolean;
var
i, j, n : integer;
backward, done : boolean;
free : array of boolean;
begin
n := Length( val);
if (n < 3) then begin
result := false;
exit;
end;
SetLength( free, n);
for j := 0 to n - 1 do free[j] := false;
i := n - 1;
free[val[i]] := true;
backward := true;
done := false;
repeat
if backward then begin
dec(i); j := val[i]; free[j] := true;
end
else begin
inc(i); j := -1;
end;
repeat
inc(j)
until (j >= n) or (free[j] and (j <> i));
if (j < n) then begin // found a suitable free value
val[i] := j; free[j] := false;
if (i = n - 1) then done := true // found the next derangement
else backward := false;
end
else if (i = 0) then done := true // no more derangements
else backward := true;
until done;
result := (i > 0);
end;
 
// Finds all derangements of integers 0..(n - 1) and
// returns the number of derangements.
// if boolean "show" is true, writes derangments to standard output.
function FindDerangements( n : integer;
show : boolean) : integer;
var
int_array : array of integer;
j : integer;
ok : boolean;
begin
result := 0;
if (n < 0) then exit;
SetLength( int_array, n);
ok := FirstDerangement( int_array);
while ok do begin
inc( result);
if show then begin
for j := 0 to n - 1 do Write( ' ', int_array[j]);
WriteLn();
end;
ok := NextDerangement( int_array);
end;
end;
 
// Returns subfactorial of passed-in integer.
function Subfactorial( n : integer) : uint64;
var
j : integer;
begin
result := 1;
for j := 1 to n do begin
result := result*j;
if Odd(j) then dec(result) else inc(result);
end;
end;
 
// Main routine for Rosetta Code task.
var
n, nrFound, nrCalc : integer;
begin
WriteLn( 'Derangements of 4 integers');
nrFound := FindDerangements( 4, true);
WriteLn( 'Number of derangements found = ', nrFound);
WriteLn();
WriteLn( 'Number of derangements');
WriteLn( ' n Found Subfactorial');
for n := 0 to 9 do begin
nrFound := FindDerangements( n, false);
nrCalc := Subfactorial( n);
WriteLn( n:3, nrFound:8, nrCalc:8);
end;
WriteLn();
WriteLn( 'Subfactorial(20) = ', Subfactorial(20));
end.
</syntaxhighlight>
{{out}}
<pre>
Derangements of 4 integers
1 0 3 2
1 2 3 0
1 3 0 2
2 0 3 1
2 3 0 1
2 3 1 0
3 0 1 2
3 2 0 1
3 2 1 0
Number of derangements found = 9
 
Number of derangements
n Found Subfactorial
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
Subfactorial(20) = 895014631192902121
</pre>
 
=={{header|Perl}}==
===Traditional verbose version===
<langsyntaxhighlight Perllang="perl">sub d {
# compare this with the deranged() sub to see how to turn procedural
# code into functional one ('functional' as not in 'understandable')
Line 2,260 ⟶ 2,961:
 
print "\nNumber of derangements:\n";
print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</langsyntaxhighlight>
 
{{out}}
Line 2,310 ⟶ 3,011:
===Using a module===
{{libheader|ntheory}}
<langsyntaxhighlight lang="perl">use ntheory ":all";
 
# Count derangements using derangement iterator
Line 2,334 ⟶ 3,035:
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;</langsyntaxhighlight>
{{out}}
<pre>
Line 2,365 ⟶ 3,066:
=={{header|Phix}}==
{{libheader|Phix/mpfr}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function deranged(sequence s1, sequence s2)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
for i=1 to length(s1) do
<span style="color: #008080;">function</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">s2</span><span style="color: #0000FF;">)</span>
if s1[i]==s2[i] then return 0 end if
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<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>
return 1
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function derangements(integer n)
sequence ts = tagset(n)
<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>
sequence res = {}
<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>
for i=1 to factorial(n) do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
sequence s = permute(i,ts)
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if deranged(s,ts) then
<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>
res = append(res,s)
<span style="color: #008080;">if</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ts</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
end if
<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>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function subfactorial(integer n)
if n<2 then return 1-n end if
<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>
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
<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>
end function
<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>
?derangements(4)
for n=0 to 9 do
<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>
printf(1,"%d: counted:%d, calculated:%d\n",{n,length(derangements(n)),subfactorial(n)})
<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>
end for
<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>
string msg = iff(machine_bits()=32?" (incorrect on 32-bit!)":"") -- (fine on 64-bit)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
printf(1,"!20=%d%s\n",{subfactorial(20),msg})
<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>
include mpfr.e
function mpz_sub_factorial(integer n)
<span style="color: #008080;">include</span> <span style="color: #004080;">mpfr</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
-- probably not the most efficient way to do this!
<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>
if n<2 then return sprintf("%d",{1-n}) end if
<span style="color: #000080;font-style:italic;">-- probably not the most efficient way to do this!</span>
mpz f = mpz_init(mpz_sub_factorial(n-1)),
<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>
g = mpz_init(mpz_sub_factorial(n-2))
<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>
mpz_add(f,f,g)
<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>
mpz_mul_si(f,f,n-1)
<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>
string res = mpz_get_str(f)
<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>
{f,g} = mpz_free({f,g})
<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>
return res
<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>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
printf(1,"!20=%s (mpfr)\n",{mpz_sub_factorial(20)})</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"!20=%s (mpfr)\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">mpz_sub_factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">)})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 2,425 ⟶ 3,129:
!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)-->
<lang Phix>include mpfr.e
<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>
function subfactorial(integer n)
sequence res = repeat(0,n)
<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>
mpz num = mpz_init(1)
<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>
for i=1 to n do
mpz_mul_si(num,num,i)
<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>
if mpz_odd(num) then
<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>
mpz_sub_ui(num,num,1)
<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>
else
<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>
mpz_add_ui(num,num,1)
<span style="color: #008080;">else</span>
end if
<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>
res[i] = mpz_get_str(num)
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
-- res[i] = mpz_init_set(num)
<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>
end for
<span style="color: #000080;font-style:italic;">-- res[i] = mpz_init_set(num)</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
?extract(subfactorial(20),tagset(9)&20)</lang>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">extract</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">)&</span><span style="color: #000000;">20</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>{"0","1","2","9","44","265","1854","14833","133496","895014631192902121"}</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">import util.
 
go =>
foreach(N in 0..9)
println([N,num_derangements=num_derangements(N), subfactorial=subfactorial(N), subfactorial2=subfactorial2(N)])
end,
println(["!20", subfactorial(20)]),
println(["!20 approx", subfactorial2(20)]),
println("subfactorial0..30"=[subfactorial(N) : N in 0..30 ]),
println("subfactorial2_0..30"=[subfactorial2(N) : N in 0..30 ]),
println(["!200", subfactorial(200)]),
nl,
println("Syntax sugar:"),
println("'!'(20)"='!'(20)),
println("200.'!'()"=200.'!'()),
println("'!!'(20)"='!!'(20)),
println("'!-!!'(10)"='!-!!'(10)),
nl.
 
num_derangements(N) = derangements(N).length.
 
derangements(N) = D =>
D = [P : P in permutations(1..N), nofixpoint(P)].
 
% subfactorial: tabled recursive function
table
subfactorial(0) = 1.
subfactorial(1) = 0.
subfactorial(N) = (N-1)*(subfactorial(N-1)+subfactorial(N-2)).
 
% approximate version of subfactorial
subfactorial2(0) = 1.
subfactorial2(N) = floor(1.0*floor(factorial(N)/2.71828 + 1/2.0)).
 
% Factorial
fact(N) = F =>
F1 = 1,
foreach(I in 1..N)
F1 := F1 * I
end,
F = F1.
 
% No fixpoint in L
nofixpoint(L) =>
foreach(I in 1..L.length)
L[I] != I
end.
 
% Some syntax sugar. Note: the function must be an atom.
'!'(N) = fact(N).
'!!'(N) = subfactorial(N).
 
'!-!!'(N) = fact(N) - subfactorial(N).</syntaxhighlight>
 
{{out}}
<pre>[0,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[1,num_derangements = 0,subfactorial = 0,subfactorial2 = 0]
[2,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[3,num_derangements = 2,subfactorial = 2,subfactorial2 = 2]
[4,num_derangements = 9,subfactorial = 9,subfactorial2 = 9]
[5,num_derangements = 44,subfactorial = 44,subfactorial2 = 44]
[6,num_derangements = 265,subfactorial = 265,subfactorial2 = 265]
[7,num_derangements = 1854,subfactorial = 1854,subfactorial2 = 1854]
[8,num_derangements = 14833,subfactorial = 14833,subfactorial2 = 14833]
[9,num_derangements = 133496,subfactorial = 133496,subfactorial2 = 133496]
[!20,895014631192902121]
[!20 approx,895015233227128960]
subfactorial0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334961,14684570,176214841,2290792932,32071101049,481066515734,7697064251745,130850092279664,2355301661033953,44750731559645106,895014631192902121,18795307255050944540,413496759611120779881,9510425471055777937262,228250211305338670494289,5706255282633466762357224,148362637348470135821287825,4005791208408693667174771274,112162153835443422680893595673,3252702461227859257745914274516,97581073836835777732377428235481]
subfactorial2_0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334962,14684580,176214959,2290794473,32071122622,481066839325,7697069429198,130850180296364,2355303245334550,44750761661356448,895015233227128960,18795319897769705472,413497037750933585920,9510431868271472934912,228250364838515316883456,5706259120962883593175040,148362737145034969127583744,4005793902915943736948031488,112162229281646435629661159424,3252704649167746668444545712128,97581139475032389920237209780224]
[!200,290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201]
 
Syntax sugar:
'!'(20) = 2432902008176640000
200.'!'() = 788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000
'!!'(20) = 895014631192902121
'!-!!'(10) = 2293839</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l") # For 'permute'
 
(de derangements (Lst)
Line 2,465 ⟶ 3,250:
(*
(dec N)
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</langsyntaxhighlight>
{{out}}
<pre>: (derangements (range 1 4))
Line 2,492 ⟶ 3,277:
=={{header|PureBasic}}==
Brute Force
<syntaxhighlight lang="purebasic">
<lang PureBasic>
Procedure.q Subfactoral(n)
If n=0:ProcedureReturn 1:EndIf
Line 2,616 ⟶ 3,401:
DeleteFile(tempFile.s)
Return
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,655 ⟶ 3,440:
 
{{trans|C}}
<langsyntaxhighlight PureBasiclang="purebasic">Procedure.i deranged(depth, lenn, Array d(1), show)
Protected count, tmp, i
If depth = lenn
Line 2,705 ⟶ 3,490:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
 
{{out}}
Line 2,746 ⟶ 3,531:
=={{header|Python}}==
Includes stretch goal.
<langsyntaxhighlight lang="python">from itertools import permutations
import math
 
Line 2,786 ⟶ 3,571:
 
n = 20
print("\n!%i = %i" % (n, subfact(n)))</langsyntaxhighlight>
 
{{out}}
Line 2,813 ⟶ 3,598:
 
!20 = 895014631192902121</pre>
 
=={{header|QBasic}}==
{{works with|QBasic|1.1}}
{{trans|FreeBASIC}}
Error "Subscript out of scope" for n > 7
<syntaxhighlight lang="qbasic">' Heap's algorithm non-recursive
FUNCTION permsderange (n!, flag!)
IF n = 0 THEN permsderange = 1
DIM a!(0 TO n), c!(0 TO n)
FOR j = 0 TO n - 1: a(j) = j: NEXT j
WHILE i < n
IF c(i) < i THEN
IF (i AND 1) = 0 THEN
SWAP a(0), a(i)
ELSE
SWAP a(c(i)), a(i)
END IF
FOR j = 0 TO n - 1
IF a(j) = j THEN j = 99
NEXT j
IF j < 99 THEN
count = count + 1
IF flag = 0 THEN
c1 = c1 + 1
FOR j = 0 TO n - 1
PRINT a(j);
NEXT j
IF c1 > 12 THEN
PRINT : c1 = 0
ELSE
PRINT
END IF
END IF
END IF
c(i) = c(i) + 1
i = 0
ELSE
c(i) = 0
i = i + 1
END IF
WEND
IF flag = 0 AND c1 <> 0 THEN PRINT
permsderange = count
END FUNCTION
 
SUB Subfactorial (a!())
FOR i = 0 TO UBOUND(a)
num = num * i
IF (i AND 1) = 1 THEN
num = num - 1
ELSE
num = num + 1
END IF
a(i) = num
NEXT i
END SUB
 
n! = 4
DIM subfac!(7)
 
CALL Subfactorial(subfac())
 
PRINT "permutations derangements for n = "; n
i! = permsderange(n, 0)
PRINT "count returned ="; i; " , !"; n; " calculated ="; subfac(n)
 
PRINT
PRINT "count counted subfactorial"
PRINT "---------------------------"
FOR i = 0 TO 7
PRINT USING " ###: ######## ########"; i; permsderange(i, 1); subfac(i)
NEXT i</syntaxhighlight>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="quackery">
[ stack ] is deranges.num ( --> [ )
 
forward is (deranges)
[ over size
deranges.num share = iff
[ over temp take
swap nested join
temp put ]
else
[ dup size times
[ 2dup i^ pluck
dip [ over size ]
tuck != iff
[ rot swap
nested join
swap (deranges) ]
else
[ drop 2drop ] ] ]
2drop ] resolves (deranges) ( [ [ --> )
 
[ dup deranges.num put
[] swap times [ i^ join ]
[] temp put
[] swap (deranges)
temp take
deranges.num release ] is derangements ( n --> [ )
 
[ dup 0 = iff [ drop 1 ] done
1 0 rot
1 - times
[ swap over + i^ 1+ * ]
nip ] is sub! ( n --> n )
 
4 derangements witheach [ echo cr ]
cr
10 times
[ i^ echo sp
i^ derangements size echo sp
i^ sub! echo cr ]
cr
20 sub! echo</syntaxhighlight>
 
{{out}}
 
<pre>[ 1 0 3 2 ]
[ 1 2 3 0 ]
[ 1 3 0 2 ]
[ 2 0 3 1 ]
[ 2 3 0 1 ]
[ 2 3 1 0 ]
[ 3 0 1 2 ]
[ 3 2 0 1 ]
[ 3 2 1 0 ]
 
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
895014631192902121</pre>
 
=={{header|Racket}}==
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 2,863 ⟶ 3,793:
(sub-fact 20)
;; -> 895014631192902121
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
Line 2,878 ⟶ 3,808:
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" perl6line>sub derangements(@l) {
@l.permutations.grep(-> @p { none(@p Zeqv @l) })
}
Line 2,892 ⟶ 3,822:
for 0 .. 9 -> $n {
say "!$n == { !$n } == { derangements(^$n).elems }"
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,910 ⟶ 3,840:
!9 == 133496 == 133496
</pre>
 
Much faster to just calculate the subfactorial.
<syntaxhighlight lang="raku" line>my @subfactorial = 1,0,{++$ × ($^a + $^b)}…*;
 
say "!$_: ",@subfactorial[$_] for |^10, 20, 200;</syntaxhighlight>
{{out}}
<pre>!0: 1
!1: 0
!2: 1
!3: 2
!4: 9
!5: 44
!6: 265
!7: 1854
!8: 14833
!9: 133496
!20: 895014631192902121
!200: 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201</pre>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX 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.*/
Line 2,953 ⟶ 3,901:
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</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 2,977 ⟶ 3,925:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">def derangements(n)
ary = (1 .. n).to_a
ary.permutation.select do |perm|
Line 3,003 ⟶ 3,951:
(10..20).each do |n|
puts "#{n} : #{subfact(n)}"
end</langsyntaxhighlight>
 
{{out}}
Line 3,045 ⟶ 3,993:
=={{header|Scala}}==
{{trans|Ruby}}
<langsyntaxhighlight Scalalang="scala">def derangements(n: Int) =
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
 
Line 3,059 ⟶ 4,007:
println("\n%2s%10s%10s".format("n", "derange", "subfact"))
(0 to 9).foreach(n => println("%2d%10d%10d".format(n, derangements(n).size, subfactorial(n))))
(10 to 20).foreach(n => println(f"$n%2d${subfactorial(n)}%20d"))</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4
Line 3,096 ⟶ 4,044:
 
=={{header|SuperCollider}}==
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
d = { |array, n|
Routine {
Line 3,111 ⟶ 4,059:
x = f.(4);
x.all.do(_.postln); "";
)</langsyntaxhighlight>
 
Answers:
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
[ 3, 2, 1, 0 ]
[ 2, 3, 0, 1 ]
Line 3,124 ⟶ 4,072:
[ 2, 3, 1, 0 ]
[ 3, 0, 1, 2 ]
</syntaxhighlight>
</lang>
 
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
z = { |n|
case
Line 3,140 ⟶ 4,088:
"% % %\n".postf(i, p.(derangements.size), p.(subfactorial));
};
)</langsyntaxhighlight>
 
Answers:
 
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
n derangements subfactorial
0 1 1
Line 3,156 ⟶ 4,104:
8 14833 14833
9 133496 133496
</syntaxhighlight>
</lang>
 
=={{header|Tcl}}==
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5; # for arbitrary-precision integers
package require struct::list; # for permutation enumerator
 
Line 3,196 ⟶ 4,144:
}
return $s
}</langsyntaxhighlight>
Demonstrating with the display parts of the task:
<langsyntaxhighlight lang="tcl">foreach d [deranged1to 4] {
puts "derangement of 1..4: $d"
}
Line 3,208 ⟶ 4,156:
 
# Stretch goal
puts "\n!20 = [subfact 20]"</langsyntaxhighlight>
{{out}}
<pre>
Line 3,232 ⟶ 4,180:
!8 14833 14833
!9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
{{libheader|Wren-big}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
import "./big" for BigInt
 
var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
var perms = []
var toInsert = input[0]
for (perm in permute.call(input[1..-1])) {
for (i in 0..perm.count) {
var newPerm = perm.toList
newPerm.insert(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
 
var derange = Fn.new { |input|
if (input.isEmpty) return [input]
var perms = permute.call(input)
var derangements = []
for (perm in perms) {
var deranged = true
for (i in 0...perm.count) {
if (perm[i] == i) {
deranged = false
break
}
}
if (deranged) derangements.add(perm)
}
return derangements
}
 
var subFactorial // recursive
subFactorial = Fn.new { |n|
if (n == 0) return BigInt.one
if (n == 1) return BigInt.zero
return (subFactorial.call(n-1) + subFactorial.call(n-2)) * (n - 1)
}
 
var input = [0, 1, 2, 3]
var derangements = derange.call(input)
System.print("There are %(derangements.count) derangements of %(input), namely:\n")
System.print(derangements.join("\n"))
 
System.print("\nN Counted Calculated")
System.print("- ------- ----------")
for (n in 0..9) {
var list = List.filled(n, 0)
for (i in 0...n) list[i] = i
var counted = derange.call(list).count
Fmt.print("$d $-9d $-9i", n, counted, subFactorial.call(n))
}
System.print("\n!20 = %(subFactorial.call(20))")</syntaxhighlight>
 
{{out}}
<pre>
There are 9 derangements of [0, 1, 2, 3], namely:
 
[1, 2, 3, 0]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[1, 0, 3, 2]
[1, 3, 0, 2]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]
 
N Counted Calculated
- ------- ----------
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
Line 3,238 ⟶ 4,277:
=={{header|zkl}}==
{{trans|Python}} mostly
<langsyntaxhighlight lang="zkl">fcn subFact(n){
if(n==0) return(1);
if(n==1) return(0);
Line 3,256 ⟶ 4,295:
sum + (perm.zipWith('==,enum).sum(0) == 0)
},0);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">println("Derangements of 0,1,2,3:\n",derangements(4));
println("\nTable of n vs counted vs calculated derangements:");
foreach n in (10){
Line 3,263 ⟶ 4,302:
}
 
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));</langsyntaxhighlight>
{{out}}
<pre>
Line 3,285 ⟶ 4,324:
</pre>
Lazy/iterators version:
<langsyntaxhighlight lang="zkl">fcn derangements(n){ //-->Walker
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
Line 3,294 ⟶ 4,333:
fcn derangers(n){ // just count # of derangements, w/o saving them
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">foreach d in (derangements(4)){ println(d) }
//rest of test code remains the same</langsyntaxhighlight>
10,327

edits