A247005 Number A(n,k) of permutations on [n] that are the k-th power of a permutation; square array A(n,k), n>=0, k>=0, read by antidiagonals.

1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 6, 1, 1, 1, 2, 3, 24, 1, 1, 1, 1, 4, 12, 120, 1, 1, 1, 2, 3, 16, 60, 720, 1, 1, 1, 1, 6, 9, 80, 270, 5040, 1, 1, 1, 2, 1, 24, 45, 400, 1890, 40320, 1, 1, 1, 1, 6, 4, 96, 225, 2800, 14280, 362880, 1, 1, 1, 2, 3, 24, 40, 576, 1575, 22400, 128520, 3628800, 1

Offset: 0

Author

Alois P. Heinz, Sep 09 2014

Keywords

• nonn
• tabl

Comments

Number of permutations p on [n] such that a permutation q on [n] exists with p=q^k.

Examples

			A(3,0) = 1: (1,2,3).
A(3,1) = 6: (1,2,3), (1,3,2), (2,1,3), (2,3,1), (3,1,2), (3,2,1).
A(3,2) = 3: (1,2,3), (2,3,1), (3,1,2).
A(3,3) = 4: (1,2,3), (1,3,2), (2,1,3), (3,2,1).
Square array A(n,k) begins:
  1,    1,    1,    1,    1,    1,    1,    1,    1, ...
  1,    1,    1,    1,    1,    1,    1,    1,    1, ...
  1,    2,    1,    2,    1,    2,    1,    2,    1, ...
  1,    6,    3,    4,    3,    6,    1,    6,    3, ...
  1,   24,   12,   16,    9,   24,    4,   24,    9, ...
  1,  120,   60,   80,   45,   96,   40,  120,   45, ...
  1,  720,  270,  400,  225,  576,  190,  720,  225, ...
  1, 5040, 1890, 2800, 1575, 4032, 1330, 4320, 1575, ...
		

Links

• Alois P. Heinz, Antidiagonals n = 0..140, flattened
• William Y. C. Chen and Elena L. Wang, r-Enriched Permutations and an Inequality of Bóna-McLennan-White, arXiv:2502.04136 [math.CO], 2025. See pp. 3, 14.
• H. S. Wilf, Generatingfunctionology, 2nd edn., Academic Press, NY, 1994, Theorem 4.8.2.

Crossrefs

Columns k=0-10 give: A000012, A000142, A003483, A103619, A103620, A215716, A215717, A215718, A247006, A247007, A247008.

Main diagonal gives A247009.

Cf. A247026 (the same for endofunctions), A155510.

Programs

Maple

with(combinat): with(numtheory): with(padic):
b:= proc(n, i, k) option remember; `if`(n=0, 1, `if`(i<1, 0, add(
      `if`(irem(j, mul(p^ordp(k, p), p=factorset(i)))=0, (i-1)!^j*
      multinomial(n, n-i*j, i$j)/j!*b(n-i*j, i-1, k), 0), j=0..n/i)))
    end:
A:= (n, k)-> `if`(k=0, 1, b(n$2, k)):
seq(seq(A(n, d-n), n=0..d), d=0..14);

Mathematica

multinomial[n_, k_List] := n!/Times @@ (k!); b[, 1, ] = 1; b[n_, i_, k_] := b[n, i, k] = If[n == 0, 1, If[i < 1, 0, Sum[If[Mod[j, Product[ p^IntegerExponent[k, p], {p, FactorInteger[i][[All, 1]]}]] == 0, (i - 1)!^j*multinomial[n, Join[{n-i*j}, Array[i&, j]]]/j!*b[n-i*j, i-1, k], 0], {j, 0, n/i}]]]; A[n_, k_] := If[k == 0, 1, b[n, n, k]]; Table[A[n, d - n], {d, 0, 14}, {n, 0, d}] // Flatten (* Jean-François Alcover, Jan 14 2017, after Alois P. Heinz *)