A245910
Number A(n,k) of pairs of endofunctions f, g on [n] satisfying f(g^k(i)) = f(i) for all i in [n]; square array A(n,k), n>=0, k>=0, read by antidiagonals.
Original entry on oeis.org
1, 1, 1, 1, 1, 16, 1, 1, 10, 729, 1, 1, 12, 159, 65536, 1, 1, 10, 249, 3496, 9765625, 1, 1, 12, 207, 7744, 98345, 2176782336, 1, 1, 10, 249, 6856, 326745, 3373056, 678223072849, 1, 1, 12, 159, 9184, 302345, 17773056, 136535455, 281474976710656
Offset: 0
Square array A(n,k) begins:
0 : 1, 1, 1, 1, 1, 1, ...
1 : 1, 1, 1, 1, 1, 1, ...
2 : 16, 10, 12, 10, 12, 10, ...
3 : 729, 159, 249, 207, 249, 159, ...
4 : 65536, 3496, 7744, 6856, 9184, 3496, ...
5 : 9765625, 98345, 326745, 302345, 488745, 173225, ...
Columns k=0-10 give:
A062206,
A239761,
A239777,
A245912,
A245913,
A245914,
A245915,
A245916,
A245917,
A245918,
A245919.
-
with(combinat):
b:= proc(n, i, k) option remember; unapply(`if`(n=0 or i=1, x^n,
expand(add((i-1)!^j*multinomial(n, n-i*j, i$j)/j!*
x^(igcd(i, k)*j)*b(n-i*j, i-1, k)(x), j=0..n/i))), x)
end:
A:= (n, k)-> `if`(k=0, n^(2*n), add(binomial(n-1, j-1)*n^(n-j)*
b(j$2, k)(n), j=0..n)):
seq(seq(A(n, d-n), n=0..d), d=0..10);
-
multinomial[n_, k_List] := n!/Times @@ (k!); b[n_, i_, k_] := b[n, i, k] = Function[{x}, If[n == 0 || i == 1, x^n, Expand[Sum[(i-1)!^j*multinomial[n, Join[{ n-i*j}, Array[i&, j]]]/j!*x^(GCD[i, k]*j)*b[n-i*j, i-1, k][x], {j, 0, n/i}]]]]; A[0, ] = 1; A[n, k_] := If[k == 0, n^(2n), Sum[Binomial[n-1, j-1]*n^(n-j)* b[j, j, k][n], {j, 0, n}]]; Table[A[n, d-n], {d, 0, 10}, {n, 0, d}] // Flatten (* Jean-François Alcover, Feb 04 2015, after Alois P. Heinz *)
A245988
Number of pairs of endofunctions f, g on [n] satisfying g^n(f(i)) = f(i) for all i in [n].
Original entry on oeis.org
1, 1, 10, 141, 9592, 159245, 86252976, 908888155, 1682479423360, 128805405787953, 93998774487116800, 1099662085349496911, 44830846497021739693056, 147548082727234113659293, 3534565745374740945151080448, 1613371163531618738559582856125
Offset: 0
-
with(numtheory): with(combinat): M:=multinomial:
a:= proc(n) option remember; local l, g; l, g:= sort([divisors(n)[]]),
proc(k, m, i, t) option remember; local d, j; d:= l[i];
`if`(i=1, n^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; forget(g);
`if`(n=0, 1, add(g(j, n-j, nops(l), 0)*
stirling2(n, j)*binomial(n, j)*j!, j=0..n))
end:
seq(a(n), n=0..20);
-
multinomial[n_, k_List] := n!/Times @@ (k!); M = multinomial;
b[n_, k0_, p_] := Module[{l, g}, l = Sort[Divisors[p]];
g[k_, m_, i_, t_] := g[k, m, i, t] = Module[{d, j}, d = l[[i]];
If[i == 1, n^m, Sum[M[k, Join[{k-(d-t)*j}, Array[(d - t) &, j]]]/j!*
(d - 1)!^j*M[m, Join[{m - t*j}, Array[t &, j]]]*
If[d - t == 1, g[k - (d - t)*j, m - t*j, i - 1, 0],
g[k - (d - t)*j, m - t*j, i, t + 1]], {j, 0, Min[k/(d - t),
If[t == 0, Infinity, m/t]]}]]]; g[k0, n - k0, Length[l], 0]];
A[n_, k_] := If[k == 0, n^(2*n), Sum[b[n, j, k]*StirlingS2[n,j]*Binomial[n, j]*j!, {j, 0, n}]];
A[0, ] = A[1, ] = 1;
a[n_] := A[n, n];
Table[a[n], {n, 0, 20}] (* Jean-François Alcover, Apr 29 2022, after Alois P. Heinz in A245980 *)
Showing 1-2 of 2 results.