login
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.
13
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,9
COMMENTS
Number of permutations p on [n] such that a permutation q on [n] exists with p=q^k.
LINKS
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. See also Enriched Cycle Structures and Roots of Permutations, Tianjin Univ. (China, 2025). See pp. 2, 15.
H. S. Wilf, Generatingfunctionology, 2nd edn., Academic Press, NY, 1994, Theorem 4.8.2.
FORMULA
T(n,k) = T(n,k+A003418(n)). - Geoffrey Critzer, Dec 25 2025
EXAMPLE
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, ...
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 *)
CROSSREFS
Main diagonal gives A247009.
Cf. A247026 (the same for endofunctions), A155510.
Cf. A003418.
Sequence in context: A202480 A124341 A275062 * A380164 A174215 A364457
KEYWORD
nonn,tabl
AUTHOR
Alois P. Heinz, Sep 09 2014
STATUS
approved