|
|
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).
|
|
0
|
|
|
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
(list;
graph;
refs;
listen;
history;
text;
internal format)
|
|
|
OFFSET
|
1,1
|
|
COMMENTS
|
Row sums are (with zeros) {0, 0, 0, 8, 23, 81, 305, 1027, 3514, 12002, 40658, ...}.
This sequence is as a result of my Pc Mandelbrot-Julia work.
I noticed that these substitution levels increased like iteration polynomials, so I converted the substitution levels to polynomials.
To get a good implicit plot I have been using the inverse of the differential in polynomials as a product.
So I used that kind of procedure to get the differentiation of a substitution.
|
|
LINKS
|
|
|
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).
|
|
EXAMPLE
|
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},
|
|
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}];
|
|
CROSSREFS
|
|
|
KEYWORD
|
nonn,uned,tabf
|
|
AUTHOR
|
|
|
STATUS
|
approved
|
|
|
|