A155835 - OEIS

%I #4 Jan 09 2024 12:25:25

%S 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,

%T 43,21,10,28,61,93,93,61,28,10,27,59,132,228,276,228,132,59,27,12,36,

%U 91,187,269,269,187,91,36,12,33,75,186,410,684,814,684,410,186,75,33

%N 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))

%C Row sums are:

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

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

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

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

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

%C with projection as with scale 3 removed:

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

%C Fractal picture in Mathematica:

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

%C 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]}];

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

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

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

%F 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);

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

%e {4},

%e {3, 3},

%e {7, 8, 7},

%e {6, 10, 10, 6},

%e {15, 23, 28, 23, 15},

%e {8, 20, 31, 31, 20, 8},

%e {21, 43, 74, 90, 74, 43, 21},

%e {10, 28, 61, 93, 93, 61, 28, 10},

%e {27, 59, 132, 228, 276, 228, 132, 59, 27},

%e {12, 36, 91, 187, 269, 269, 187, 91, 36, 12},

%e {33, 75, 186, 410, 684, 814, 684, 410, 186, 75, 33}

%t Clear[p, n, m, x, a];

%t p[x, 0] = 2; p[x, 1] = x + 2;

%t 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}];

%t a = Table[CoefficientList[ExpandAll[p[x, n]], x] + Reverse[CoefficientList[ExpandAll[p[x, n]], x]], {n, 0, 10}]

%t Flatten[a]

%K nonn,tabl

%O 0,1

%A _Roger L. Bagula_ and _Gary W. Adamson_, Jan 28 2009