A246072 Number A(n,k) of permutations p on [2n] satisfying p^k(i) = i for all i in [n]; square array A(n,k), n>=0, k>=0, read by antidiagonals.
1, 1, 2, 1, 1, 24, 1, 2, 2, 720, 1, 1, 10, 6, 40320, 1, 2, 10, 84, 24, 3628800, 1, 1, 16, 108, 1032, 120, 479001600, 1, 2, 2, 264, 1800, 17040, 720, 87178291200, 1, 1, 18, 150, 6672, 47520, 359280, 5040, 20922789888000
Offset: 0
Examples
A(2,3) = 10: (1,2,3,4), (1,2,4,3), (1,3,4,2), (1,4,2,3), (2,3,1,4), (2,4,3,1), (3,1,2,4), (3,2,4,1), (4,1,3,2), (4,2,1,3). a(2,4) = 16: (1,2,3,4), (1,2,4,3), (1,3,2,4), (1,4,3,2), (2,1,3,4), (2,1,4,3), (2,3,4,1), (2,4,1,3), (3,1,4,2), (3,2,1,4), (3,4,1,2), (3,4,2,1), (4,1,2,3), (4,2,3,1), (4,3,1,2), (4,3,2,1). A(2,5) = 2: (1,2,3,4), (1,2,4,3). A(3,1) = 6: (1,2,3,4,5,6), (1,2,3,4,6,5), (1,2,3,5,4,6), (1,2,3,5,6,4), (1,2,3,6,4,5), (1,2,3,6,5,4). Square array A(n,k) begins: 0 : 1, 1, 1, 1, 1, 1, ... 1 : 2, 1, 2, 1, 2, 1, ... 2 : 24, 2, 10, 10, 16, 2, ... 3 : 720, 6, 84, 108, 264, 150, ... 4 : 40320, 24, 1032, 1800, 6672, 2424, ... 5 : 3628800, 120, 17040, 47520, 241440, 109200, ...
Links
- Alois P. Heinz, Antidiagonals n = 0..90, flattened
Crossrefs
Programs
-
Maple
with(numtheory): with(combinat): M:=multinomial: b:= proc(n, k, p) local l, g; l, g:= sort([divisors(p)[]]), proc(k, m, i, t) option remember; local d, j; d:= l[i]; `if`(i=1, m!, add(M(k, k-(d-t)*j, (d-t)$j)/j!* (d-1)!^j *M(m, m-t*j, t$j) *g(k-(d-t)*j, m-t*j, `if`(d-t=1, [i-1, 0], [i, t+1])[]), j=0..min(k/(d-t), `if`(t=0, [][], m/t)))) end; g(k, n-k, nops(l), 0) end: A:= (n, k)-> `if`(k=0, (2*n)!, b(2*n, n, k)): seq(seq(A(n, d-n), n=0..d), d=0..12); -
Mathematica
multinomial[n_, k_List] := n!/Times @@ (k!); M = multinomial; b[n_, k_, p_] := b[n, k, p] = Module[{l, g}, l = Sort[Divisors[p]]; g[k0_, m_, i_, t_] := g[k0, m, i, t] = Module[{d}, d = l[[i]]; If[i == 1, m!, Sum[ M[k0, Join[{k0-(d-t)*j}, Table[d-t, {j}]]]/j!*(d-1)!^j*M[m, Join[{m-t*j}, Table[t, {j}]]]*If[d-t == 1, g[k0-(d-t)*j, m-t*j, i-1, 0], g[k0-(d-t)*j, m-t*j, i, t+1]], {j, 0, Min[k0/(d-t), If[t == 0, Infinity, m/t]]}]]]; g[k, n-k, Length[l], 0]]; A[n_, k_] := If[k == 0, (2*n)!, b[2*n, n, k]]; Table[Table[A[n, d-n], {n, 0, d}], {d, 0, 12}] // Flatten (* Jean-François Alcover, Jan 06 2015, after Alois P. Heinz *)
Comments