A155835 A polynomial coefficient triangle based on projection modulo two of a Cantor dust with scale removed: p(x,n)=If[Mod[n, 2] == 0, (x + 2)*p(x, n - 1) + n, (x)*p(x, n - 1) + n + 2]; q(x,n)=p(x,n)+x^n*p(1/x,n); t(n,m)=coefficients(q(x,n))

4, 3, 3, 7, 8, 7, 6, 10, 10, 6, 15, 23, 28, 23, 15, 8, 20, 31, 31, 20, 8, 21, 43, 74, 90, 74, 43, 21, 10, 28, 61, 93, 93, 61, 28, 10, 27, 59, 132, 228, 276, 228, 132, 59, 27, 12, 36, 91, 187, 269, 269, 187, 91, 36, 12, 33, 75, 186, 410, 684, 814, 684, 410, 186, 75, 33

Offset

0,1

Comments

Row sums are:

{4, 6, 22, 32, 104, 118, 366, 384, 1168, 1190, 3590,...}

IFS transform one: x(n)=x(n-1)/3;

y(n)=y(n-1)/3+2/3;

IFS transform one: x(n)=x(n-1)/3+2/3;

y(n)=y(n-1)/3;

with projection as with scale 3 removed:

x(n)->x and y(n)->n.

Fractal picture in Mathematica:

Clear[a]; a = Table[CoefficientList[ExpandAll[p[x, n]], x] +

Reverse[CoefficientList[ExpandAll[p[x, n]], x]], {n, 0, 32}]; b0 = Table[If[ m <= n, 3 - Mod[a[[n]][[m]], 3], 0], {m, 1, Length[a]}, {n, 1, Length[a]}];

ListDensityPlot[b0, Mesh -> False, Frame -> False, AspectRatio -> Automatic, ColorFunction -> Hue]

gr = ListPlot3D[b0, Mesh -> False, AspectRatio -> Automatic, Boxed -> False, Axes -> False, ViewPoint -> {-2.319, 1.420, 2.014}]

References

G. A. Edgar, Measure, Topology and Fractal Geometry, Springer-Verlag, New York, 1990, page 64,83.

Links

Table of n, a(n) for n=0..65.

Formula

p(x,n)=If[Mod[n, 2] == 0, (x + 2)*p(x, n - 1) + n, (x)*p(x, n - 1) + n + 2]; q(x,n)=p(x,n)+x^n*p(1/x,n);

t(n,m)=coefficients(q(x,n))

Example

{4},
{3, 3},
{7, 8, 7},
{6, 10, 10, 6},
{15, 23, 28, 23, 15},
{8, 20, 31, 31, 20, 8},
{21, 43, 74, 90, 74, 43, 21},
{10, 28, 61, 93, 93, 61, 28, 10},
{27, 59, 132, 228, 276, 228, 132, 59, 27},
{12, 36, 91, 187, 269, 269, 187, 91, 36, 12},
{33, 75, 186, 410, 684, 814, 684, 410, 186, 75, 33}

Mathematica

Clear[p, n, m, x, a];
p[x, 0] = 2; p[x, 1] = x + 2;
p[x_, n_] := p[x, n] = If[Mod[n, 2] == 0, (x + 2)*p[x, n - 1] + n, (x)*p[x, n - 1] + n + 2] Table[ExpandAll[p[x, n]], {n, 0, 10}];
a = Table[CoefficientList[ExpandAll[p[x, n]], x] + Reverse[CoefficientList[ExpandAll[p[x, n]], x]], {n, 0, 10}]
Flatten[a]

Crossrefs

Sequence in context: A237197 A006994 A038627 * A138187 A105342 A323601

Adjacent sequences: A155832 A155833 A155834 * A155836 A155837 A155838

Keyword

nonn,tabl

Author

Roger L. Bagula and Gary W. Adamson, Jan 28 2009

Status

approved