Discussion:
The Devil's curves
(too old to reply)
Roger Bagula
2009-02-01 16:27:59 UTC
Permalink
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
--
Respectfully, Roger L. Bagula
11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://www.geocities.com/rlbagulatftn/Index.html
alternative email: ***@sbcglobal.net
Roger Bagula
2009-02-02 20:54:19 UTC
Permalink
This seems to be a fundamental pattern of some sort:
Loading Image...

The p partitions in this form give strange near normal looking
"patternless" results ...


%I A156054
%S A156054
1,1,1,1,1,1,1,2,2,1,1,1,2,1,1,1,2,2,2,2,1,1,2,3,2,3,2,1,1,2,3,3,3,3,2,
%T A156054 1,1,2,3,3,4,3,3,2,1,1,3,4,4,5,5,4,4,3,1,1,3,5,5,6,6,6,5,5,3,1
%N A156054 A triangle sequence: t(n,m)=2 + PartitionsQ[n] -
PartitionsQ[m] - PartitionsQ[n - m]. %C A156054 Row sums are:
%C A156054 {1, 2, 3, 6, 6, 10, 14, 18, 22, 34, 46,...}.
%C A156054 As q partitions are closely related to fermion theory, this
sequence is important.
%C A156054 This sequence gives a very pretty new fractal:
%C A156054 Clear[a, b];
%C A156054 a = Table[Table[t[n, m], {m, 0, n}], {n, 0, 64}];
%C A156054 b = Table[If[m ≤ n, Mod[a[[n]][[m]], 2], 0], {m, 1,
Length[a]}, {n, 1, Length[a]}];
%C A156054 ListDensityPlot[b, Mesh -> False, Frame -> False]
%C A156054 The statistical thermodynamics of Bosons and Fermions
%C A156054 are based on the two types of partitions
%C A156054 and each type of partition is based on products of two types
of combinations at
%C A156054 large n numbers.
%C A156054 Boson combinations are:
%C A156054 Boson(n,m)=(n+m-1)!/((n-1)!*m!)
%C A156054 Fermion combinations are:
%C A156054 Fermion(n,m)=Binomial[n,m]
%C A156054 Distribution laws:
%C A156054 boson:x=(a0+b0*x(i))=n(i)
%C A156054 f(i)=n(i)/(Exp[(a0+b0*x(i)]-1)=x/(Exp[x]-1): Bernoulli numbers
%C A156054 Fermion:x=(a0+b0*x(i));n(i)=2
%C A156054 f(i)=n(i)/(Exp[(a0+b0*x(i)]-1)=2/(Exp[x]+1): Euler numbers
%C A156054 p partitions : ( Boson like): unrestricted partition %C
A156054 Sum[p[n]*x^n,{n,0,Infinity}]=Product[1/(1-x^k),{k,1,Infinity}]
%C A156054 q partitions: ( Fermion like: 2 parts): partitions into
distinct parts %C A156054
Sum[q[n]*x^n,{n,0,Infinity}]=Product[1+x^k),{k,1,Infinity}]
%C A156054 The distributions associated are Bernouli numbers for Bosons
and ( Planck as degenerate)
%C A156054 and Euler numbers for Fermions. %F A156054 t(n,m)=2 +
PartitionsQ[n] - PartitionsQ[m] - PartitionsQ[n - m]. %e A156054 {1}, %e
A156054 {1, 1}, %e A156054 {1, 1, 1}, %e A156054 {1, 2, 2, 1}, %e
A156054 {1, 1, 2, 1, 1}, %e A156054 {1, 2, 2, 2, 2, 1},
%e A156054 {1, 2, 3, 2, 3, 2, 1}, %e A156054 {1, 2, 3, 3, 3, 3, 2, 1},
%e A156054 {1, 2, 3, 3, 4, 3, 3, 2, 1},
%e A156054 {1, 3, 4, 4, 5, 5, 4, 4, 3, 1}, %e A156054 {1, 3, 5, 5, 6, 6,
6, 5, 5, 3, 1} %t A156054 Clear[f];
%t A156054 f[n_, m_] = 2 + PartitionsQ[n] - PartitionsQ[m] -
PartitionsQ[n - m];
%t A156054 Table[Table[f[n, m], {m, 0, n}], {n, 0, 10}];
%t A156054 Flatten[%] %K A156054 nonn,tabl
%O A156054 0,8
%A A156054 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Feb 02 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
Loading...