A246070 Number A(n,k) of endofunctions f on [2n] satisfying f^k(i) = i for all i in [n]; square array A(n,k), n>=0, k>=0, read by antidiagonals.
1, 1, 4, 1, 2, 256, 1, 3, 16, 46656, 1, 2, 50, 216, 16777216, 1, 3, 36, 1626, 4096, 10000000000, 1, 2, 56, 1440, 83736, 100000, 8916100448256, 1, 3, 16, 2688, 84624, 6026120, 2985984, 11112006825558016, 1, 2, 70, 720, 215760, 7675200, 571350096, 105413504, 18446744073709551616
Offset: 0
Examples
Square array A(n,k) begins: 0 : 1, 1, 1, 1, 1, 1, ... 1 : 4, 2, 3, 2, 3, 2, ... 2 : 256, 16, 50, 36, 56, 16, ... 3 : 46656, 216, 1626, 1440, 2688, 720, ... 4 : 16777216, 4096, 83736, 84624, 215760, 94816, ... 5 : 10000000000, 100000, 6026120, 7675200, 24899120, 11218000, ...
Links
- Alois P. Heinz, Antidiagonals n = 0..70, flattened
Crossrefs
Programs
-
Maple
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, (2*n)^(2*n), b(2*n, n, k)): seq(seq(A(n, d-n), n=0..d), d=0..10); -
Mathematica
multinomial[n_, k_List] := n!/Times @@ (k!); M = multinomial; b[n_, k0_, p_] := Module[{l, g}, l = Divisors[p]; g[k_, m_, i_, t_] := g[k, m, i, t] = Module[{d, j}, d = l[[i]]; If[i == 1, If[m == 0, 1, n^m], Sum[M[k, Join[{k - (d - t)*j}, Table[d - t, {j}]]]/j!*If[j == 0, 1, (d - 1)!^j]*M[m, Join[{m - t*j}, Array[t&, j]]]*g[k - (d - t)*j, m - t*j, Sequence @@ If[d - t == 1, {i - 1, 0}, {i, t + 1}]], {j, 0, Min[k/(d - t), If[t == 0, {}, m/t]]}]]]; g[k0, n - k0, Length[l], 0]]; A[n_, k_] := If[k == 0, If[n == 0, 1, (2n)^(2n)], b[2*n, n, k]]; Table[A[n, d - n], {d, 0, 10}, {n, 0, d}] // Flatten (* Jean-François Alcover, May 27 2016, after Alois P. Heinz, updated Jan 01 2021 *)