%I #26 May 09 2018 10:32:59
%S 1,1,2,1,1,24,1,2,2,720,1,1,10,6,40320,1,2,10,84,24,3628800,1,1,16,
%T 108,1032,120,479001600,1,2,2,264,1800,17040,720,87178291200,1,1,18,
%U 150,6672,47520,359280,5040,20922789888000
%N 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.
%C Column k=2 is n! * A005425(n), column k=3 is n! * A242054(n). - _Vaclav Kotesovec_, Aug 13 2014
%H Alois P. Heinz, <a href="/A246072/b246072.txt">Antidiagonals n = 0..90, flattened</a>
%e 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).
%e 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).
%e A(2,5) = 2: (1,2,3,4), (1,2,4,3).
%e 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).
%e Square array A(n,k) begins:
%e 0 : 1, 1, 1, 1, 1, 1, ...
%e 1 : 2, 1, 2, 1, 2, 1, ...
%e 2 : 24, 2, 10, 10, 16, 2, ...
%e 3 : 720, 6, 84, 108, 264, 150, ...
%e 4 : 40320, 24, 1032, 1800, 6672, 2424, ...
%e 5 : 3628800, 120, 17040, 47520, 241440, 109200, ...
%p with(numtheory): with(combinat): M:=multinomial:
%p b:= proc(n, k, p) local l, g; l, g:= sort([divisors(p)[]]),
%p proc(k, m, i, t) option remember; local d, j; d:= l[i];
%p `if`(i=1, m!, add(M(k, k-(d-t)*j, (d-t)$j)/j!*
%p (d-1)!^j *M(m, m-t*j, t$j) *g(k-(d-t)*j, m-t*j,
%p `if`(d-t=1, [i-1, 0], [i, t+1])[]), j=0..min(k/(d-t),
%p `if`(t=0, [][], m/t))))
%p end; g(k, n-k, nops(l), 0)
%p end:
%p A:= (n, k)-> `if`(k=0, (2*n)!, b(2*n, n, k)):
%p seq(seq(A(n, d-n), n=0..d), d=0..12);
%t 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_ *)
%Y Columns k=0-1 give: A010050, A000142. Main diagonal gives A246073.
%Y Cf. A005425, A242054, A246070 (the same for endofunctions).
%K nonn,tabl
%O 0,3
%A _Alois P. Heinz_, Aug 12 2014