|
| |
|
|
A155688
|
|
A symmetrical triangle of polynomial coefficients that are von Koch like: b=1/4; p(x, n) = If[Mod[n, 4] == 2, (b*x - n/2)*p(x, n - 1), If[ Mod[n, 4] == 3, (x/2 - b*n + 1/2)*p(x, n - 1), If[ Mod[n, 4] == 0, (-b*x - n/2 + b)*p(x, n - 1), (x/2 + b*n)*p(x, n - 1)]]]; q(x,n)=(p(x,n)+x^n*(p(1/x,n))/b^n.
|
|
0
| |
|
|
2, 3, 3, -2, -14, -2, 8, -17, -17, 8, -32, -9, 226, -9, -32, -148, -85, 737, 737, -85, -148, 1672, 404, -6199, -2842, -6199, 404, 1672, -8416, 1744, 36297, -12993, -12993, 36297, 1744, -8416, 126016, -15504, -532423, 54438, 202722, 54438
(list; table; graph; refs; listen; history; internal format)
|
|
|
|
OFFSET
| 0,1
|
|
|
COMMENTS
| Row sums are:
{2, 6, -18, -18, 144, 1008, -11088, 33264, -532224, -5854464, 111234816,...}. Using the IFS definition of Hans Lauweier, I made a polynomial product set with Substirutions:
x->x and y->n.
The fractal modulo four is:
a = Table[Expand[(1/ b^n)*CoefficientList[ExpandAll[p[x, n]], x] + Reverse[(1/b^n)* CoefficientList[ExpandAll[p[x, n]], x]]], {n, 0, 128}];
b0 = Table[If[m <= n, Mod[ a[[n]][[m]], 4], 0], {m, 1, Length[a]}, {n, 1, Length[a]}];
ListDensityPlot[b0, Mesh -> False, Frame -> False, AspectRatio -> Automatic, ColorFunction -> Hue]
|
|
|
REFERENCES
| Hans Lauweier, Fractals,Endlessly Repeated Geometrical Figures,Princeton University Press, Ne Jersey,1991,pages 98-99
|
|
|
FORMULA
| b=1/4;
p(x, n) = If[Mod[n, 4] == 2, (b*x - n/2)*p(x, n - 1),
If[ Mod[n, 4] == 3, (x/2 - b*n + 1/2)*p(x, n - 1),
If[ Mod[n, 4] == 0, (-b*x - n/2 + b)*p(x, n - 1),
(x/2 + b*n)*p(x, n - 1)]]];
q(x,n)=(p(x,n)+x^n*(p(1/x,n))/b^n.
|
|
|
EXAMPLE
| {2},
{3, 3},
{-2, -14, -2},
{8, -17, -17, 8},
{-32, -9, 226, -9, -32},
{-148, -85, 737, 737, -85, -148},
{1672, 404, -6199, -2842, -6199, 404, 1672},
{-8416, 1744, 36297, -12993, -12993, 36297, 1744, -8416},
{126016, -15504, -532423, 54438, 202722, 54438, -532423, -15504, 126016},
{1134032, 111936, -4799127, -523664, 1149591, 1149591, -523664, -4799127, 111936, 1134032},
{-22679968, -1098304, 95967468, 4727137, -20196266, -2205318, -20196266, 4727137, 95967468, -1098304, -22679968}
|
|
|
MATHEMATICA
| Clear[p, x, n, b, a, b0]; b = 1/4;
p[x, 0] = 1; p[x, 1] = x/2 + b; p[x_, n_] := p[x, n] = If[Mod[n, 4] == 2, (b*x - n/2)*p[x, n - 1],
If[Mod[n, 4] == 3, (x/2 - b*n + 1/2)*p[x, n - 1],
If[Mod[n, 4] == 0, (-b*x - n/2 + b)*p[x, n - 1], (x/2 + b*n)*p[x, n - 1]]]];
Table[Expand[(1/b^n)*CoefficientList[ ExpandAll[p[x, n]], x] + Reverse[(1/b^n)*CoefficientList[ExpandAll[ p[x, n]], x]]], {n, 0, 10}];
Flatten[%]
|
|
|
CROSSREFS
| Sequence in context: A153479 A153489 A153310 * A153592 A153878 A118925
Adjacent sequences: A155685 A155686 A155687 * A155689 A155690 A155691
|
|
|
KEYWORD
| sign,tabl,uned
|
|
|
AUTHOR
| Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Jan 24 2009
|
| |
|
|
