Rosetta Code

Permutations/Derangements: Difference between revisions

Page Discussion

Permutations/Derangements (view source)

Revision as of 00:14, 17 April 2024

52,154 bytes added ,  1 month ago
m
→‎{{header|Raku}}: Add a version using subfactorials
(→‎{{header|Kotlin}}: Updated example see https://github.com/dkandalov/rosettacode-kotlin for details)
m (→‎{{header|Raku}}: Add a version using subfactorials)
 
(47 intermediate revisions by 24 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 308 ⟶ 367:
</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 364 ⟶ 526:
end loop;
Put_Line ("!20 = " & U64'Image (sub_fact (20)));
end DePermute;</langsyntaxhighlight>
{{out}}
<pre>Deranged 4:
Line 388 ⟶ 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 487 ⟶ 714:
a *= A_Index
return a
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for 1, 2, 3, 4:
Line 513 ⟶ 740:
 
Approximation of !20: 895014631192902144</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight BBClang="bbc BASICbasic"> PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
Line 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 831 ⟶ 1,059:
19: 44750731559645106
20: 895014631192902121</pre>
 
=={{header|C sharp|C#}}==
Recursive version
 
<syntaxhighlight lang="csharp">
using System;
class Derangements
{
static int n = 4;
static int [] buf = new int [n];
static bool [] used = new bool [n];
 
static void Main()
{
for (int i = 0; i < n; i++) used [i] = false;
rec(0);
}
 
static void rec(int ind)
{
for (int i = 0; i < n; i++)
{
if (!used [i] && i != ind)
{
used [i] = true;
buf [ind] = i;
if (ind + 1 < n) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
used [i] = false;
}
}
}
}
</syntaxhighlight>
 
=={{header|C++}}==
<syntaxhighlight lang="c++">
#include <cstdint>
#include <iomanip>
#include <iostream>
#include <numeric>
#include <vector>
 
typedef std::pair<std::vector<std::vector<int32_t>>, int32_t> list_or_count;
 
uint64_t factorial(const int32_t& n) {
uint64_t result = 1;
for ( int32_t i = 2; i <= n; ++i ) {
result *= i;
}
return result;
}
 
uint64_t subfactorial(const int32_t& n) {
if ( n >= 0 && n <= 2 ) {
return ( n == 1 ) ? 0 : 1;
}
return ( n - 1 ) * ( subfactorial(n - 1) + subfactorial(n - 2) );
}
 
list_or_count derangements(const int32_t& n, const bool& count_only) {
std::vector<int32_t> sequence(n, 0);
std::iota(sequence.begin() ,sequence.end(), 1);
std::vector<int32_t> original(sequence);
uint64_t permutation_count = factorial(n);
 
std::vector<std::vector<int32_t>> list;
int32_t count = ( n == 0 ) ? 1 : 0;
 
while ( --permutation_count > 0 ) {
int32_t j = n - 2;
while ( sequence[j] > sequence[j + 1] ) {
j--;
}
int32_t k = n - 1;
while ( sequence[j] > sequence[k] ) {
k--;
}
std::swap(sequence[j], sequence[k]);
 
int32_t r = n - 1;
int32_t s = j + 1;
while ( r > s ) {
std::swap(sequence[r], sequence[s]);
r--;
s++;
}
 
j = 0;
while ( j < n && sequence[j] != original[j] ) {
j++;
}
if ( j == n ) {
if ( count_only ) {
count++;
} else {
std::vector<int32_t> copy_sequence(sequence);
list.emplace_back(copy_sequence);
}
}
}
return list_or_count(list, count);
}
 
int main() {
std::cout << "Derangements for n = 4" << std::endl;
list_or_count list_count = derangements(4, false);
for ( std::vector<int32_t> list : list_count.first ) {
std::cout << "[";
for ( uint64_t i = 0; i < list.size() - 1; ++i ) {
std::cout << list[i] << ", ";
}
std::cout << list.back() << "]" << std::endl;
}
std::cout << std::endl;
 
std::cout << "n derangements !n" << std::endl;
std::cout << "------------------------" << std::endl;
for ( int32_t n = 0; n < 10; ++n ) {
int32_t count = derangements(n, true).second;
std::cout << n << ": " << std::setw(9) << count << " " << std::setw(9) << subfactorial(n) << std::endl;
}
std::cout << std::endl;
 
std::cout << "!20 = " << subfactorial(20) << std::endl;
}
</syntaxhighlight>
{{ out }}
<pre>
Derangements for n = 4
[2, 1, 4, 3]
[2, 3, 4, 1]
[2, 4, 1, 3]
[3, 1, 4, 2]
[3, 4, 1, 2]
[3, 4, 2, 1]
[4, 1, 2, 3]
[4, 3, 1, 2]
[4, 3, 2, 1]
 
n derangements !n
------------------------
0: 1 1
1: 0 0
2: 1 1
3: 2 2
4: 9 9
5: 44 44
6: 265 265
7: 1854 1854
8: 14833 14833
9: 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|Clojure}}==
Generating functions with no fixed point
 
<syntaxhighlight lang="clojure">(ns derangements.core
(:require [clojure.set :as s]))
 
(defn subfactorial [n]
(case n
0 1
1 0
(* (dec n) (+ (subfactorial (dec n)) (subfactorial (- n 2))))))
 
(defn no-fixed-point
"f : A -> B must be a biyective function written as a hash-map, returns
all g : A -> B such that (f(a) = b) => not(g(a) = b)"
[f]
(case (count f)
0 [{}]
1 []
(let [g (s/map-invert f)
a (first (keys f))
a' (f a)]
(mapcat
(fn [b'] (let [b (g b')
f' (dissoc f a b)]
(concat (map #(reduce conj % [[a b'] [b a']])
(no-fixed-point f'))
(map #(conj % [a b'])
(no-fixed-point (assoc f' b a'))))))
(filter #(not= a' %) (keys g))))))
 
(defn derangements [xs]
{:pre [(= (count xs) (count (set xs)))]}
(map (fn [f] (mapv f xs))
(no-fixed-point (into {} (map vector xs xs)))))
(defn -main []
(do
(doall (map println (derangements [0,1,2,3])))
(doall (map #(println (str (subfactorial %) " " (count (derangements (range %)))))
(range 10)))
(println (subfactorial 20))))
</syntaxhighlight>
{{Out}}
<pre>[1 0 3 2]
[1 2 3 0]
[1 3 0 2]
[2 3 0 1]
[2 3 1 0]
[2 0 3 1]
[3 2 1 0]
[3 2 0 1]
[3 0 1 2]
1 1
0 0
1 1
2 2
9 9
44 44
265 265
1854 1854
14833 14833
133496 133496
895014631192902121</pre>
 
=={{header|Common Lisp}}==
{{trans|Acornsoft Lisp}}
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((= n 0) 1)
((= n 1) 0)
(t (* (- n 1)
(+ (subfact (- n 1))
(subfact (- n 2)))))))
 
(defun count-derangements (n)
(let ((count 0))
(visit-derangements (range 1 n)
(lambda (d) (declare (ignore d)) (incf count)))
count))
 
(defun visit-derangements (items visitor)
(visit-permutations items
(lambda (p)
(when (derangement-p items p)
(funcall visitor p)))))
 
(defun derangement-p (original d)
(notany #'equal original d))
 
(defun visit-permutations (items visitor)
(labels
((vp (items perm)
(cond ((null items)
(funcall visitor (reverse perm)))
(t
(mapc (lambda (i)
(vp (remove i items)
(cons i perm)))
items)))))
(vp items '())))
 
(defun range (start end)
(loop for i from start to end collect i))
 
(defun examples ()
(show-derangements '(1 2 3 4))
(format t "~%n counted !n~%")
(dotimes (i 10)
(format t "~S ~7@S ~7@S~%"
i
(count-derangements i)
(subfact i)))
(format t "~%!20 = ~S~2%" (subfact 20)))
 
(defun show-derangements (items)
(format t "~%Derangements of ~S~%" items)
(visit-derangements items
(lambda (d)
(format t " ~S~%" d))))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> would output:
 
<pre>
Derangements of (1 2 3 4)
(2 1 4 3)
(2 3 4 1)
(2 4 1 3)
(3 1 4 2)
(3 4 1 2)
(3 4 2 1)
(4 1 2 3)
(4 3 1 2)
(4 3 2 1)
 
n counted !n
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|D}}==
===Iterative Version===
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.conv,
std.range, std.traits;
 
Line 898 ⟶ 1,436:
 
writefln("\n!20 = %s", 20L.subfact);
}</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4:
Line 928 ⟶ 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 974 ⟶ 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 998 ⟶ 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,021 ⟶ 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,053 ⟶ 1,639:
Enum.each(10..20, fn n ->
:io.format "~2w :~19w~n", [n, Permutation.subfact(n)]
end)</langsyntaxhighlight>
 
{{out}}
Line 1,092 ⟶ 1,678:
20 : 895014631192902121
</pre>
 
=={{header|F_Sharp|F#}}==
===The Function===
<syntaxhighlight lang="fsharp">
// Generate derangements. Nigel Galloway: July 9th., 2019
let derange n=
let fG n i g=let e=Array.copy n in e.[i]<-n.[g]; e.[g]<-n.[i]; e
let rec derange n g α=seq{
match (α>0,n&&&(1<<<α)=0) with
(true,true)->for i in [0..α-1] do if n&&&(1<<<i)=0 then let g=(fG g α i) in yield! derange (n+(1<<<i)) g (α-1); yield! derange n g (α-1)
|(true,false)->yield! derange n g (α-1)
|(false,false)->yield g
|_->()}
derange 0 [|1..n|] (n-1)
</syntaxhighlight>
===The Task===
<syntaxhighlight lang="fsharp">
derange 4 |> Seq.iter(printfn "%A")
</syntaxhighlight>
{{out}}
<pre>
[|4; 3; 2; 1|]
[|2; 3; 4; 1|]
[|3; 4; 2; 1|]
[|3; 4; 1; 2|]
[|4; 3; 1; 2|]
[|3; 1; 4; 2|]
[|2; 1; 4; 3|]
[|2; 4; 1; 3|]
[|4; 1; 2; 3|]
</pre>
<syntaxhighlight lang="fsharp">
let subFact n=let rec fN n g=match n with 0m->int64(round(g/2.7182818284590452353602874713526624978m))|_->fN (n-1m) (g*n) in if n=0 then 1L else fN (decimal n) 1m
[1..9] |> Seq.iter(fun n->printfn "items=%d !n=%d derangements=%d" n (subFact n) (derange n|>Seq.length))
</syntaxhighlight>
{{out}}
<pre>
items=1 !n=0 derangements=0
items=2 !n=1 derangements=1
items=3 !n=2 derangements=2
items=4 !n=9 derangements=9
items=5 !n=44 derangements=44
items=6 !n=265 derangements=265
items=7 !n=1854 derangements=1854
items=8 !n=14833 derangements=14833
items=9 !n=133496 derangements=133496
</pre>
 
=={{header|Factor}}==
{{works with|Factor|0.98}}
<syntaxhighlight lang="factor">USING: combinators formatting io kernel math math.combinatorics
prettyprint sequences ;
IN: rosetta-code.derangements
 
: !n ( n -- m )
{
{ 0 [ 1 ] }
{ 1 [ 0 ] }
[ [ 1 - !n ] [ 2 - !n + ] [ 1 - * ] tri ]
} case ;
 
: derangements ( n -- seq )
<iota> dup [ [ = ] 2map [ f = ] all? ] with
filter-permutations ;
 
"4 derangements" print 4 derangements . nl
"n count calc\n= ====== ======" print
10 <iota> [
dup [ derangements length ] [ !n ] bi
"%d%8d%8d\n" printf
] each nl
"!20 = " write 20 !n .</syntaxhighlight>
{{out}}
<pre>
4 derangements
V{
{ 1 0 3 2 }
{ 1 2 3 0 }
{ 1 3 0 2 }
{ 2 0 3 1 }
{ 2 3 0 1 }
{ 2 3 1 0 }
{ 3 0 1 2 }
{ 3 2 0 1 }
{ 3 2 1 0 }
}
 
n count calc
= ====== ======
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' version 08-04-2017
' compile with: fbc -s console
 
Line 1,186 ⟶ 1,875:
Print : Print "hit any key to end program"
Sleep
End</langsyntaxhighlight>
{{out}}
<pre>permutations derangements for n = 4
Line 1,217 ⟶ 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,251 ⟶ 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,323 ⟶ 2,013:
// stretch (sic)
fmt.Println("\n!20 =", subFact(20))
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,355 ⟶ 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,363 ⟶ 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,381 ⟶ 2,071:
println """
!20 == ${subfact(20)}
"""</langsyntaxhighlight>
 
{{out}}
Line 1,411 ⟶ 2,101:
=={{header|Haskell}}==
 
<langsyntaxhighlight Haskelllang="haskell">import Control.Monad (forM_)
 
import Data.List (permutations)
Line 1,443 ⟶ 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,461 ⟶ 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,470 ⟶ 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,499 ⟶ 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,505 ⟶ 2,195:
=={{header|Java}}==
{{trans|D}}
<langsyntaxhighlight lang="java">import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
Line 1,599 ⟶ 2,289:
return r;
}
}</langsyntaxhighlight>
 
<pre>derangements for n = 4
Line 1,631 ⟶ 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,654 ⟶ 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,662 ⟶ 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,689 ⟶ 2,379:
9: 133496 vs 133496
 
Computed approximation to !20 (15 significant digits): 895014631192902000</langsyntaxhighlight>
 
=={{header|Julia}}==
<syntaxhighlight lang="julia">using Printf, Combinatorics
 
derangements(n::Int) = (perm for perm in permutations(1:n)
if all(indx != p for (indx, p) in enumerate(perm)))
 
function subfact(n::Integer)::Integer
if n in (0, 2)
return 1
elseif n == 1
return 0
elseif 1 ≤ n ≤ 18
return round(Int, factorial(n) / e)
elseif n > 0
return (n - 1) * ( subfact(n - 1) + subfact(n - 2) )
else
error()
end
end
 
println("Derangements of [1, 2, 3, 4]")
for perm in derangements(4)
println(perm)
end
 
@printf("\n%5s%13s%13s\n", "n", "derangements", "!n")
for n in 1:10
ders = derangements(n)
subf = subfact(n)
@printf("%5i%13i%13i\n", n, length(collect(ders)), subf)
end
 
println("\n!20 = ", subfact(20))</syntaxhighlight>
 
{{out}}
<pre>Derangements of [1, 2, 3, 4]
[2, 1, 4, 3]
[2, 3, 4, 1]
[2, 4, 1, 3]
[3, 1, 4, 2]
[3, 4, 1, 2]
[3, 4, 2, 1]
[4, 1, 2, 3]
[4, 3, 1, 2]
[4, 3, 2, 1]
 
n derangements !n
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
10 1334961 1334961
 
!20 = 895014631192902121</pre>
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun <T> permute(input: List<T>): List<List<T>> {
Line 1,736 ⟶ 2,487:
}
println("\n!20 = ${subFactorial(20)}")
}</langsyntaxhighlight>
 
{{out}}
Line 1,769 ⟶ 2,520:
 
=={{header|Lua}}==
<langsyntaxhighlight Lualang="lua">-- Return an iterator to produce every permutation of list
function permute (list)
local function perm (list, n)
Line 1,837 ⟶ 2,588:
print("\t| " .. #derangements(listOneTo(i)))
end
print("\n\nThe subfactorial of 20 is " .. subFact(20))</langsyntaxhighlight>
{{out}}
<pre>Derangements of [1,2,3,4]
Line 1,869 ⟶ 2,620:
The subfactorial of 20 is 8.950146311929e+17</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
<lang Mathematica>
Needs["Combinatorica`"]
derangements[n_] := Derangements[Range[n]]
derangements[4]
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm
Subfactorial[20]</langsyntaxhighlight>
{{out}}
<pre>
Line 1,892 ⟶ 2,643:
 
895014631192902121</pre>
 
=={{header|Nim}}==
<syntaxhighlight lang="nim">import algorithm, sequtils, strformat, strutils, tables
 
iterator derangements[T](a: openArray[T]): seq[T] =
var perm = @a
while true:
if not perm.nextPermutation():
break
block checkDerangement:
for i, val in a:
if perm[i] == val: break checkDerangement
yield perm
 
proc `!`(n: Natural): Natural =
if n <= 1: return 1 - n
result = (n - 1) * (!(n - 1) + !(n - 2))
 
echo "Derangements of 1 2 3 4:"
for d in [1, 2, 3, 4].derangements():
echo d.join(" ")
 
echo "\nNumber of derangements:"
echo "n counted calculated"
echo "- ------- ----------"
for n in 0..9:
echo &"{n} {toSeq(derangements(toSeq(1..n))).len:>6} {!n:>6}"
 
echo "\n!20 = ", !20</syntaxhighlight>
 
{{out}}
<pre>Derangements of 1 2 3 4:
2 1 4 3
2 3 4 1
2 4 1 3
3 1 4 2
3 4 1 2
3 4 2 1
4 1 2 3
4 3 1 2
4 3 2 1
 
Number of derangements:
n counted calculated
- ------- ----------
0 0 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121</pre>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">derangements(n)=if(n,round(n!/exp(1)),1);
derange(n)={
my(v=[[]],tmp);
Line 1,912 ⟶ 2,720:
derange(4)
for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n)))
derangements(20)</langsyntaxhighlight>
{{out}}
<pre>%1 = [[2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1]]
Line 1,928 ⟶ 2,736:
 
%2 = 895014631192902121</pre>
 
=={{header|Pascal}}==
<syntaxhighlight lang="pascal">
program Derangements_RC;
(*
Pascal solution for Rosetta Code task "Permutations/Derangements"
Console program written in Free Pascal (Lazarus)
*)
// Returns first derangement in lexicographic order.
// Function return is false if there are no derangements.
function FirstDerangement( var val : array of integer) : boolean;
var
n, j : integer;
begin
n := Length( val);
result := (n <> 1);
if n < 2 then exit;
if Odd(n) then begin
val[n - 3] := n - 2;
val[n - 2] := n - 1;
val[n - 1] := n - 3;
dec( n, 3);
end;
j := 0;
while (j < n) do begin
val[j] := j + 1;
val[j + 1] := j;
inc( j, 2);
end;
end;
 
// Returns next derangement in lexicographic order.
// Function return is false if there are no more derangements.
// Finds next derangement directly, i.e. not by generating
// permutations until a derangement is found.
function NextDerangement( var val : array of integer) : boolean;
var
i, j, n : integer;
backward, done : boolean;
free : array of boolean;
begin
n := Length( val);
if (n < 3) then begin
result := false;
exit;
end;
SetLength( free, n);
for j := 0 to n - 1 do free[j] := false;
i := n - 1;
free[val[i]] := true;
backward := true;
done := false;
repeat
if backward then begin
dec(i); j := val[i]; free[j] := true;
end
else begin
inc(i); j := -1;
end;
repeat
inc(j)
until (j >= n) or (free[j] and (j <> i));
if (j < n) then begin // found a suitable free value
val[i] := j; free[j] := false;
if (i = n - 1) then done := true // found the next derangement
else backward := false;
end
else if (i = 0) then done := true // no more derangements
else backward := true;
until done;
result := (i > 0);
end;
 
// Finds all derangements of integers 0..(n - 1) and
// returns the number of derangements.
// if boolean "show" is true, writes derangments to standard output.
function FindDerangements( n : integer;
show : boolean) : integer;
var
int_array : array of integer;
j : integer;
ok : boolean;
begin
result := 0;
if (n < 0) then exit;
SetLength( int_array, n);
ok := FirstDerangement( int_array);
while ok do begin
inc( result);
if show then begin
for j := 0 to n - 1 do Write( ' ', int_array[j]);
WriteLn();
end;
ok := NextDerangement( int_array);
end;
end;
 
// Returns subfactorial of passed-in integer.
function Subfactorial( n : integer) : uint64;
var
j : integer;
begin
result := 1;
for j := 1 to n do begin
result := result*j;
if Odd(j) then dec(result) else inc(result);
end;
end;
 
// Main routine for Rosetta Code task.
var
n, nrFound, nrCalc : integer;
begin
WriteLn( 'Derangements of 4 integers');
nrFound := FindDerangements( 4, true);
WriteLn( 'Number of derangements found = ', nrFound);
WriteLn();
WriteLn( 'Number of derangements');
WriteLn( ' n Found Subfactorial');
for n := 0 to 9 do begin
nrFound := FindDerangements( n, false);
nrCalc := Subfactorial( n);
WriteLn( n:3, nrFound:8, nrCalc:8);
end;
WriteLn();
WriteLn( 'Subfactorial(20) = ', Subfactorial(20));
end.
</syntaxhighlight>
{{out}}
<pre>
Derangements of 4 integers
1 0 3 2
1 2 3 0
1 3 0 2
2 0 3 1
2 3 0 1
2 3 1 0
3 0 1 2
3 2 0 1
3 2 1 0
Number of derangements found = 9
 
Number of derangements
n Found Subfactorial
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
Subfactorial(20) = 895014631192902121
</pre>
 
=={{header|Perl}}==
===Traditional verbose version===
<lang Perl>sub d {
<syntaxhighlight lang="perl">sub d {
# compare this with the deranged() sub to see how to turn procedural
# code into functional one ('functional' as not in 'understandable')
Line 1,995 ⟶ 2,961:
 
print "\nNumber of derangements:\n";
print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</langsyntaxhighlight>
 
{{out}}
Line 2,043 ⟶ 3,009:
20: 895014631192902121</pre>
 
===Using a module===
=={{header|Perl 6}}==
{{libheader|ntheory}}
<syntaxhighlight lang="perl">use ntheory ":all";
 
# Count derangements using derangement iterator
{{trans|Perl}}
sub countderange {
{{works with|Rakudo|2016.10}}
my($n,$s) = (shift,0);
<lang perl6>
forderange { $s++ } $n;
sub is-derangement(List $l) {
$s;
return not grep { $l[$_] == $_ }, 0..($l.elems - 1);
}
# Count derangements using inclusion-exclusion
 
sub subfactorial1 {
# task 1
my $n = shift;
sub derangements(Range $x) {
vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n);
$x.permutations.grep( *.&is-derangement )
}
# Count derangements using simple recursion without special functions
 
sub subfactorial2 {
# task 2
my $n = shift;
.say for (0..4).&derangements;
use bigint; no warnings 'recursion';
 
($n < 1) ? 1 : $n * subfactorial2($n-1) + (-1)**$n;
# task 3
sub prefix:<!>(Int $x) {
return +derangements(^$x);
}
 
print "Derangements of 4 items:\n";
# task 4
forderange { print "@_\n" } 4;
for ^9 -> $n {
printf "\n%3s %15s %15s\n","N","List count","!N";
say "number: " ~ $n;
printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9;
say "count: " ~ !$n;
printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;</syntaxhighlight>
say "derangements: ";
{{out}}
.say for (0..$n-1).&derangements;
<pre>
}
Derangements of 4 items:
</lang>
1 0 3 2
1 2 3 0
1 3 0 2
2 0 3 1
2 3 0 1
2 3 1 0
3 0 1 2
3 2 0 1
3 2 1 0
 
N List count !N (binomial) !N (recursion)
=={{header|Phix}}==
0 1 1 1
<lang Phix>function deranged(sequence s1, sequence s2)
1 0 0 0
for i=1 to length(s1) do
2 1 1 1
if s1[i]==s2[i] then return 0 end if
3 2 2 2
end for
4 9 9 9
return 1
5 44 44 44
end function
6 265 265 265
 
7 1854 1854 1854
function derangements(integer n)
8 14833 14833 14833
sequence ts = tagset(n)
9 133496 133496 133496
sequence res = {}
20 895014631192902121
for i=1 to factorial(n) do
200 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
sequence s = permute(i,ts)
</pre>
if deranged(s,ts) then
res = append(res,s)
end if
end for
return res
end function
 
=={{header|Phix}}==
function subfactorial(integer n)
{{libheader|Phix/mpfr}}
if n<=0 then return 1 end if
<!--<syntaxhighlight lang="phix">(phixonline)-->
if n=1 then return 0 end if
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
<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>
end function
<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>
?derangements(4)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
for n=0 to 9 do
<span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
printf(1,"%d: counted:%d, calculated:%d\n",{n,length(derangements(n)),subfactorial(n)})
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
end for
printf(1,"!20=%d (incorrect!)\n",{subfactorial(20)})
<span style="color: #008080;">function</span> <span style="color: #000000;">derangements</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
include builtins\bigatom.e
<span style="color: #004080;">sequence</span> <span style="color: #000000;">ts</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
function ba_subfactorial(integer n)
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
if n<=0 then return 1 end if
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if n=1 then return 0 end if
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ts</span><span style="color: #0000FF;">)</span>
return ba_multiply(n-1,ba_add(ba_subfactorial(n-1),ba_subfactorial(n-2)))
<span style="color: #008080;">if</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ts</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
end function
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
ba_printf(1,"!20=%B (bigatom)\n",ba_subfactorial(20))</lang>
<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>
Line 2,125 ⟶ 3,126:
8: counted:14833, calculated:14833
9: counted:133496, calculated:133496
!20=895014631192902186 (incorrect on 32-bit!)
!20=895014631192902121 (bigatommpfr)
</pre>
<small>(under pwa/p2js you get a trailing "000" instead of "186" for the incorrect result)</small>
{{trans|FreeBASIC}}
A more efficient method of calculating subfactorials (0 should be handled separately, or obviously prepend a 1 and extract with idx+1).<br>
Should you instead of string results want an array of mpz for further calculations, use the mpz_init_set() call as shown:
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">include</span> <span style="color: #004080;">mpfr</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">mpz</span> <span style="color: #000000;">num</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_init</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">mpz_mul_si</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">mpz_odd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">mpz_sub_ui</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #7060A8;">mpz_add_ui</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">num</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mpz_get_str</span><span style="color: #0000FF;">(</span><span style="color: #000000;">num</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- res[i] = mpz_init_set(num)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">extract</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subfactorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">20</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">)&</span><span style="color: #000000;">20</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>{"0","1","2","9","44","265","1854","14833","133496","895014631192902121"}</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">import util.
 
go =>
foreach(N in 0..9)
println([N,num_derangements=num_derangements(N), subfactorial=subfactorial(N), subfactorial2=subfactorial2(N)])
end,
println(["!20", subfactorial(20)]),
println(["!20 approx", subfactorial2(20)]),
println("subfactorial0..30"=[subfactorial(N) : N in 0..30 ]),
println("subfactorial2_0..30"=[subfactorial2(N) : N in 0..30 ]),
println(["!200", subfactorial(200)]),
nl,
println("Syntax sugar:"),
println("'!'(20)"='!'(20)),
println("200.'!'()"=200.'!'()),
println("'!!'(20)"='!!'(20)),
println("'!-!!'(10)"='!-!!'(10)),
nl.
 
num_derangements(N) = derangements(N).length.
 
derangements(N) = D =>
D = [P : P in permutations(1..N), nofixpoint(P)].
 
% subfactorial: tabled recursive function
table
subfactorial(0) = 1.
subfactorial(1) = 0.
subfactorial(N) = (N-1)*(subfactorial(N-1)+subfactorial(N-2)).
 
% approximate version of subfactorial
subfactorial2(0) = 1.
subfactorial2(N) = floor(1.0*floor(factorial(N)/2.71828 + 1/2.0)).
 
% Factorial
fact(N) = F =>
F1 = 1,
foreach(I in 1..N)
F1 := F1 * I
end,
F = F1.
 
% No fixpoint in L
nofixpoint(L) =>
foreach(I in 1..L.length)
L[I] != I
end.
 
% Some syntax sugar. Note: the function must be an atom.
'!'(N) = fact(N).
'!!'(N) = subfactorial(N).
 
'!-!!'(N) = fact(N) - subfactorial(N).</syntaxhighlight>
 
{{out}}
<pre>[0,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[1,num_derangements = 0,subfactorial = 0,subfactorial2 = 0]
[2,num_derangements = 1,subfactorial = 1,subfactorial2 = 1]
[3,num_derangements = 2,subfactorial = 2,subfactorial2 = 2]
[4,num_derangements = 9,subfactorial = 9,subfactorial2 = 9]
[5,num_derangements = 44,subfactorial = 44,subfactorial2 = 44]
[6,num_derangements = 265,subfactorial = 265,subfactorial2 = 265]
[7,num_derangements = 1854,subfactorial = 1854,subfactorial2 = 1854]
[8,num_derangements = 14833,subfactorial = 14833,subfactorial2 = 14833]
[9,num_derangements = 133496,subfactorial = 133496,subfactorial2 = 133496]
[!20,895014631192902121]
[!20 approx,895015233227128960]
subfactorial0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334961,14684570,176214841,2290792932,32071101049,481066515734,7697064251745,130850092279664,2355301661033953,44750731559645106,895014631192902121,18795307255050944540,413496759611120779881,9510425471055777937262,228250211305338670494289,5706255282633466762357224,148362637348470135821287825,4005791208408693667174771274,112162153835443422680893595673,3252702461227859257745914274516,97581073836835777732377428235481]
subfactorial2_0..30 = [1,0,1,2,9,44,265,1854,14833,133496,1334962,14684580,176214959,2290794473,32071122622,481066839325,7697069429198,130850180296364,2355303245334550,44750761661356448,895015233227128960,18795319897769705472,413497037750933585920,9510431868271472934912,228250364838515316883456,5706259120962883593175040,148362737145034969127583744,4005793902915943736948031488,112162229281646435629661159424,3252704649167746668444545712128,97581139475032389920237209780224]
[!200,290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201]
 
Syntax sugar:
'!'(20) = 2432902008176640000
200.'!'() = 788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000
'!!'(20) = 895014631192902121
'!-!!'(10) = 2293839</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l") # For 'permute'
 
(de derangements (Lst)
Line 2,142 ⟶ 3,250:
(*
(dec N)
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</langsyntaxhighlight>
{{out}}
<pre>: (derangements (range 1 4))
Line 2,168 ⟶ 3,276:
 
=={{header|PureBasic}}==
Brute Force
{{incomplete|PureBasic|Missing the subfactorial !n.}}
<syntaxhighlight lang="purebasic">
Brute Force: Tested up to n=10
Procedure.q Subfactoral(n)
<lang PureBasic>
If n=0:ProcedureReturn 1:EndIf
 
If n=1:ProcedureReturn 0:EndIf
Procedure.q perm(n)
if n=0:ProcedureReturn (Subfactoral(n-1)+Subfactoral(n-2))*(n-1:endif)
if n=1:ProcedureReturn 0:endif
ProcedureReturn (perm(n-1)+perm(n-2))*(n-1)
EndProcedure
 
factFile.s="factorials.txt"
tempFile.s="temp.txt"
Line 2,184 ⟶ 3,290:
DeleteFile(tempFile.s)
DeleteFile(drngFile.s)
 
n=4
 
; create our storage file
f.s=factFile.s
If CreateFile(21130,f.s)
WriteStringN(21130,"1.2")
WriteStringN(21130,"2.1")
CloseFile(21130)
Else
Debug "not createfile :"+f.s
EndIf
 
showfactorial=#FALSEFalse
 
ifIf showfactorial
; cw("nfactorial n ="+str(n))
Debug "nfactorial n ="+strStr(n)
EndIf
endif
 
; build up the factorial combinations
forFor l=1 toTo n-2
gosubGosub nfactorial
Next
next
 
; extract the derangements
; cw("derangements["+str(perm(n))+"] for n="+str(n))
Debug "derangements["+strStr(permSubfactoral(n))+"] for n="+strStr(n)
gosubGosub derangements
; cw("")
Debug ""
 
; show the first 20 derangements
forFor i=0 toTo 20
;Debug cw("derangements["+strStr(permSubfactoral(i))+"] for n="+strStr(i))
Next
Debug "derangements["+str(perm(i))+"] for n="+str(i)
next
End
end
 
derangements:
x=0
If ReadFile(21120,factFile.s) andAnd CreateFile(21131,drngFile.s)
Repeat
repeat
r.s = ReadString(21120)
cs=CountString(r.s,".")
ifIf cs
hit=0
t.s=""
; scan for numbers at their index
forFor i=1 toTo cs+1
s.s=StringField(r.s,i,".")
t.s+s.s+"."
ifIf valVal(s.s)=i:hit+1:endifEndIf
Next
next
t.s=rtrimRTrim(t.s,".")
; show only those which are valid
ifIf notNot hit
x+1
; cw(t.s+" "+str(x))
Debug t.s+" "+strStr(x)
WriteStringN(21131,t.s+" "+strStr(x))
EndIf
endif
EndIf
endif
Until Eof(0)
until eof(2112)
CloseFile(21120)
CloseFile(21131)
Else
Debug "not readfile :"+factFile.s
Line 2,256 ⟶ 3,362:
; cw("")
Debug ""
Return
return
 
nfactorial:
x=0
If ReadFile(21120,factFile.s) andAnd CreateFile(21131,tempFile.s)
Repeat
repeat
r.s = ReadString(21120)
cs=CountString(r.s,".")
ifIf cs
forFor j=1 toTo cs+2
t.s=""
forFor i=1 toTo cs+1
s.s=StringField(r.s,i,".")
ifIf i=j
t.s+"."+strStr(cs+2)+"."+s.s
Else
else
t.s+"."+s.s
EndIf
endif
Next
next
ifIf j=cs+2:t.s+"."+strStr(cs+2):endifEndIf
t.s=trimTrim(t.s,".")
x+1
ifIf cs+2=n andAnd showfactorial
; cw(t.s+" "+str(x))
Debug t.s+" "+strStr(x)
EndIf
endif
WriteStringN(21131,t.s)
Next
next
EndIf
endif
Until Eof(0)
until eof(2112)
CloseFile(21120)
CloseFile(21131)
Else
Debug "not readfile :"+factFile.s
Line 2,294 ⟶ 3,400:
CopyFile(tempFile.s,factFile.s)
DeleteFile(tempFile.s)
Return
return
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,334 ⟶ 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,384 ⟶ 3,490:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
 
{{out}}
Line 2,425 ⟶ 3,531:
=={{header|Python}}==
Includes stretch goal.
<langsyntaxhighlight lang="python">from itertools import permutations
import math
 
Line 2,465 ⟶ 3,571:
 
n = 20
print("\n!%i = %i" % (n, subfact(n)))</langsyntaxhighlight>
 
{{out}}
Line 2,492 ⟶ 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,542 ⟶ 3,793:
(sub-fact 20)
;; -> 895014631192902121
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
 
{{trans|Perl}}
{{works with|Rakudo|2016.10}}
 
 
Generate <code>List.permutations</code> and keep the ones where no elements are in their original position. This is done by zipping each permutation with the original list, and keeping the ones where none of the zipped pairs are equal.
 
I am using the <code>Z</code> infix zip operator with the <code>eqv</code> equivalence infix operator, all wrapped inside a <code>none()</code> Junction.
 
Although not necessary for this task, I have used <code>eqv</code> instead of <code>==</code> so that the <code>derangements()</code> function also works with any set of arbitrary objects (eg. strings, lists, etc.)
 
<syntaxhighlight lang="raku" line>sub derangements(@l) {
@l.permutations.grep(-> @p { none(@p Zeqv @l) })
}
 
sub prefix:<!>(Int $n) {
(1, 0, 1, -> $a, $b { ($++ + 2) × ($b + $a) } ... *)[$n]
}
 
say 'derangements([1, 2, 3, 4])';
say derangements([1, 2, 3, 4]), "\n";
 
say 'n == !n == derangements(^n).elems';
for 0 .. 9 -> $n {
say "!$n == { !$n } == { derangements(^$n).elems }"
}</syntaxhighlight>
{{out}}
<pre>
derangements([1, 2, 3, 4])
((2 1 4 3) (2 3 4 1) (2 4 1 3) (3 1 4 2) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 3 1 2) (4 3 2 1))
 
n == !n == derangements(^n).elems
!0 == 1 == 1
!1 == 0 == 0
!2 == 1 == 1
!3 == 2 == 2
!4 == 9 == 9
!5 == 44 == 44
!6 == 265 == 265
!7 == 1854 == 1854
!8 == 14833 == 14833
!9 == 133496 == 133496
</pre>
 
Much faster to just calculate the subfactorial.
<syntaxhighlight lang="raku" line>my @subfactorial = 1,0,{++$ × ($^a + $^b)}…*;
 
say "!$_: ",@subfactorial[$_] for |^10, 20, 200;</syntaxhighlight>
{{out}}
<pre>!0: 1
!1: 0
!2: 1
!3: 2
!4: 9
!5: 44
!6: 265
!7: 1854
!8: 14833
!9: 133496
!20: 895014631192902121
!200: 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201</pre>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX pgmprogram generates all permutations of N derangements & and subfactorial # */
numeric digits 1000 /*be able to handle biglarge subfacts.subfactorials*/
parse arg N .; if N=='' then| N=4="," then N=4 /*Not specified? Then use Assumethe default.*/
d=derangementsSet derangeSet(N) /*go &and build the derangements set. */
say d 'derangements for' N "items are:"
say
do i=1 for d /*showdisplay the derangements for N items.*/
say right('derangement', 22) right(i, length(d) ) '───►' $.i
end /*i*/
say /* [↓] count and calculate subfact !L. */
do L=0 to 92; d=derangementsSet derangeSet(L)
say L 'items: derangement count='right(d, 6)", !"L'='right( !s(L), 6)
end /*L*/
say
say right('!20=' , 4022) !s( 20)
say right('!100200=', 4022) !s(100200)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────!S subroutine───────────────────────*/
!s: _=1; do j=1 for arg(1); if j//2 then _=-1+ j*_ - 1; else _=1+j*_;end;return _ + 1
end /*j*/; return _
/*──────────────────────────────────DERANGEMENTSSET subroutine──────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
derangementsSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
derangeSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
if x==0 then return 1; if x==1 then return 0
if x==0 then return 1; if x==1 then return /*populate the first derangement.*/0
@.1=2; @.2=1; do i=3 to x; @.i=i; end /*populate 1st derangement.*/
parse value @.p @.x with @. do i=3 to x; @.pi=i; end /*i*/ call .buildD x /*swap & build " the rest of 'em.*/
parse value @.p @.x with @.x @.p; call .buildD x /*swap & /*build others.*/
do while .nextD(x,0); call .buildD x; end /*build others.*/
do while .nextD(x, 0); call .buildD x; end; return #
return #
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────.BUILDD subroutine──────────────────*/
.buildD: do j=1 for arg(1); if @.j==j then return; end
#=#+1; do j=1 for arg(1); $.#= $.# @.j; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────.NEXTD subroutine───────────────────*/
.nextD: procedure expose @.; parse arg n,i; nm=n-1
 
do k=nmn-1 by -1 for nmn-1; kp=k+1; if @.k<@.kp then do; i=k; leave; end
end /*k*/
 
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
end /*j*/
 
if i==0 then return 0
do m=i+1 while @.m<@.i; end /*m*/ /* [↓] swap two do j=i+1 while @values.j<@.i; end*/
parse value @.jm @.i with @.i @.jm; return 1</syntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
return 1</lang>
{{out}}
<pre>
9 derangements for 4 items are:
Line 2,605 ⟶ 3,919:
1 items: derangement count= 0, !1= 0
2 items: derangement count= 1, !2= 1
3 items: derangement count= 2, !3= 2
4 items: derangement count= 9, !4= 9
5 items: derangement count= 44, !5= 44
6 items: derangement count= 265, !6= 265
7 items: derangement count= 1854, !7= 1854
8 items: derangement count= 14833, !8= 14833
9 items: derangement count=133496, !9=133496
 
!20= 895014631192902121
!200= 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201
</pre>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">def derangements(n)
ary = (1 .. n).to_a
ary.permutation.select do |perm|
Line 2,644 ⟶ 3,951:
(10..20).each do |n|
puts "#{n} : #{subfact(n)}"
end</langsyntaxhighlight>
 
{{out}}
Line 2,686 ⟶ 3,993:
=={{header|Scala}}==
{{trans|Ruby}}
<langsyntaxhighlight Scalalang="scala">def derangements(n: Int) =
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
 
Line 2,700 ⟶ 4,007:
println("\n%2s%10s%10s".format("n", "derange", "subfact"))
(0 to 9).foreach(n => println("%2d%10d%10d".format(n, derangements(n).size, subfactorial(n))))
(10 to 20).foreach(n => println(f"$n%2d${subfactorial(n)}%20d"))</langsyntaxhighlight>
{{out}}
<pre>Derangements for n = 4
Line 2,737 ⟶ 4,044:
 
=={{header|SuperCollider}}==
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
d = { |array, n|
Routine {
Line 2,752 ⟶ 4,059:
x = f.(4);
x.all.do(_.postln); "";
)</langsyntaxhighlight>
 
Answers:
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
[ 3, 2, 1, 0 ]
[ 2, 3, 0, 1 ]
Line 2,765 ⟶ 4,072:
[ 2, 3, 1, 0 ]
[ 3, 0, 1, 2 ]
</syntaxhighlight>
</lang>
 
<syntaxhighlight lang="supercollider">(
<lang SuperCollider>(
z = { |n|
case
Line 2,781 ⟶ 4,088:
"% % %\n".postf(i, p.(derangements.size), p.(subfactorial));
};
)</langsyntaxhighlight>
 
Answers:
 
<syntaxhighlight lang="supercollider">
<lang SuperCollider>
n derangements subfactorial
0 1 1
Line 2,797 ⟶ 4,104:
8 14833 14833
9 133496 133496
</syntaxhighlight>
</lang>
 
=={{header|Tcl}}==
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5; # for arbitrary-precision integers
package require struct::list; # for permutation enumerator
 
Line 2,837 ⟶ 4,144:
}
return $s
}</langsyntaxhighlight>
Demonstrating with the display parts of the task:
<langsyntaxhighlight lang="tcl">foreach d [deranged1to 4] {
puts "derangement of 1..4: $d"
}
Line 2,849 ⟶ 4,156:
 
# Stretch goal
puts "\n!20 = [subfact 20]"</langsyntaxhighlight>
{{out}}
<pre>
Line 2,873 ⟶ 4,180:
!8 14833 14833
!9 133496 133496
 
!20 = 895014631192902121
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
{{libheader|Wren-big}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
import "./big" for BigInt
 
var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
var perms = []
var toInsert = input[0]
for (perm in permute.call(input[1..-1])) {
for (i in 0..perm.count) {
var newPerm = perm.toList
newPerm.insert(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
 
var derange = Fn.new { |input|
if (input.isEmpty) return [input]
var perms = permute.call(input)
var derangements = []
for (perm in perms) {
var deranged = true
for (i in 0...perm.count) {
if (perm[i] == i) {
deranged = false
break
}
}
if (deranged) derangements.add(perm)
}
return derangements
}
 
var subFactorial // recursive
subFactorial = Fn.new { |n|
if (n == 0) return BigInt.one
if (n == 1) return BigInt.zero
return (subFactorial.call(n-1) + subFactorial.call(n-2)) * (n - 1)
}
 
var input = [0, 1, 2, 3]
var derangements = derange.call(input)
System.print("There are %(derangements.count) derangements of %(input), namely:\n")
System.print(derangements.join("\n"))
 
System.print("\nN Counted Calculated")
System.print("- ------- ----------")
for (n in 0..9) {
var list = List.filled(n, 0)
for (i in 0...n) list[i] = i
var counted = derange.call(list).count
Fmt.print("$d $-9d $-9i", n, counted, subFactorial.call(n))
}
System.print("\n!20 = %(subFactorial.call(20))")</syntaxhighlight>
 
{{out}}
<pre>
There are 9 derangements of [0, 1, 2, 3], namely:
 
[1, 2, 3, 0]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[1, 0, 3, 2]
[1, 3, 0, 2]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]
 
N Counted Calculated
- ------- ----------
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
9 133496 133496
 
!20 = 895014631192902121
Line 2,879 ⟶ 4,277:
=={{header|zkl}}==
{{trans|Python}} mostly
<langsyntaxhighlight lang="zkl">fcn subFact(n){
if(n==0) return(1);
if(n==1) return(0);
Line 2,897 ⟶ 4,295:
sum + (perm.zipWith('==,enum).sum(0) == 0)
},0);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">println("Derangements of 0,1,2,3:\n",derangements(4));
println("\nTable of n vs counted vs calculated derangements:");
foreach n in (10){
Line 2,904 ⟶ 4,302:
}
 
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));</langsyntaxhighlight>
{{out}}
<pre>
Line 2,926 ⟶ 4,324:
</pre>
Lazy/iterators version:
<langsyntaxhighlight lang="zkl">fcn derangements(n){ //-->Walker
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
Line 2,935 ⟶ 4,333:
fcn derangers(n){ // just count # of derangements, w/o saving them
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">foreach d in (derangements(4)){ println(d) }
//rest of test code remains the same</langsyntaxhighlight>
Thundergnat
10,327

edits

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