A138054 Levels of substitution A059832 taken as polynomials p(x,n)]and coefficients of the differential polynomials returned as q(x,n) = dp(x,n)dx coefficients (first three zeros omitted).
2, 6, 3, 2, 6, 12, 1, 4, 9, 8, 15, 6, 14, 24, 2, 6, 6, 12, 5, 12, 21, 24, 9, 20, 33, 24, 39, 14, 30, 48, 3, 2, 6, 12, 15, 6, 14, 24, 18, 30, 11, 24, 39, 14, 30, 48, 34, 54, 19, 40, 63, 66, 23, 48, 75, 52, 81, 28, 58, 90, 1, 4, 9, 8, 15, 6, 14, 24, 9, 20, 33, 24, 39, 14, 30, 48, 51, 18
Offset: 1
Examples
Three zeros then:
{2, 6},
{3, 2, 6, 12},
{1, 4, 9, 8, 15, 6, 14, 24},
{2, 6, 6, 12, 5, 12, 21, 24, 9, 20, 33, 24, 39, 14, 30, 48},
Programs
-
Mathematica
Clear[a, s, p, t, m, n] (* substitution *) s[1] = {2}; s[2] = {3}; s[3] = {1, 2, 3}; t[a_] := Flatten[s /@ a]; p[0] = {1}; p[1] = t[p[0]]; p[n_] := t[p[n - 1]]; (*A059832*) a = Table[p[n], {n, 0, 10}]; Flatten[a]; b = Table[CoefficientList[D[Apply[Plus, Table[a[[n]][[m]]*x^( m - 1), {m, 1, Length[a[[n]]]}]], x], x], {n, 1, 11}]; Flatten[b] Table[Apply[Plus, CoefficientList[D[Apply[Plus, Table[a[[n]][[m]]* x^(m - 1), {m, 1, Length[a[[n]]]}]], x], x]], {n, 1, 11}];
Formula
p(x,n)=Sum[A059832[n,m]*t(m-1),{m,1,n}]; q(x,n)=dp(x,n)dx; out_n,m=Coefficients(q(x,n).
Comments