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,3

Comments

Column k=2 is n! * A005425(n), column k=3 is n! * A242054(n). - Vaclav Kotesovec, Aug 13 2014

Links

Alois P. Heinz, Antidiagonals n = 0..90, flattened

Example

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, ...

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 *)

Crossrefs

Columns k=0-1 give: A010050, A000142. Main diagonal gives A246073.

Cf. A005425, A242054, A246070 (the same for endofunctions).

Sequence in context: A172177 A156725 A141904 * A147802 A093076 A132454

Adjacent sequences: A246069 A246070 A246071 * A246073 A246074 A246075

Keyword

nonn,tabl

Author

Alois P. Heinz, Aug 12 2014

Status

approved