Roger Bagula
2009-02-01 16:27:59 UTC
Pictures:
Loading Image...
Loading Image...
I call them the Devil's curves after tthe Devils's staircase.
The idea that the Pascal's ( Sierpinski gasket) triangles:
(x+1)^n
and
(1-x)^n
are fractal isn't new. Combinations as in Binomial[n,m]
are always subsets of n!.
The set of polynomial given by ChebyshevT and ChebyshevU
are Hilbert space levels that are topolgically covering for two space.
( they are A_n or SU(n+1) like in group theory terms).
I noticed last night that the polynomial :
p(x,n)=(x+1)^n+(1-x)^n
and
q(x,n)=(x+1)^n-(1-x)^n
behave very much like cosine and sine in being even and odd.
tc[n_, m_] = Binomial[n, m] + (-1)^m*Binomial[n, m]
ts[n_, m_] = Binomial[n, m] - (-1)^m*Binomial[n, m]
What if we subtracted the fractal Pascal triangle curves from the
Hilbert space
Chebyshev curves?
The result should be a set of Cantor dust like curves.
To make them better, make them symmetrical by adding the toral or reverse
curves to them.
p[x_, n_] = -(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n))
q[x_, n_] = -(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n))
sp[x_, n_] = p[x, n] + x^n*p[1/x, n]
sq[x_, n_] = q[x, n] + x^n*q[1/x, n]
The do show a cusp like behavior when plottted against each other:
a = Table[ParametricPlot[{sp[x, n], -sq[x, n]}, {x, -1, 1}], {n, 2, 12}]
Show[a, PlotRange -> All]
The fractals seem to be dust like ( disconnected):
Clear[a]
a = Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x], {n, 2,
32}];
b = Table[If[m ≤ n, Mod[a[[n]][[m]], 3], 0], {m, 1, Length[
a]}, {n, 1, Length[a]}];
ListDensityPlot[b, Mesh -> False]
The fractals:
Clear[a]
a = Table[CoefficientList[FullSimplify[ExpandAll[sq[x, n]]], x], {n, 2,
32}];
b = Table[If[m ≤ n, Mod[a[[n]][[m]], 3], 0], {m, 1, Length[
a]}, {n, 1, Length[a]}];
ListDensityPlot[b, Mesh -> False]
%I A155994
%S A155994 2,3,8,3,6,10,10,6,17,16,24,16,17,30,4,52,52,4,30,63,24,56,80,
%T A155994 56,24,63,126,22,234,10,10,234,22,126,257,32,488,224,480,224,488,
%U A155994 32,257,510,8,1096,328,420,420,328,1096,8,510,1023,40,2244,480
%V A155994
-2,-3,8,-3,-6,10,10,-6,-17,16,24,16,-17,-30,4,52,52,4,-30,-63,24,56,80,
%W A155994
56,24,-63,-126,22,234,-10,-10,234,22,-126,-257,32,488,224,-480,224,488,
%X A155994
32,-257,-510,8,1096,328,-420,-420,328,1096,8,-510,-1023,40,2244,480
%N A155994 A triangle of polynomial coefficients: p(x,n)=-(ChebyshevU[n,
x] - ((x + 1)^n - (1 - x)^n)); sp(x,n) = p(x, n) + x^n*p(1/x, n).
%C A155994 Row sums are:
%C A155994 {-2, 0, 2, 8, 22, 52, 114, 240, 494, 1004, 2026,...}.
%F A155994 p(x,n)=-(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n));
%F A155994 sp(x,n) = p(x, n) + x^n*p(1/x, n).
%e A155994 {-2},
%e A155994 {},
%e A155994 {-3, 8, -3},
%e A155994 {-6, 10, 10, -6},
%e A155994 {-17, 16, 24, 16, -17},
%e A155994 {-30, 4, 52, 52, 4, -30},
%e A155994 {-63, 24, 56, 80, 56, 24, -63},
%e A155994 {-126, 22, 234, -10, -10, 234, 22, -126},
%e A155994 {-257, 32, 488, 224, -480, 224, 488, 32, -257},
%e A155994 {-510, 8, 1096, 328, -420, -420, 328, 1096, 8, -510},
%e A155994 {-1023, 40, 2244, 480, -1232, 1008, -1232, 480, 2244, 40, -1023}
%t A155994 p[x_, n_] =-(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n));
%t A155994 sp[x_, n_] = p[x, n] + x^n*p[1/x, n];
%t A155994 Table[FullSimplify[ExpandAll[sp[x, n]]], {n, 0, 10}];
%t A155994 Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x],
{n, 0, 10}]; Q Flatten[%]
%K A155994 sign,tabl
%O A155994 0,1
%A A155994 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Feb 01 2009
%I A155993
%S A155993 2,1,1,3,0,3,2,9,9,2,5,0,40,0,5,14,5,40,40,5,14,27,0,90,0,90,0,
%T A155993 27,62,21,154,14,14,154,21,62,125,0,400,0,40,0,400,0,125,254,9,
%U A155993 648,288,180,180,288,648,9,254,507,0,1410,0,120,0,120,0,1410,0,507
%V A155993 2,1,1,3,0,3,-2,9,9,-2,-5,0,40,0,-5,-14,5,40,40,5,-14,-27,0,90,0,90,0,
%W A155993 -27,-62,21,154,14,14,154,21,-62,-125,0,400,0,-40,0,400,0,-125,-254,9,
%X A155993 648,288,-180,-180,288,648,9,-254,-507,0,1410,0,120,0,120,0,1410,0,-507
%N A155993 A triangle of polynomial coefficients: p(x,n)=-(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n)); sp(x,n) = p(x, n) + x^n*p(1/x, n).
%C A155993 Row sums are:
%C A155993 {2, 2, 6, 14, 30, 62, 126, 254, 510, 1022, 2046,...}.
%F A155993 p(x,n)=-(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n));
%F A155993 sp(x,n) = p(x, n) + x^n*p(1/x, n).
%e A155993 {2},
%e A155993 {1, 1},
%e A155993 {3, 0, 3},
%e A155993 {-2, 9, 9, -2},
%e A155993 {-5, 0, 40, 0, -5},
%e A155993 {-14, 5, 40, 40, 5, -14},
%e A155993 {-27, 0, 90, 0, 90, 0, -27},
%e A155993 {-62, 21, 154, 14, 14, 154, 21, -62},
%e A155993 {-125, 0, 400, 0, -40, 0, 400, 0, -125},
%e A155993 {-254, 9, 648, 288, -180, -180, 288, 648, 9, -254},
%e A155993 {-507, 0, 1410, 0, 120, 0, 120, 0, 1410, 0, -507}
%t A155993 p[x_, n_] = -(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n));
%t A155993 sp[x_, n_] = p[x, n] + x^n*p[1/x, n];
%t A155993 Table[FullSimplify[ExpandAll[sp[x, n]]], {n, 0, 10}];
%t A155993 Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x], {n, 0, 10}]; Q Flatten[%]
%K A155993 sign,tabl
%O A155993 0,1
%A A155993 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Feb 01 2009
Loading Image...
Loading Image...
I call them the Devil's curves after tthe Devils's staircase.
The idea that the Pascal's ( Sierpinski gasket) triangles:
(x+1)^n
and
(1-x)^n
are fractal isn't new. Combinations as in Binomial[n,m]
are always subsets of n!.
The set of polynomial given by ChebyshevT and ChebyshevU
are Hilbert space levels that are topolgically covering for two space.
( they are A_n or SU(n+1) like in group theory terms).
I noticed last night that the polynomial :
p(x,n)=(x+1)^n+(1-x)^n
and
q(x,n)=(x+1)^n-(1-x)^n
behave very much like cosine and sine in being even and odd.
tc[n_, m_] = Binomial[n, m] + (-1)^m*Binomial[n, m]
ts[n_, m_] = Binomial[n, m] - (-1)^m*Binomial[n, m]
What if we subtracted the fractal Pascal triangle curves from the
Hilbert space
Chebyshev curves?
The result should be a set of Cantor dust like curves.
To make them better, make them symmetrical by adding the toral or reverse
curves to them.
p[x_, n_] = -(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n))
q[x_, n_] = -(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n))
sp[x_, n_] = p[x, n] + x^n*p[1/x, n]
sq[x_, n_] = q[x, n] + x^n*q[1/x, n]
The do show a cusp like behavior when plottted against each other:
a = Table[ParametricPlot[{sp[x, n], -sq[x, n]}, {x, -1, 1}], {n, 2, 12}]
Show[a, PlotRange -> All]
The fractals seem to be dust like ( disconnected):
Clear[a]
a = Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x], {n, 2,
32}];
b = Table[If[m ≤ n, Mod[a[[n]][[m]], 3], 0], {m, 1, Length[
a]}, {n, 1, Length[a]}];
ListDensityPlot[b, Mesh -> False]
The fractals:
Clear[a]
a = Table[CoefficientList[FullSimplify[ExpandAll[sq[x, n]]], x], {n, 2,
32}];
b = Table[If[m ≤ n, Mod[a[[n]][[m]], 3], 0], {m, 1, Length[
a]}, {n, 1, Length[a]}];
ListDensityPlot[b, Mesh -> False]
%I A155994
%S A155994 2,3,8,3,6,10,10,6,17,16,24,16,17,30,4,52,52,4,30,63,24,56,80,
%T A155994 56,24,63,126,22,234,10,10,234,22,126,257,32,488,224,480,224,488,
%U A155994 32,257,510,8,1096,328,420,420,328,1096,8,510,1023,40,2244,480
%V A155994
-2,-3,8,-3,-6,10,10,-6,-17,16,24,16,-17,-30,4,52,52,4,-30,-63,24,56,80,
%W A155994
56,24,-63,-126,22,234,-10,-10,234,22,-126,-257,32,488,224,-480,224,488,
%X A155994
32,-257,-510,8,1096,328,-420,-420,328,1096,8,-510,-1023,40,2244,480
%N A155994 A triangle of polynomial coefficients: p(x,n)=-(ChebyshevU[n,
x] - ((x + 1)^n - (1 - x)^n)); sp(x,n) = p(x, n) + x^n*p(1/x, n).
%C A155994 Row sums are:
%C A155994 {-2, 0, 2, 8, 22, 52, 114, 240, 494, 1004, 2026,...}.
%F A155994 p(x,n)=-(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n));
%F A155994 sp(x,n) = p(x, n) + x^n*p(1/x, n).
%e A155994 {-2},
%e A155994 {},
%e A155994 {-3, 8, -3},
%e A155994 {-6, 10, 10, -6},
%e A155994 {-17, 16, 24, 16, -17},
%e A155994 {-30, 4, 52, 52, 4, -30},
%e A155994 {-63, 24, 56, 80, 56, 24, -63},
%e A155994 {-126, 22, 234, -10, -10, 234, 22, -126},
%e A155994 {-257, 32, 488, 224, -480, 224, 488, 32, -257},
%e A155994 {-510, 8, 1096, 328, -420, -420, 328, 1096, 8, -510},
%e A155994 {-1023, 40, 2244, 480, -1232, 1008, -1232, 480, 2244, 40, -1023}
%t A155994 p[x_, n_] =-(ChebyshevU[n, x] - ((x + 1)^n - (1 - x)^n));
%t A155994 sp[x_, n_] = p[x, n] + x^n*p[1/x, n];
%t A155994 Table[FullSimplify[ExpandAll[sp[x, n]]], {n, 0, 10}];
%t A155994 Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x],
{n, 0, 10}]; Q Flatten[%]
%K A155994 sign,tabl
%O A155994 0,1
%A A155994 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Feb 01 2009
%I A155993
%S A155993 2,1,1,3,0,3,2,9,9,2,5,0,40,0,5,14,5,40,40,5,14,27,0,90,0,90,0,
%T A155993 27,62,21,154,14,14,154,21,62,125,0,400,0,40,0,400,0,125,254,9,
%U A155993 648,288,180,180,288,648,9,254,507,0,1410,0,120,0,120,0,1410,0,507
%V A155993 2,1,1,3,0,3,-2,9,9,-2,-5,0,40,0,-5,-14,5,40,40,5,-14,-27,0,90,0,90,0,
%W A155993 -27,-62,21,154,14,14,154,21,-62,-125,0,400,0,-40,0,400,0,-125,-254,9,
%X A155993 648,288,-180,-180,288,648,9,-254,-507,0,1410,0,120,0,120,0,1410,0,-507
%N A155993 A triangle of polynomial coefficients: p(x,n)=-(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n)); sp(x,n) = p(x, n) + x^n*p(1/x, n).
%C A155993 Row sums are:
%C A155993 {2, 2, 6, 14, 30, 62, 126, 254, 510, 1022, 2046,...}.
%F A155993 p(x,n)=-(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n));
%F A155993 sp(x,n) = p(x, n) + x^n*p(1/x, n).
%e A155993 {2},
%e A155993 {1, 1},
%e A155993 {3, 0, 3},
%e A155993 {-2, 9, 9, -2},
%e A155993 {-5, 0, 40, 0, -5},
%e A155993 {-14, 5, 40, 40, 5, -14},
%e A155993 {-27, 0, 90, 0, 90, 0, -27},
%e A155993 {-62, 21, 154, 14, 14, 154, 21, -62},
%e A155993 {-125, 0, 400, 0, -40, 0, 400, 0, -125},
%e A155993 {-254, 9, 648, 288, -180, -180, 288, 648, 9, -254},
%e A155993 {-507, 0, 1410, 0, 120, 0, 120, 0, 1410, 0, -507}
%t A155993 p[x_, n_] = -(ChebyshevT[n, x] - ((x + 1)^n + (1 - x)^n));
%t A155993 sp[x_, n_] = p[x, n] + x^n*p[1/x, n];
%t A155993 Table[FullSimplify[ExpandAll[sp[x, n]]], {n, 0, 10}];
%t A155993 Table[CoefficientList[FullSimplify[ExpandAll[sp[x, n]]], x], {n, 0, 10}]; Q Flatten[%]
%K A155993 sign,tabl
%O A155993 0,1
%A A155993 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Feb 01 2009
--
Respectfully, Roger L. Bagula
11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://www.geocities.com/rlbagulatftn/Index.html
alternative email: ***@sbcglobal.net
Respectfully, Roger L. Bagula
11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://www.geocities.com/rlbagulatftn/Index.html
alternative email: ***@sbcglobal.net