Permutations/Derangements: Difference between revisions
m
→{{header|Raku}}: Add a version using subfactorials
(Permutations/Derangements in QBasic) |
Thundergnat (talk | contribs) m (→{{header|Raku}}: Add a version using subfactorials) |
||
| (8 intermediate revisions by 6 users not shown) | |||
Line 32:
{{trans|Python}}
<
[[Int]] r
V perm = Array(0 .< n)
Line 55:
n = 20
print("\n!#. = #.".format(n, subfact(n)))</
{{out}}
Line 88:
{{trans|BBC BASIC}}
Due to 32 bit integers !12 is the limit.
<
DERANGE CSECT
USING DERANGE,R13 base register
Line 339:
PG DC CL80' ' buffer
YREGS
END DERANGE</
{{out}}
<pre>
Line 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}}
<
procedure DePermute is
type U64 is mod 2**64;
Line 422 ⟶ 526:
end loop;
Put_Line ("!20 = " & U64'Image (sub_fact (20)));
end DePermute;</
{{out}}
<pre>Deranged 4:
Line 449 ⟶ 553:
=={{header|Arturo}}==
<
loop.with:'i s 'a [
if a = o\[i] -> return false
Line 481 ⟶ 585:
]
print ~"\n!20 = |subfactorial 20|"</
{{out}}
Line 515 ⟶ 619:
{{works with|AutoHotkey_L}}
Note that the permutations are generated in lexicographic order, from http://www.autohotkey.com/forum/topic77959.html
<
SetBatchLines -1
Process, Priority,, high
Line 610 ⟶ 714:
a *= A_Index
return a
}</
{{out}}
<pre>Derangements for 1, 2, 3, 4:
Line 639 ⟶ 743:
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<
Count% = FN_Derangement_Generate(4,TRUE)
Line 713 ⟶ 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))</
{{out}}
Line 752 ⟶ 856:
Also the counter <code>count</code> is a global variable.
<
= memo answ
. (memo==)
Line 803 ⟶ 907:
& out$("!20 =" calculated-!n$20)
& lst$calculated-!n
)</
{{out}}
<pre>Derangements of 1 2 3 4
Line 862 ⟶ 966:
=={{header|C}}==
<
typedef unsigned long long LONG;
Line 918 ⟶ 1,022:
return 0;
}</
{{out}}
<pre>Deranged Four:
Line 959 ⟶ 1,063:
Recursive version
<
using System;
class Derangements
Line 988 ⟶ 1,092:
}
}
</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
<
(:require [clojure.set :as s]))
Line 1,032 ⟶ 1,257:
(range 10)))
(println (subfactorial 20))))
</syntaxhighlight>
{{Out}}
<pre>[1 0 3 2]
Line 1,054 ⟶ 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===
<
std.range, std.traits;
Line 1,121 ⟶ 1,436:
writefln("\n!20 = %s", 20L.subfact);
}</
{{out}}
<pre>Derangements for n = 4:
Line 1,151 ⟶ 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.
<
T factorial(T)(in T n) pure nothrow {
Line 1,197 ⟶ 1,512:
writefln("\n!20 = %s", 20L.subfact);
}</
=={{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}}==
<
(lib 'list) ;; in-permutations
(lib 'bigint)
Line 1,221 ⟶ 1,584:
(remember '!n #(1 0))
</syntaxhighlight>
{{out}}
<
(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,244 ⟶ 1,607:
(!n 20)
→ 895014631192902121
</syntaxhighlight>
=={{header|Elixir}}==
{{trans|Ruby}}
<
def derangements(n) do
list = Enum.to_list(1..n)
Line 1,276 ⟶ 1,639:
Enum.each(10..20, fn n ->
:io.format "~2w :~19w~n", [n, Permutation.subfact(n)]
end)</
{{out}}
Line 1,318 ⟶ 1,681:
=={{header|F_Sharp|F#}}==
===The Function===
<
// Generate derangements. Nigel Galloway: July 9th., 2019
let derange n=
Line 1,329 ⟶ 1,692:
|_->()}
derange 0 [|1..n|] (n-1)
</syntaxhighlight>
===The Task===
<
derange 4 |> Seq.iter(printfn "%A")
</syntaxhighlight>
{{out}}
<pre>
Line 1,346 ⟶ 1,709:
[|4; 1; 2; 3|]
</pre>
<
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>
Line 1,365 ⟶ 1,728:
=={{header|Factor}}==
{{works with|Factor|0.98}}
<
prettyprint sequences ;
IN: rosetta-code.derangements
Line 1,386 ⟶ 1,749:
"%d%8d%8d\n" printf
] each nl
"!20 = " write 20 !n .</
{{out}}
<pre>
Line 1,419 ⟶ 1,782:
=={{header|FreeBASIC}}==
<
' compile with: fbc -s console
Line 1,512 ⟶ 1,875:
Print : Print "hit any key to end program"
Sleep
End</
{{out}}
<pre>permutations derangements for n = 4
Line 1,543 ⟶ 1,906:
=={{header|GAP}}==
<
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,577 ⟶ 1,940:
# [ 7, 1854, 1854, 1854 ],
# [ 8, 14833, 14833, 14833 ],
# [ 9, 133496, 133496, 133496 ] ]</
=={{header|Go}}==
<
import (
Line 1,650 ⟶ 2,013:
// stretch (sic)
fmt.Println("\n!20 =", subFact(20))
}</
{{out}}
<pre>
Line 1,682 ⟶ 2,045:
=={{header|Groovy}}==
Solution:
<
def subfact
subfact = { BigInteger n -> (n == 0) ? 1 : (n == 1) ? 0 : ((n-1) * (subfact(n-1) + subfact(n-2))) }
Line 1,690 ⟶ 2,053:
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p }
d
}</
Test:
<
assert d.size() == subfact(4)
d.each { println it }
Line 1,708 ⟶ 2,071:
println """
!20 == ${subfact(20)}
"""</
{{out}}
Line 1,738 ⟶ 2,101:
=={{header|Haskell}}==
<
import Data.List (permutations)
Line 1,770 ⟶ 2,133:
putStrLn ""
-- Print the number of derangements in a list of 20 items
print $ subfactorial 20</
{{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,788 ⟶ 2,151:
Alternatively, this is a backtracking method:
<
where loop [] [] = [[]]
loop (h:hs) xs = [x:ys | x <- xs, x /= h, ys <- loop hs (delete x xs)]</
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,797 ⟶ 2,160:
Note: <code>!n</code> in J denotes factorial (or gamma n+1), and not subfactorial.
<
subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</
Requested examples:
<
1 0 3 2
1 2 3 0
Line 1,826 ⟶ 2,189:
8.95015e17
subfactorial 20x NB. using extended precision
895014631192902121</
Note that derangement 10 was painfully slow (almost 3 seconds, about 10 times slower than derangement 9 and 100 times slower than derangement 8) -- this is a brute force approach. But brute force seems like an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).
Line 1,832 ⟶ 2,195:
=={{header|Java}}==
{{trans|D}}
<
import java.util.Arrays;
import java.util.List;
Line 1,926 ⟶ 2,289:
return r;
}
}</
<pre>derangements for n = 4
Line 1,958 ⟶ 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.
<
# In order to reference the original array conveniently, define _derangements(ary):
Line 1,981 ⟶ 2,344:
# Avoid creating an array just to count the items in a stream:
def count(g): reduce g as $i (0; . + 1);</
'''Tasks''':
<
([range(1;5)] | derangements),
"",
Line 1,989 ⟶ 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)"</
{{Out}}
<
jq -n -c -r -f derangements.jq
Line 2,016 ⟶ 2,379:
9: 133496 vs 133496
Computed approximation to !20 (15 significant digits): 895014631192902000</
=={{header|Julia}}==
<
derangements(n::Int) = (perm for perm in permutations(1:n)
Line 2,050 ⟶ 2,413:
end
println("\n!20 = ", subfact(20))</
{{out}}
Line 2,079 ⟶ 2,442:
=={{header|Kotlin}}==
<
fun <T> permute(input: List<T>): List<List<T>> {
Line 2,124 ⟶ 2,487:
}
println("\n!20 = ${subFactorial(20)}")
}</
{{out}}
Line 2,157 ⟶ 2,520:
=={{header|Lua}}==
<
function permute (list)
local function perm (list, n)
Line 2,225 ⟶ 2,588:
print("\t| " .. #derangements(listOneTo(i)))
end
print("\n\nThe subfactorial of 20 is " .. subFact(20))</
{{out}}
<pre>Derangements of [1,2,3,4]
Line 2,258 ⟶ 2,621:
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
Needs["Combinatorica`"]
derangements[n_] := Derangements[Range[n]]
derangements[4]
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm
Subfactorial[20]</
{{out}}
<pre>
Line 2,282 ⟶ 2,645:
=={{header|Nim}}==
<
iterator derangements[T](a: openArray[T]): seq[T] =
Line 2,308 ⟶ 2,671:
echo &"{n} {toSeq(derangements(toSeq(1..n))).len:>6} {!n:>6}"
echo "\n!20 = ", !20</
{{out}}
Line 2,339 ⟶ 2,702:
=={{header|PARI/GP}}==
<
derange(n)={
my(v=[[]],tmp);
Line 2,357 ⟶ 2,720:
derange(4)
for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n)))
derangements(20)</
{{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,373 ⟶ 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===
<
# compare this with the deranged() sub to see how to turn procedural
# code into functional one ('functional' as not in 'understandable')
Line 2,441 ⟶ 2,961:
print "\nNumber of derangements:\n";
print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</
{{out}}
Line 2,491 ⟶ 3,011:
===Using a module===
{{libheader|ntheory}}
<
# Count derangements using derangement iterator
Line 2,515 ⟶ 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;</
{{out}}
<pre>
Line 2,546 ⟶ 3,066:
=={{header|Phix}}==
{{libheader|Phix/mpfr}}
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">s2</span><span style="color: #0000FF;">)</span>
Line 2,592 ⟶ 3,112:
<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>
<!--</
{{out}}
<pre>
Line 2,613 ⟶ 3,133:
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:
<!--<
<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>
Line 2,635 ⟶ 3,155:
<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>
<!--</
{{out}}
<pre>{"0","1","2","9","44","265","1854","14833","133496","895014631192902121"}</pre>
=={{header|Picat}}==
<
go =>
Line 2,692 ⟶ 3,212:
'!!'(N) = subfactorial(N).
'!-!!'(N) = fact(N) - subfactorial(N).</
{{out}}
Line 2,718 ⟶ 3,238:
=={{header|PicoLisp}}==
<
(de derangements (Lst)
Line 2,730 ⟶ 3,250:
(*
(dec N)
(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</
{{out}}
<pre>: (derangements (range 1 4))
Line 2,757 ⟶ 3,277:
=={{header|PureBasic}}==
Brute Force
<syntaxhighlight lang="purebasic">
Procedure.q Subfactoral(n)
If n=0:ProcedureReturn 1:EndIf
Line 2,881 ⟶ 3,401:
DeleteFile(tempFile.s)
Return
</syntaxhighlight>
{{out}}
Line 2,920 ⟶ 3,440:
{{trans|C}}
<
Protected count, tmp, i
If depth = lenn
Line 2,970 ⟶ 3,490:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</
{{out}}
Line 3,011 ⟶ 3,531:
=={{header|Python}}==
Includes stretch goal.
<
import math
Line 3,051 ⟶ 3,571:
n = 20
print("\n!%i = %i" % (n, subfact(n)))</
{{out}}
Line 3,083 ⟶ 3,603:
{{trans|FreeBASIC}}
Error "Subscript out of scope" for n > 7
<
FUNCTION permsderange (n!, flag!)
IF n = 0 THEN permsderange = 1
Line 3,152 ⟶ 3,672:
FOR i = 0 TO 7
PRINT USING " ###: ######## ########"; i; permsderange(i, 1); subfac(i)
NEXT i</
=={{header|Quackery}}==
<syntaxhighlight lang="quackery">
[ stack ] is deranges.num ( --> [ )
Line 3,197 ⟶ 3,717:
i^ sub! echo cr ]
cr
20 sub! echo</
{{out}}
Line 3,225 ⟶ 3,745:
=={{header|Racket}}==
<syntaxhighlight lang="racket">
#lang racket
Line 3,273 ⟶ 3,793:
(sub-fact 20)
;; -> 895014631192902121
</syntaxhighlight>
=={{header|Raku}}==
Line 3,288 ⟶ 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"
@l.permutations.grep(-> @p { none(@p Zeqv @l) })
}
Line 3,302 ⟶ 3,822:
for 0 .. 9 -> $n {
say "!$n == { !$n } == { derangements(^$n).elems }"
}</
{{out}}
<pre>
Line 3,320 ⟶ 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}}==
<
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 3,363 ⟶ 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</
{{out|output|text= when using the default inputs:}}
<pre>
Line 3,387 ⟶ 3,925:
=={{header|Ruby}}==
<
ary = (1 .. n).to_a
ary.permutation.select do |perm|
Line 3,413 ⟶ 3,951:
(10..20).each do |n|
puts "#{n} : #{subfact(n)}"
end</
{{out}}
Line 3,455 ⟶ 3,993:
=={{header|Scala}}==
{{trans|Ruby}}
<
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
Line 3,469 ⟶ 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"))</
{{out}}
<pre>Derangements for n = 4
Line 3,506 ⟶ 4,044:
=={{header|SuperCollider}}==
<syntaxhighlight lang="supercollider">(
d = { |array, n|
Routine {
Line 3,521 ⟶ 4,059:
x = f.(4);
x.all.do(_.postln); "";
)</
Answers:
<syntaxhighlight lang="supercollider">
[ 3, 2, 1, 0 ]
[ 2, 3, 0, 1 ]
Line 3,534 ⟶ 4,072:
[ 2, 3, 1, 0 ]
[ 3, 0, 1, 2 ]
</syntaxhighlight>
<syntaxhighlight lang="supercollider">(
z = { |n|
case
Line 3,550 ⟶ 4,088:
"% % %\n".postf(i, p.(derangements.size), p.(subfactorial));
};
)</
Answers:
<syntaxhighlight lang="supercollider">
n derangements subfactorial
0 1 1
Line 3,566 ⟶ 4,104:
8 14833 14833
9 133496 133496
</syntaxhighlight>
=={{header|Tcl}}==
{{tcllib|struct::list}}
<
package require struct::list; # for permutation enumerator
Line 3,606 ⟶ 4,144:
}
return $s
}</
Demonstrating with the display parts of the task:
<
puts "derangement of 1..4: $d"
}
Line 3,618 ⟶ 4,156:
# Stretch goal
puts "\n!20 = [subfact 20]"</
{{out}}
<pre>
Line 3,650 ⟶ 4,188:
{{libheader|Wren-fmt}}
{{libheader|Wren-big}}
<
import "./big" for BigInt
var permute // recursive
Line 3,705 ⟶ 4,243:
Fmt.print("$d $-9d $-9i", n, counted, subFactorial.call(n))
}
System.print("\n!20 = %(subFactorial.call(20))")</
{{out}}
Line 3,739 ⟶ 4,277:
=={{header|zkl}}==
{{trans|Python}} mostly
<
if(n==0) return(1);
if(n==1) return(0);
Line 3,757 ⟶ 4,295:
sum + (perm.zipWith('==,enum).sum(0) == 0)
},0);
}</
<
println("\nTable of n vs counted vs calculated derangements:");
foreach n in (10){
Line 3,764 ⟶ 4,302:
}
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));</
{{out}}
<pre>
Line 3,786 ⟶ 4,324:
</pre>
Lazy/iterators version:
<
enum:=[0..n-1].pump(List);
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
Line 3,795 ⟶ 4,333:
fcn derangers(n){ // just count # of derangements, w/o saving them
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
}</
<
//rest of test code remains the same</
| |||