A245980
Number A(n,k) of pairs of endofunctions f, g on [n] satisfying g^k(f(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, 6, 729, 1, 1, 10, 87, 65536, 1, 1, 6, 213, 2200, 9765625, 1, 1, 10, 141, 8056, 84245, 2176782336, 1, 1, 6, 213, 6184, 465945, 4492656, 678223072849, 1, 1, 10, 87, 9592, 387545, 37823616, 315937195, 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, 6, 10, 6, 10, 6, ...
3 : 729, 87, 213, 141, 213, 87, ...
4 : 65536, 2200, 8056, 6184, 9592, 2200, ...
5 : 9765625, 84245, 465945, 387545, 682545, 159245, ...
Columns k=0-10 give:
A062206,
A239750,
A239771,
A241015,
A245981,
A245982,
A245983,
A245984,
A245985,
A245986,
A245987.
-
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, 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; g(k, n-k, nops(l), 0)
end:
A:= (n, k)-> `if`(k=0, n^(2*n), add(b(n, j, k)*
stirling2(n, j)*binomial(n, j)*j!, j=0..n)):
seq(seq(A(n, d-n), n=0..d), d=0..12);
-
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, ] = 1; A[1, ] = 1;
Table[Table[A[n, d - n], {n, 0, d}], {d, 0, 12}] // Flatten (* Jean-François Alcover, Jan 27 2015, after Alois P. Heinz *)
A239771
Number of pairs of functions (f,g) from a size n set into itself satisfying f(x) = g(g(f(x))).
Original entry on oeis.org
1, 1, 10, 213, 8056, 465945, 37823616, 4075467781, 560230714240, 95369455852497, 19643693349548800, 4805295720474420501, 1374890520609054683136, 454286686896040037996905, 171479277693049020232695808, 73262491601904459123264721125, 35143072854722729593790081499136
Offset: 0
-
g:= proc(n) g(n):= `if`(n<2, 1, g(n-1)+(n-1)*g(n-2)) end:
a:= n-> add(binomial(n, k)*Stirling2(n, k)*k!*
add(binomial(n-k, i)*binomial(k, i)*i!*
g(k-i)*n^(n-k-i), i=0..min(k, n-k)), k=0..n):
seq(a(n), n=0..20); # Alois P. Heinz, Jul 18 2014
-
g[n_] := g[n] = If[n < 2, 1, g[n-1] + (n-1)*g[n-2]];
a[n_] := If[n == 0, 1, Sum[Binomial[n, k]*StirlingS2[n, k]*k!*Sum[ Binomial[n-k, i]*Binomial[k, i]*i!*g[k-i]*n^(n-k-i), {i, 0, Min[k, n-k]} ], {k, 0, n}]];
a /@ Range[0, 20] (* Jean-François Alcover, Oct 03 2019, after Alois P. Heinz *)
A239750
Number of ordered pairs of endofunctions (f,g) on a set of n elements satisfying g(f(x)) = f(f(f(x))).
Original entry on oeis.org
1, 1, 6, 87, 2200, 84245, 4492656, 315937195, 28186856832, 3099006365769, 410478164588800, 64323095036300111, 11748771067445148672, 2470422069374379054493, 591735532838657160296448, 160004357420756572368889875, 48458574881000820765562863616
Offset: 0
-
a:= n-> add(binomial(n, k)*k^n*(n-1)^(n-k), k=0..n):
seq(a(n), n=0..20); # Alois P. Heinz, Jul 23 2014
-
a[n_] := If[n<2, 1, Sum[Binomial[n, k]*k^n*(n-1)^(n-k), {k, 0, n}]];
a /@ Range[0, 20] (* Jean-François Alcover, Oct 03 2019, after Alois P. Heinz *)
A245958
Number T(n,k) of endofunctions f on [n] satisfying f^3(i) = i for all i in [k]; triangle T(n,k), n>=0, 0<=k<=n, read by rows.
Original entry on oeis.org
1, 1, 1, 4, 2, 1, 27, 11, 5, 3, 256, 88, 36, 18, 9, 3125, 925, 335, 141, 57, 21, 46656, 12096, 3912, 1440, 516, 186, 81, 823543, 189679, 55377, 18279, 6003, 2079, 837, 351, 16777216, 3473408, 924160, 277824, 84624, 27672, 10116, 3690, 1233
Offset: 0
Triangle T(n,k) begins:
0 : 1;
1 : 1, 1;
2 : 4, 2, 1;
3 : 27, 11, 5, 3;
4 : 256, 88, 36, 18, 9;
5 : 3125, 925, 335, 141, 57, 21;
6 : 46656, 12096, 3912, 1440, 516, 186, 81;
7 : 823543, 189679, 55377, 18279, 6003, 2079, 837, 351;
...
-
with(combinat): M:=multinomial:
T:= proc(n, k) local l, g; l, g:= [1, 3],
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; g(k, n-k, nops(l), 0)
end:
seq(seq(T(n, k), k=0..n), n=0..12);
-
M[n_, m_, k_List] := n!/Times @@ (Join[{m}, k]!);
T[0, 0] = 1; T[n_, k_] := T[n, k] = Module[{l = {1, 3}, g}, g[k0_, m_, {i_, t_}] := g[k0, m, i, t]; g[k0_, m_, i_, t_] := g[k0, m, i, t] = Module[ {d}, d = l[[i]]; If[i == 1, n^m, Sum[M[k0, k0 - (d-t)*j, Table[(d-t), {j}]]/j!*(d-1)!^j*M[m, m - t*j, Table[t, {j}]]*g[k0 - (d-t)*j, m - t*j, If[d-t == 1, {i-1, 0}, {i, t+1}]], {j, 0, Min[k0/(d-t), If[t == 0, Infinity, m/t]]}]]]; g[k, n-k, Length[l], 0]];
Table[T[n, k], {n, 0, 12}, {k, 0, n}] // Flatten (* Jean-François Alcover, Oct 03 2019, after Alois P. Heinz *)
Showing 1-4 of 4 results.
Comments