A138061 This sequence is a triangular sequence formed by the substitution: ( French sideways graph) 1->1,2;2->3;3->4;4->1; as a Markov style substitution form. The result is the differential polynomial coefficient form. ( first zero omitted).

2, 2, 6, 2, 6, 12, 2, 6, 12, 4, 2, 6, 12, 4, 5, 12, 2, 6, 12, 4, 5, 12, 7, 16, 27, 2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 14, 30, 48, 68, 18, 2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 14, 30, 48, 68, 18, 19, 40, 63, 88, 23, 24

Offset: 1

Author

Roger L. Bagula, May 02 2008

Keywords

• nonn
• uned
• tabf

Comments

Row sums are:

{0, 2, 8, 20, 24, 41, 91, 211, 389, 696, 1307}

This uses the French sideways graph method as in:

A103684:the morphism f: 1->{1,2}, 2->{1,3}, 3->{3}.

These sequences in the polynomial form were created to see what the

fractal implicit pictures would look like and not for the sequences:

Clear[a, s, p, t, m, n, t, p, k]

(* substitution *)

s[1] = {1, 2}; s[2] = {3}; s[3] = {4}; s[4] = {1};

t[a_] := Flatten[s /(AT) a];

p[0] = {1}; p[1] = t[p[0]];

p[n_] := t[p[n - 1]];

a = Table[p[n], {n, 0, 12}];

k = Table[D[Apply[Plus, Table[

a[[n]][[m]]*x^(m - 1), {m, 1, Length[a[[n]]]}]], x], {n, 3, 13}];

Clear[x, y, a, b, f, z, p];

nr = k /. x -> z;

p[z_] = Apply[Times, nr];

z = x + I*y;

f[x_, y_] = Re[1/(p[z])];

ContourPlot[ f[x, y], {x, -1.61,1.61}, {y, -1.61, 1.61}, PlotPoints -> {300, 300}, ImageSize ->600, ColorFunction -> (Hue[2# ] &)]

Examples

			First zero omitted:
{2},
{2, 6},
{2, 6, 12},
{2, 6, 12, 4},
{2, 6, 12, 4, 5, 12},
{2, 6, 12, 4, 5, 12, 7, 16, 27},
{2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52},
{2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 14, 30, 48, 68, 18},
{2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 14, 30, 48, 68, 18, 19, 40, 63, 88, 23, 24, 50},
{2, 6, 12, 4, 5, 12, 7, 16, 27, 10, 22, 36, 52, 14, 30, 48, 68, 18, 19, 40, 63, 88, 23, 24, 50, 26, 54, 84, 116, 30, 31, 64, 33, 68, 105}
		

Crossrefs

Cf. A103684.

Programs

Mathematica

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

( French sideways graph) 1->1,2;2->3;3->4;4->1; Substitution->p(x,n); out_n,m=Coefficients(dp(x,n)/dx).