Permutations/Derangements: Difference between revisions

The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''. There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''.

;Task:

<langsyntaxhighlight Adalang="ada">with Ada.Text_IO; use Ada.Text_IO;

end DePermute;</langsyntaxhighlight>

<langsyntaxhighlight AHKlang="ahk">#NoEnv

}</langsyntaxhighlight>

<langsyntaxhighlight BBClang="bbc BASICbasic"> PRINT"Derangements for the numbers 0,1,2,3 are:"

REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))</langsyntaxhighlight>

<langpre>Derangements for the numbers 0,1,2,3 are:

></langpre>

<langsyntaxhighlight Clang="c">#include <stdio.h>

}</langsyntaxhighlight>

<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.arrayconv,

std.conv, std.range, std.traits;

/*pure nothrow*/ @safe {

size_t[] seq = iota(n).iota.array();

foreach (immutable tot; 0 .. fact(n).factorial - 1) {

swap(seq[k], .swap(seq[j]);

swap(seq[s], .swap(seq[r]);

Unqual!T"Derangements resultfor n = 14:".writeln;

result *= id.writeln;

ifforeach (0immutable <=i; n && n0 <=.. 210)

<pre>derangementsDerangements for n = 4:

tableTable of n vs counted vs calculated derangements:

1 0 1 0 1

2 1 0 1 0

3 2 1 2 1

34 29 9 2

45 944 44 9

56 44265 265 44

67 2651854 1854 265

78 185414833 14833 1854

Slightly slower but more compact recursive version of the derangements function, based on the [[Permutations#D|D entry]] of the permutations task. Same output.

<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.convtypecons, std.rangeconv, std.traitsrange;

auto derangementsR(in size_t n, in bool countOnly=false) {pure

void perms(in size_t[] s, in size_t[] pre=null) /*nothrow*/ {

foreach (immutable i, immutable c; s)

} else if (mismatch!q{a != b}zip(pre, ori).all!(po => po[0].length =!= 0po[1])) {

Unqual!T"Derangements resultfor n = 14:".writeln;

result *= id.writeln;

ifforeach (0immutable <=i; n && n0 <=.. 210)

1 0 writeln(d); 0

<langsyntaxhighlight lang="gap"># All of this is built-in

# [ 9, 133496, 133496, 133496 ] ]</langsyntaxhighlight>

<langsyntaxhighlight lang="go">package main

}</langsyntaxhighlight>

<langsyntaxhighlight lang="groovy">def fact = { n -> [1,(1..<(n+1)).inject(1) { prod, i -> prod * i }].max() }

if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ it[0]pp, ll -> pp != it[1]ll }) d << p }

}</langsyntaxhighlight>

<langsyntaxhighlight lang="groovy">def d = derangement([1,2,3,4])

"""</langsyntaxhighlight>

<langsyntaxhighlight Haskelllang="haskell">import Control.Monad (forM_)

subfactorial 0 = 0

subfactorial 2n = (n - 1) * (subfactorial (n - 1) + subfactorial (n - 2))

main =:: doIO ()

-- Generate printand $show all the derangements [1..4]of four integers

forM_ [1 .. 9] $ \i ->

print $ subfactorial 20</langsyntaxhighlight>

895014631192902121</pre>

<langsyntaxhighlight lang="haskell">derangements xs = loop xs xs

loop (h:hs) xs = [x:ys | x <- xs, x /= h, ys <- loop hs (delete x xs)]</langsyntaxhighlight>

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>

<langsyntaxhighlight lang="j"> derangement 4 NB. task item 2

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 isseems like an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).

<langsyntaxhighlight lang="java">import java.util.ArrayList;

}</langsyntaxhighlight>

=={{header|Mathematicajq}}==

Subfactorial[20]</langsyntaxhighlight>

895014631192902121</pre>

<langsyntaxhighlight lang="parigp">derangements(n)=if(n,round(n!/exp(1)),1);

derangements(20)</langsyntaxhighlight>

print "Derangements for 34 elements:\n";

print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</langsyntaxhighlight>

<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l") # For 'permute'

(+ (subfact (dec N)) (subfact (- N 2))) ) ) )</langsyntaxhighlight>

Brute Force: Tested up to n=10

ifIf n=01:ProcedureReturn 10:endifEndIf

If CreateFile(21130,f.s)

WriteStringN(21130,"1.2")

WriteStringN(21130,"2.1")

CloseFile(21130)

showfactorial=#FALSEFalse

ifIf showfactorial

Debug "nfactorial n ="+strStr(n)

forFor l=1 toTo n-2

gosubGosub nfactorial

Debug "derangements["+strStr(permSubfactoral(n))+"] for n="+strStr(n)

gosubGosub derangements

forFor i=0 toTo 20

;Debug cw("derangements["+strStr(permSubfactoral(i))+"] for n="+strStr(i))

If ReadFile(21120,factFile.s) andAnd CreateFile(21131,drngFile.s)

r.s = ReadString(21120)

ifIf cs

forFor i=1 toTo cs+1

ifIf valVal(s.s)=i:hit+1:endifEndIf

t.s=rtrimRTrim(t.s,".")

ifIf notNot hit

Debug t.s+" "+strStr(x)

WriteStringN(21131,t.s+" "+strStr(x))

CloseFile(21120)

CloseFile(21131)

If ReadFile(21120,factFile.s) andAnd CreateFile(21131,tempFile.s)

r.s = ReadString(21120)

ifIf cs

forFor j=1 toTo cs+2

forFor i=1 toTo cs+1

ifIf i=j

t.s+"."+strStr(cs+2)+"."+s.s

ifIf j=cs+2:t.s+"."+strStr(cs+2):endifEndIf

t.s=trimTrim(t.s,".")

ifIf cs+2=n andAnd showfactorial

Debug t.s+" "+strStr(x)

WriteStringN(21131,t.s)

CloseFile(21120)

CloseFile(21131)

For i if= (depth0 =To lenn - 1: Print(Chr(d(i) + 'a')): Next

if PrintN(show"")

For i = lenn - 1 To depth Step endif-1

endif

count + deranged(depth + for i =1, lenn, -d(), 1 to depth step -1show)

tmp = d(i): if d(i) = d(depth) :continue:endif d(depth) = tmp

if If n = 0: ProcedureReturn 1:endif EndIf

if If n = 1: ProcedureReturn 0:endif EndIf

ProcedureReturn (sub_fact(n - 1) + sub_fact(n - 2)) * (n - 1)

Procedure.i gen_n(n, show)

Protected r.i

global dim Dim a(1024)

for For i = 0 toTo n - 1: a(i) = i:next Next

ProcedureReturn deranged(0, n, a(), show)

For i = 0 To next9

<pre>Deranged Four:

0: 1 1

1: 0 0

2: 1 1

3: 2 2

4: 9 9

5: 44 44

6: 265 265

7: 1854 1854

8: 14833 14833

9: 133496 133496

10: 1334961

11: 14684570

12: 176214841

13: 2290792932

14: 32071101049

15: 481066515734

16: 7697064251745

17: 130850092279664

18: 2355301661033953

19: 44750731559645106

20: 895014631192902121</pre>

<langsyntaxhighlight lang="python">from itertools import permutations

print("\n!%i = %i" % (n, subfact(n)))</langsyntaxhighlight>

<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:"

do i=1 for d /*showdisplay the derangements for N items.*/

say right('derangement', 22) right(i, length(d) ) '───►' $.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)

say right('!20=' , 4022) !s( 20)

say right('!100200=', 4022) !s(100200)

exit /*stick a fork in it, we're all done. */

!s: _=1; do j=1 for arg(1); if j//2 then _=-1+ j*_ - 1; else _=1+j*_;end;return _ + 1

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.*/

.buildD: do j=1 for arg(1); if @.j==j then return; end

#=#+1; do j=1 for arg(1); $.#= $.# @.j; end; return

.nextD: procedure expose @.; parse arg n,i; 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

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>

!20= 895014631192902121

!200= 290131015521620609254546237518688936375622413566095185632876940298382875066633305125595907908697818551860745708196640009079772455670451355426573609799907339222509103785567575227183775791345718826220455840965346196540544976439608810006794385963854831693077054723298130736781093200499800934036993104223443563872463385599425635345341317933466521378117877578807421014599223577201

<langsyntaxhighlight lang="tcl">package require Tcl 8.5; # for arbitrary-precision integers

}</langsyntaxhighlight>

<langsyntaxhighlight lang="tcl">foreach d [deranged1to 4] {

puts "\n!20 = [subfact 20]"</langsyntaxhighlight>