Permutations/Derangements: Difference between revisions
Line 893: | Line 893: | ||
!20 = 895014631192902121</pre> |
!20 = 895014631192902121</pre> |
||
=={{header|Mathematica}}== |
|||
<lang Mathematica> |
|||
Needs["Combinatorica`"] |
|||
derangements[n_] := Derangements[Range[n]] |
|||
derangements[4] |
|||
Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm |
|||
Subfactorial[20]</lang> |
|||
Output: |
|||
<pre> |
|||
{{2, 1, 4, 3}, {2, 3, 4, 1}, {2, 4, 1, 3}, {3, 1, 4, 2}, {3, 4, 1, 2}, |
|||
{3, 4, 2, 1}, {4, 1, 2, 3}, {4, 3, 1, 2}, {4, 3, 2, 1}} |
|||
0 0 |
|||
1 1 |
|||
2 2 |
|||
9 9 |
|||
44 44 |
|||
265 265 |
|||
1854 1854 |
|||
14833 14833 |
|||
133496 133496 |
|||
895014631192902121 |
|||
</pre> |
|||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
Revision as of 09:27, 22 December 2011
You are encouraged to solve this task according to the task description, using any language you may know.
A derangement is a permutation of the order of distinct items in which no item appears in its original place.
For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0), and (2, 0, 1).
The number of derangements of n distinct items is known as the subfactorial of n, sometimes written as !n. There are various ways to calculate !n.
- Task
The task is to:
- Create a named function/method/subroutine/... to generate derangements of the integers 0..n-1, (or 1..n if you prefer).
- Generate and show all the derangements of 4 integers using the above routine.
- Create a function that calculates the subfactorial of n, !n.
- Print and show a table of the counted number of derangements of n vs. the calculated !n for n from 0..9 inclusive.
As an optional stretch goal:
- Calculate !20.
- Cf.
AutoHotkey
Note that the permutations are generated in lexicographic order, from http://www.autohotkey.com/forum/topic77959.html <lang AHK>#NoEnv SetBatchLines -1 Process, Priority,, high
output := "Derangements for 1, 2, 3, 4:`n"
obj := [1, 2, 3, 4], objS := obj.Clone() Loop ; permute 4 { obj := perm_NextObj(Obj) If !obj break For k, v in obj if ( objS[k] = v ) continue 2 output .= ObjDisp(obj) "`n" } output .= "`nTable of n, counted, calculated derangements:`n"
Loop 10 ; Count !n { obj := [] count := 0 output .= A_Tab . (i := A_Index-1) . A_Tab Loop % i obj[A_Index] := A_Index objS := obj.Clone() Loop { obj := perm_NextObj(Obj) If !obj break For k, v in obj if ( objS[k] = v ) continue 2 count++ } output .= count . A_Tab . cd(i) . "`n" } output .= "`nApproximation of !20: " . cd(20) MsgBox % Clipboard := output
perm_NextObj(obj){ ; next lexicographic permutation p := 0, objM := ObjMaxIndex(obj) Loop % objM { If A_Index=1 continue t := obj[objM+1-A_Index] n := obj[objM+2-A_Index] If ( t < n ) { p := objM+1-A_Index, pC := obj[p] break } } If !p return false Loop { t := obj[objM+1-A_Index] If ( t > pC ) { n := objM+1-A_Index, nC := obj[n] break } }
obj[n] := pC, obj[p] := nC return ObjReverse(obj, objM-p) }
ObjReverse(Obj, tail){
o := ObjClone(Obj), ObjM := ObjMaxIndex(O) Loop % tail
o[ObjM-A_Index+1] := Obj[ObjM+A_Index-tail]
return o
}
ObjDisp(obj){ For k, v in obj s .= v ", " return SubStr(s, 1, strLen(s)-2) }
cd(n){ ; Count Derangements
static e := 2.71828182845904523536028747135
return n ? floor(ft(n)/e + 1/2) : 1
}
ft(n){ ; FacTorial
a := 1
Loop % n
a *= A_Index
return a
}</lang>
Output:
Derangements for 1, 2, 3, 4: 2, 1, 4, 3 2, 3, 4, 1 2, 4, 1, 3 3, 1, 4, 2 3, 4, 1, 2 3, 4, 2, 1 4, 1, 2, 3 4, 3, 1, 2 4, 3, 2, 1 Table of n, counted, calculated derangements: 0 0 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 Approximation of !20: 895014631192902144
BBC BASIC
<lang BBC BASIC> PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE) PRINT'"Table of n, counted derangements, calculated derangements :" FOR I% = 0 TO 9 PRINT I%, FN_Derangement_Generate(I%,FALSE), FN_SubFactorial(I%) NEXT PRINT'"There is no long int in BBC BASIC!" PRINT"!20 = ";FN_SubFactorial(20) END DEF FN_Derangement_Generate(N%, fPrintOut) LOCAL A%(), O%(), C%, D%, I%, J% IF N% = 0 THEN = 1 DIM A%(N%-1), O%(N%-1) FOR I% = 0 TO N%-1 : A%(I%) = I% : NEXT O%() = A%() FOR I% = 0 TO FN_Factorial(DIM(A%(),1)+1)-1 PROC_NextPermutation(A%()) D% = TRUE FOR J%=0 TO N%-1 IF A%(J%) = O%(J%) THEN D% = FALSE NEXT IF D% THEN C% += 1 IF fPrintOut THEN FOR K% = 0 TO N%-1 PRINT ;A%(K%);" "; NEXT PRINT ENDIF ENDIF NEXT = C% DEF PROC_NextPermutation(A%()) LOCAL first, last, elementcount, pos elementcount = DIM(A%(),1) IF elementcount < 1 THEN ENDPROC pos = elementcount-1 WHILE A%(pos) >= A%(pos+1) pos -= 1 IF pos < 0 THEN PROC_Permutation_Reverse(A%(), 0, elementcount) ENDPROC ENDIF ENDWHILE last = elementcount WHILE A%(last) <= A%(pos) last -= 1 ENDWHILE SWAP A%(pos), A%(last) PROC_Permutation_Reverse(A%(), pos+1, elementcount) ENDPROC DEF PROC_Permutation_Reverse(A%(), firstindex, lastindex) LOCAL first, last first = firstindex last = lastindex WHILE first < last SWAP A%(first), A%(last) first += 1 last -= 1 ENDWHILE ENDPROC DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN =1 ELSE = N * FN_Factorial(N-1) DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE =N*FN_SubFactorial(N-1)+-1^N REM Or you could use: REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))</lang>
The program outputs the following : <lang>Derangements for the numbers 0,1,2,3 are: 1 0 3 2 1 2 3 0 1 3 0 2 2 0 3 1 2 3 0 1 2 3 1 0 3 0 1 2 3 2 0 1 3 2 1 0
Table of n, counted derangements, calculated derangements :
0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496
There is no long int in BBC BASIC! !20 = 8.95014632E17 ></lang>
C
<lang C>#include <stdio.h> typedef unsigned long long LONG;
LONG deranged(int depth, int len, int *d, int show) {
int i; char tmp; LONG count = 0;
if (depth == len) { if (show) { for (i = 0; i < len; i++) putchar(d[i] + 'a'); putchar('\n'); } return 1; } for (i = len - 1; i >= depth; i--) { if (i == d[depth]) continue;
tmp = d[i]; d[i] = d[depth]; d[depth] = tmp; count += deranged(depth + 1, len, d, show); tmp = d[i]; d[i] = d[depth]; d[depth] = tmp; } return count;
}
LONG gen_n(int n, int show) {
LONG i; int a[1024]; /* 1024 ought to be big enough for anybody */
for (i = 0; i < n; i++) a[i] = i; return deranged(0, n, a, show);
}
LONG sub_fact(int n) {
return n < 2 ? 1 - n : (sub_fact(n - 1) + sub_fact(n - 2)) * (n - 1);
}
int main() {
int i;
printf("Deranged Four:\n"); gen_n(4, 1);
printf("\nCompare list vs calc:\n"); for (i = 0; i < 10; i++) printf("%d:\t%llu\t%llu\n", i, gen_n(i, 0), sub_fact(i));
printf("\nfurther calc:\n"); for (i = 10; i <= 20; i++) printf("%d: %llu\n", i, sub_fact(i));
return 0;
}</lang>
Output:
Deranged Four: dabc dcab dcba cdba cdab cadb bdac bcda badc Compare list vs calc: 0: 1 1 1: 0 0 2: 1 1 3: 2 2 4: 9 9 5: 44 44 6: 265 265 7: 1854 1854 8: 14833 14833 9: 133496 133496 further calc: 10: 1334961 11: 14684570 12: 176214841 13: 2290792932 14: 32071101049 15: 481066515734 16: 7697064251745 17: 130850092279664 18: 2355301661033953 19: 44750731559645106 20: 895014631192902121
D
<lang d>import std.stdio, std.algorithm, std.typecons, std.array,
std.conv, std.range, std.traits;
auto derangements(in size_t n, in bool countOnly=false) /*pure nothrow*/ {
size_t[] seq = array(iota(n)); auto ori = seq.idup; size_t[][] all; size_t cnt = n == 0; foreach (tot; 0 .. fact(n)-1) { size_t j = n - 2; while (seq[j] > seq[j + 1]) j--; size_t k = n - 1; while (seq[j] > seq[k]) k--; swap(seq[k], seq[j]); size_t r = n - 1; size_t s = j + 1; while (r > s) { swap(seq[s], seq[r]); r--; s++; } j = 0; while (j < n && seq[j] != ori[j]) j++; if (j == n) { if (countOnly) cnt++; else all ~= seq.dup; } }
return tuple(all, cnt);
}
T fact(T)(in T n) pure nothrow {
Unqual!T result = 1; for (Unqual!T i = 2; i <= n; i++) result *= i; return result;
}
T subfact(T)(in T n) pure nothrow {
if (0 <= n && n <= 2) return n != 1; return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
void main() {
writeln("derangements for n = 4\n"); foreach (d; derangements(4)[0]) writeln(d);
writeln("\ntable of n vs counted vs calculated derangements\n"); foreach (i; 0 .. 10) writefln("%s %-7s%-7s", i, derangements(i, 1)[1], subfact(i)); writefln("\n!20 = %s", subfact(20L));
}</lang>
Output:
derangements for n = 4 [1, 0, 3, 2] [1, 2, 3, 0] [1, 3, 0, 2] [2, 0, 3, 1] [2, 3, 0, 1] [2, 3, 1, 0] [3, 0, 1, 2] [3, 2, 0, 1] [3, 2, 1, 0] table of n vs counted vs calculated derangements 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 !20 = 895014631192902121
Slightly slower but more compact recursive version of the derangements function, based on the D entry of the permutations task.
<lang d>import std.stdio, std.algorithm, std.typecons, std.array,
std.conv, std.range, std.traits;
auto derangementsR(in size_t n, in bool countOnly=false) {
auto seq = array(iota(n)); /*immutable*/ auto ori = seq.dup; size_t[][] res; size_t cnt; void perms(in size_t[] s, size_t[] pre=[]) nothrow { if (s.length) { foreach (i, c; s) perms(s[0 .. i] ~ s[i + 1 .. $], pre ~ c); } else if (mismatch!q{a != b}(pre, ori)[0].length == 0) { if (countOnly) cnt++; else res ~= pre; } } perms(seq); return tuple(res, cnt);
}
T fact(T)(in T n) pure nothrow {
Unqual!T result = 1; for (Unqual!T i = 2; i <= n; i++) result *= i; return result;
}
T subfact(T)(in T n) pure nothrow {
if (0 <= n && n <= 2) return n != 1; return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
void main() {
writeln("derangements for n = 4\n"); foreach (d; derangementsR(4)[0]) writeln(d);
writeln("\ntable of n vs counted vs calculated derangements\n"); foreach (i; 0 .. 10) writefln("%s %-7s%-7s", i, derangementsR(i, 1)[1], subfact(i)); writefln("\n!20 = %s", subfact(20L));
}</lang>
GAP
<lang gap># All of this is built-in Derangements([1 .. 4]);
- [ [ 2, 1, 4, 3 ], [ 2, 3, 4, 1 ], [ 2, 4, 1, 3 ], [ 3, 1, 4, 2 ], [ 3, 4, 1, 2 ], [ 3, 4, 2, 1 ],
- [ 4, 1, 2, 3 ], [ 4, 3, 1, 2 ], [ 4, 3, 2, 1 ] ]
Size(last);
- 9
NrDerangements([1 .. 4]);
- 9
- An implementation using formula D(n + 1) = n*(D(n) + D(n - 1))
NrDerangementsAlt_memo := [1, 0]; NrDerangementsAlt := function(n) if not IsBound(NrDerangementsAlt_memo[n + 1]) then NrDerangementsAlt_memo[n + 1] := (n - 1)*(NrDerangementsAlt(n - 1) + NrDerangementsAlt(n - 2)); fi; return NrDerangementsAlt_memo[n + 1]; end;
L := List([0 .. 9]);
PrintArray(TransposedMat([L, List(L, n -> Size(Derangements([1 .. n]))), List(L, n -> NrDerangements([1 .. n])), List(L, NrDerangementsAlt)]));
- [ [ 0, 1, 1, 1 ],
- [ 1, 0, 0, 0 ],
- [ 2, 1, 1, 1 ],
- [ 3, 2, 2, 2 ],
- [ 4, 9, 9, 9 ],
- [ 5, 44, 44, 44 ],
- [ 6, 265, 265, 265 ],
- [ 7, 1854, 1854, 1854 ],
- [ 8, 14833, 14833, 14833 ],
- [ 9, 133496, 133496, 133496 ] ]</lang>
Go
<lang go>package main
import (
"fmt" "math/big"
)
// task 1: function returns list of derangements of n integers func dList(n int) (r [][]int) {
a := make([]int, n) for i := range a { a[i] = i } // recursive closure permutes a var recurse func(last int) recurse = func(last int) { if last == 0 { // bottom of recursion. you get here once for each permutation. // test if permutation is deranged. for j, v := range a { if j == v { return // no, ignore it } } // yes, save a copy r = append(r, append([]int{}, a...)) return } for i := last; i >= 0; i-- { a[i], a[last] = a[last], a[i] recurse(last - 1) a[i], a[last] = a[last], a[i] } } recurse(n - 1) return
}
// task 3: function computes subfactorial of n func subFact(n int) *big.Int {
if n == 0 { return big.NewInt(1) } else if n == 1 { return big.NewInt(0) } d0 := big.NewInt(1) d1 := big.NewInt(0) f := new(big.Int) for i, n64 := int64(1), int64(n); i < n64; i++ { d0, d1 = d1, d0.Mul(f.SetInt64(i), d0.Add(d0, d1)) } return d1
}
func main() {
// task 2: fmt.Println("Derangements of 4 integers") for _, d := range dList(4) { fmt.Println(d) }
// task 4: fmt.Println("\nNumber of derangements") fmt.Println("N Counted Calculated") for n := 0; n <= 9; n++ { fmt.Printf("%d %8d %11s\n", n, len(dList(n)), subFact(n).String()) }
// stretch (sic) fmt.Println("\n!20 =", subFact(20))
}</lang> Output:
Derangements of 4 integers [1 0 3 2] [3 0 1 2] [1 3 0 2] [2 0 3 1] [2 3 0 1] [3 2 0 1] [3 2 1 0] [2 3 1 0] [1 2 3 0] Number of derangements N Counted Calculated 0 0 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 !20 = 895014631192902121
Groovy
Solution: <lang groovy>def fact = { n -> [1,(1..<(n+1)).inject(1) { prod, i -> prod * i }].max() } def subfact subfact = { BigInteger n -> (n == 0) ? 1 : (n == 1) ? 0 : ((n-1) * (subfact(n-1) + subfact(n-2))) }
def derangement = { List l ->
def d = [] l.eachPermutation { p -> if ([p,l].transpose().every{ it[0] != it[1] }) d << p } d
}</lang>
Test: <lang groovy>def d = derangement([1,2,3,4]) assert d.size() == subfact(4) d.each { println it }
println """ n # derangements subfactorial = ============== ============""" (0..9). each { n ->
def dr = derangement((1..<(n+1)) as List) def sf = subfact(n) printf('%1d %14d %12d\n', n, dr.size(), sf)
}
println """ !20 == ${subfact(20)} """</lang>
Output:
[2, 1, 4, 3] [2, 3, 4, 1] [2, 4, 1, 3] [3, 1, 4, 2] [3, 4, 1, 2] [3, 4, 2, 1] [4, 1, 2, 3] [4, 3, 1, 2] [4, 3, 2, 1] n # derangements subfactorial = ============== ============ 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 !20 == 895014631192902121
Haskell
<lang Haskell>import Control.Monad import Data.List
-- Compute all derangements of a list derangements xs = filter (and . zipWith (/=) xs) $ permutations xs
-- Compute the number of derangements of n elements subfactorial 0 = 0 subfactorial 1 = 0 subfactorial 2 = 1 subfactorial n = (n-1) * (subfactorial (n-1) + subfactorial (n-2))
main = do
-- Generate and show all the derangements of four integers print $ derangements [1..4] putStrLn ""
-- Print the count of derangements vs subfactorial forM_ [1..9] $ \i -> putStrLn $ show (length (derangements [1..i])) ++ " " ++ show (subfactorial i) putStrLn ""
-- Print the number of derangements in a list of 20 items print $ subfactorial 20</lang>
Requested output:
[[4,3,2,1],[3,4,2,1],[2,3,4,1],[4,1,2,3],[2,4,1,3],[2,1,4,3],[4,3,1,2],[3,4,1,2],[3,1,4,2]] 0 0 1 1 2 2 9 9 44 44 265 265 1854 1854 14833 14833 133496 133496 895014631192902121
Alternatively, this is a backtracking method:
<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)]</lang>
Since the value i cannot occur in position i, we prefix i on all other derangements from 1 to n that do not include i. The first method of filtering permutations is significantly faster, in practice, however.
J
Note: !n in J denotes factorial (or gamma n+1), and not subfactorial.
<lang j>derangement=: (A.&i.~ !)~ (*/ .~: # [) i. NB. task item 1 subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</lang>
Requested examples:
<lang j> derangement 4 NB. task item 2 1 0 3 2 1 2 3 0 1 3 0 2 2 0 3 1 2 3 0 1 2 3 1 0 3 0 1 2 3 2 0 1 3 2 1 0
(,subfactorial,#@derangement)"0 i.10 NB. task item 4
0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496
subfactorial 20 NB. stretch task
8.95015e17
subfactorial 20x NB. using extended precision
895014631192902121</lang>
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 is an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).
Java
<lang java>import java.util.ArrayList; import java.util.Arrays; import java.util.List;
public class Derangement {
public static void main(String[] args) { System.out.println("derangements for n = 4\n"); for (Object d : (ArrayList)(derangements(4, false)[0])) { System.out.println(Arrays.toString((int[])d)); } System.out.println("\ntable of n vs counted vs calculated derangements\n"); for (int i = 0; i < 10; i++) { int d = ((Integer)derangements(i, true)[1]).intValue(); System.out.printf("%d %-7d %-7d\n", i, d, subfact(i)); } System.out.printf ("\n!20 = %20d\n", subfact(20L)); }
static Object[] derangements(int n, boolean countOnly) { int[] seq = iota(n); int[] ori = Arrays.copyOf(seq, n); long tot = fact(n);
List<int[]> all = new ArrayList<int[]>(); int cnt = n == 0 ? 1 : 0;
while (--tot > 0) { int j = n - 2; while (seq[j] > seq[j + 1]) { j--; } int k = n - 1; while (seq[j] > seq[k]) { k--; } swap(seq, k, j);
int r = n - 1; int s = j + 1; while (r > s) { swap(seq, s, r); r--; s++; }
j = 0; while (j < n && seq[j] != ori[j]) { j++; } if (j == n) { if (countOnly) { cnt++; } else { all.add(Arrays.copyOf(seq, n)); } } } return new Object[]{all, cnt}; }
static long fact(long n) { long result = 1; for (long i = 2; i <= n; i++) { result *= i; } return result; }
static long subfact(long n) { if (0 <= n && n <= 2) { return n != 1 ? 1 : 0; } return (n - 1) * (subfact(n - 1) + subfact(n - 2)); }
static void swap(int[] arr, int lhs, int rhs) { int tmp = arr[lhs]; arr[lhs] = arr[rhs]; arr[rhs] = tmp; }
static int[] iota(int n) { if (n < 0) { throw new IllegalArgumentException("iota cannot accept < 0"); } int[] r = new int[n]; for (int i = 0; i < n; i++) { r[i] = i; } return r; }
}</lang>
derangements for n = 4 [1, 0, 3, 2] [1, 2, 3, 0] [1, 3, 0, 2] [2, 0, 3, 1] [2, 3, 0, 1] [2, 3, 1, 0] [3, 0, 1, 2] [3, 2, 0, 1] [3, 2, 1, 0] table of n vs counted vs calculated derangements 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 !20 = 895014631192902121
Mathematica
<lang Mathematica> Needs["Combinatorica`"] derangements[n_] := Derangements[Range[n]] derangements[4] Table[{NumberOfDerangements[i], Subfactorial[i]}, {i, 9}] // TableForm Subfactorial[20]</lang> Output:
{{2, 1, 4, 3}, {2, 3, 4, 1}, {2, 4, 1, 3}, {3, 1, 4, 2}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 3, 1, 2}, {4, 3, 2, 1}} 0 0 1 1 2 2 9 9 44 44 265 265 1854 1854 14833 14833 133496 133496 895014631192902121
PARI/GP
<lang parigp>derangements(n)=if(n,round(n!/exp(1)),1); derange(n)={ my(v=[[]],tmp); for(level=1,n, tmp=List(); for(i=1,#v, for(k=1,n, if(k==level, next); for(j=1,level-1,if(v[i][j]==k, next(2))); listput(tmp, concat(v[i],k)) ) ); v=Vec(tmp) ); v }; derange(4) for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n))) derangements(20)</lang> Output:
%1 = [[2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2], [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1]] !0 = 1 = 1 !1 = 0 = 0 !2 = 1 = 1 !3 = 2 = 2 !4 = 9 = 9 !5 = 44 = 44 !6 = 265 = 265 !7 = 1854 = 1854 !8 = 14833 = 14833 !9 = 133496 = 133496 %2 = 895014631192902121
Perl
<lang Perl>sub d {
# compare this with the deranged() sub to see how to turn procedural # code into functional one ('functional' as not in 'understandable') $#_ ? map d([ @{$_[0]}, $_[$_] ], @_[1 .. $_-1, $_+1 .. $#_ ]), grep { $_[$_] != @{$_[0]} } 1 .. $#_ : $_[0]
}
sub deranged { # same as sub d above, just a readable version to explain method
my ($result, @avail) = @_; return $result if !@avail; # no more elements to pick from, done
my @list; # list of permutations to return for my $i (0 .. $#avail) { # try to add each element to result in turn next if $avail[$i] == @$result; # element n at n-th position, no-no my $e = splice @avail, $i, 1; # move the n-th element from available to result push @list, deranged([ @$result, $e ], @avail); # and recurse down, keep what's returned splice @avail, $i, 0, $e; # put that element back, try next } return @list;
}
sub choose { # choose k among n, i.e. n! / k! (n-k)!
my ($n, $k) = @_; factorial($n) / factorial($k) / factorial($n - $k)
}
my @fact = (1); sub factorial {
# //= : standard caching technique. If cached value available, # return it; else compute, cache and return. # For this specific task not really necessary. $fact[ $_[0] ] //= $_[0] * factorial($_[0] - 1)
}
my @subfact; sub sub_factorial {
my $n = shift; $subfact[$n] //= do # same caching stuff, try comment out this line { # computes deranged without formula, using recursion my $total = factorial($n); # total permutations for my $k (1 .. $n) { # minus the permutations where k items are fixed # to original location, and the rest deranged $total -= choose($n, $k) * sub_factorial($n - $k) } $total }
}
print "Derangements for 3 elements:\n"; my @deranged = d([], 0 .. 3); for (1 .. @deranged) {
print "$_: @{$deranged[$_-1]}\n"
}
print "\nCompare list length and calculated table\n"; for (0 .. 9) {
my @x = d([], 0 .. $_-1); print $_, "\t", scalar(@x), "\t", sub_factorial($_), "\n"
}
print "\nNumber of derangements:\n"; print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</lang>
Output:
Derangements for 3 elements: 1: 1 0 3 2 2: 1 2 3 0 3: 1 3 0 2 4: 2 0 3 1 5: 2 3 0 1 6: 2 3 1 0 7: 3 0 1 2 8: 3 2 0 1 9: 3 2 1 0 Compare list length and calculated table 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 Number of derangements: 1: 0 2: 1 3: 2 4: 9 5: 44 6: 265 7: 1854 8: 14833 9: 133496 10: 1334961 11: 14684570 12: 176214841 13: 2290792932 14: 32071101049 15: 481066515734 16: 7697064251745 17: 130850092279664 18: 2355301661033953 19: 44750731559645106 20: 895014631192902121
PicoLisp
<lang PicoLisp>(load "@lib/simul.l") # For 'permute'
(de derangements (Lst)
(filter '((L) (not (find = L Lst))) (permute Lst) ) )
(de subfact (N)
(if (>= 2 N) (if (= 1 N) 0 1) (* (dec N) (+ (subfact (dec N)) (subfact (- N 2))) ) ) )</lang>
Output:
: (derangements (range 1 4)) -> ((2 1 4 3) (2 3 4 1) (2 4 1 3) (3 1 4 2) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 3 1 2) (4 3 2 1)) : (for I (range 0 9) (tab (2 8 8) I (length (derangements (range 1 I))) (subfact I) ) ) 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 -> NIL : (subfact 20) -> 895014631192902121
Python
Includes stretch goal. <lang python>from itertools import permutations import math
def derangements(n):
'All deranged permutations of the integers 0..n-1 inclusive' return ( perm for perm in permutations(range(n)) if all(indx != p for indx, p in enumerate(perm)) )
def subfact(n):
if n == 2 or n == 0: return 1 elif n == 1: return 0 elif 1 <= n <=18: return round(math.factorial(n) / math.e) elif n.imag == 0 and n.real == int(n.real) and n > 0: return (n-1) * ( subfact(n - 1) + subfact(n - 2) ) else: raise ValueError()
def _iterlen(iter):
'length of an iterator without taking much memory' l = 0 for x in iter: l += 1 return l
if __name__ == '__main__':
n = 4 print("Derangements of %s" % (tuple(range(n)),)) for d in derangements(n): print(" %s" % (d,))
print("\nTable of n vs counted vs calculated derangements") for n in range(10): print("%2i %-5i %-5i" % (n, _iterlen(derangements(n)), subfact(n)))
n = 20 print("\n!%i = %i" % (n, subfact(n)))</lang>
- Sample output
Derangements of (0, 1, 2, 3) (1, 0, 3, 2) (1, 2, 3, 0) (1, 3, 0, 2) (2, 0, 3, 1) (2, 3, 0, 1) (2, 3, 1, 0) (3, 0, 1, 2) (3, 2, 0, 1) (3, 2, 1, 0) Table of n vs counted vs calculated derangements 0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 !20 = 895014631192902121
Ruby
<lang ruby>def derangements(n)
ary = (1 .. n).to_a ary.permutation.select do |perm| ary.zip(perm).all? {|a,b| a != b} end
end
def subfact(n)
case n when 0 then 1 when 1 then 0 else (n-1)*(subfact(n-1) + subfact(n-2)) end
end
(0..9).each do |n|
s = subfact(n) if n <= 4 d = derangements(n) puts "n=%d, subfact=%d, num_derangements=%d, %s" % [n, s, d.length, d] else puts "n=%d, subfact=%d" % [n, s] end
end puts "n=20, subfact=#{subfact(20)}"</lang>
output
n=0, subfact=1, num_derangements=1, [[]] n=1, subfact=0, num_derangements=0, [] n=2, subfact=1, num_derangements=1, [[2, 1]] n=3, subfact=2, num_derangements=2, [[2, 3, 1], [3, 1, 2]] n=4, subfact=9, num_derangements=9, [[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=5, subfact=44 n=6, subfact=265 n=7, subfact=1854 n=8, subfact=14833 n=9, subfact=133496 n=20, subfact=895014631192902121
Tcl
<lang tcl>package require Tcl 8.5; # for arbitrary-precision integers package require struct::list; # for permutation enumerator
proc derangements lst {
# Special case if {![llength $lst]} {return {{}}} set result {} for {set perm [struct::list firstperm $lst]} {[llength $perm]} \
{set perm [struct::list nextperm $perm]} { set skip 0 foreach a $lst b $perm { if {[set skip [string equal $a $b]]} break } if {!$skip} {lappend result $perm}
} return $result
}
proc deranged1to n {
for {set i 1;set r {}} {$i <= $n} {incr i} {lappend r $i} return [derangements $r]
}
proc countDeranged1to n {
llength [deranged1to $n]
}
proc subfact n {
if {$n == 0} {return 1} if {$n == 1} {return 0} set o 1 set s 0 for {set i 1} {$i < $n} {incr i} {
set s [expr {$i * ($o + [set o $s])}]
} return $s
}</lang> Demonstrating with the display parts of the task: <lang tcl>foreach d [deranged1to 4] {
puts "derangement of 1..4: $d"
}
puts "\n\tcounted\tcalculated" for {set i 0} {$i <= 9} {incr i} {
puts "!$i\t[countDeranged1to $i]\t[subfact $i]"
}
- Stretch goal
puts "\n!20 = [subfact 20]"</lang> Output:
derangement of 1..4: 2 1 4 3 derangement of 1..4: 2 3 4 1 derangement of 1..4: 2 4 1 3 derangement of 1..4: 3 1 4 2 derangement of 1..4: 3 4 1 2 derangement of 1..4: 3 4 2 1 derangement of 1..4: 4 1 2 3 derangement of 1..4: 4 3 1 2 derangement of 1..4: 4 3 2 1 counted calculated !0 1 1 !1 0 0 !2 1 1 !3 2 2 !4 9 9 !5 44 44 !6 265 265 !7 1854 1854 !8 14833 14833 !9 133496 133496 !20 = 895014631192902121