A215703 A(n,k) is the n-th derivative of f_k at x=1, and f_k is the k-th of all functions that are representable as x^x^...^x with m>=1 x's and parentheses inserted in all possible ways; square array A(n,k), n>=0, k>=1, read by antidiagonals.
1, 1, 1, 1, 1, 0, 1, 1, 2, 0, 1, 1, 4, 3, 0, 1, 1, 2, 12, 8, 0, 1, 1, 6, 9, 52, 10, 0, 1, 1, 4, 27, 32, 240, 54, 0, 1, 1, 2, 18, 156, 180, 1188, -42, 0, 1, 1, 2, 15, 100, 1110, 954, 6804, 944, 0, 1, 1, 8, 9, 80, 650, 8322, 6524, 38960, -5112, 0, 1, 1, 6, 48, 56, 590, 4908, 70098, 45016, 253296, 47160, 0
Offset: 0
Examples
Square array A(n,k) begins: 1, 1, 1, 1, 1, 1, 1, 1, ... 1, 1, 1, 1, 1, 1, 1, 1, ... 0, 2, 4, 2, 6, 4, 2, 2, ... 0, 3, 12, 9, 27, 18, 15, 9, ... 0, 8, 52, 32, 156, 100, 80, 56, ... 0, 10, 240, 180, 1110, 650, 590, 360, ... 0, 54, 1188, 954, 8322, 4908, 5034, 2934, ... 0, -42, 6804, 6524, 70098, 41090, 47110, 26054, ...
Links
- Alois P. Heinz, Antidiagonals n = 0..140, flattened
Crossrefs
Columns k=1-17, 37 give: A019590, A005727, A215524, A179230, A215704, A215522, A215705, A179405, A215706, A215707, A215708, A215709, A215691, A215710, A215643, A215629, A179505, A211205.
Rows n=0+1, 2-10 give: A000012, A215841, A215842, A215834, A215835, A215836, A215837, A215838, A215839, A215840.
Number of distinct values taken for m x's by derivatives n=1-10: A000012, A028310, A199085, A199205, A199296, A199883, A215796, A215971, A216062, A216403.
Main diagonal gives A306739.
Programs
-
Maple
T:= proc(n) T(n):=`if`(n=1, [x], map(h-> x^h, g(n-1$2))) end: g:= proc(n, i) option remember; `if`(i=1, [x^n], [seq(seq( seq(mul(T(i)[w[t]-t+1], t=1..j)*v, v=g(n-i*j, i-1)), w= combinat[choose]([$1..nops(T(i))+j-1], j)), j=0..n/i)]) end: f:= proc() local i, l; i, l:= 0, []; proc(n) while n> nops(l) do i:= i+1; l:= [l[], T(i)[]] od; l[n] end end(): A:= (n, k)-> n!*coeff(series(subs(x=x+1, f(k)), x, n+1), x, n): seq(seq(A(n, 1+d-n), n=0..d), d=0..12);
-
Mathematica
T[n_] := If[n == 1, {x}, Map[x^#&, g[n - 1, n - 1]]]; g[n_, i_] := g[n, i] = If[i == 1, {x^n}, Flatten @ Table[ Table[ Table[ Product[T[i][[w[[t]] - t + 1]], {t, 1, j}]*v, {v, g[n - i*j, i - 1]}], {w, Subsets[ Range[ Length[T[i]] + j - 1], {j}]}], {j, 0, n/i}]]; f[n_] := Module[{i = 0, l = {}}, While[n > Length[l], i++; l = Join[l, T[i]]]; l[[n]]]; A[n_, k_] := n! * SeriesCoefficient[f[k] /. x -> x+1, {x, 0, n}]; Table[Table[A[n, 1+d-n], {n, 0, d}], {d, 0, 12}] // Flatten (* Jean-François Alcover, Nov 08 2019, after Alois P. Heinz *)
Comments