A138056 Levels of substitution A103684 (based on the morphism f: 1->{1,2}, 2->{1,3}, 3->{3}) like Markov substitution taken as polynomials p(x,n)]and coefficients of the differential polynomials returned as q(x,n) =dp(x,n)dx coefficients (first zero omitted).

2, 2, 2, 9, 2, 2, 9, 4, 10, 6, 2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24, 2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24, 13, 28, 15, 48, 17, 36, 19, 20, 42, 22, 69, 2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24, 13, 28, 15, 48, 17, 36, 19, 20, 42, 22, 69, 24, 50, 26, 81, 28, 58, 30, 31, 64, 33, 102, 35

Offset: 1

Author

Roger L. Bagula, May 02 2008

Keywords

• nonn
• uned
• less
• tabf

Examples

			{2},
{2, 2, 9},
{2, 2, 9, 4, 10, 6},
{2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24},
{2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24, 13, 28, 15, 48, 17, 36, 19, 20, 42, 22, 69},
{2, 2, 9, 4, 10, 6, 7, 16, 9, 30, 11, 24, 13, 28, 15, 48, 17, 36, 19, 20, 42, 22, 69, 24, 50, 26, 81, 28, 58, 30, 31, 64, 33, 102, 35, 72, 37, 76, 39, 120, 41, 84, 43}
		

Crossrefs

Cf. A103684.

Programs

Mathematica

s[1] = {1, 2}; s[2] = {1, 3}; s[3] = {1};
t[a_] := Flatten[s /@ a];
p[0] = {1}; p[1] = t[p[0]]; p[n_] := t[p[n - 1]];
(*A103684*);
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}];