Got the weights correct here...

https://plus.google.com/101799841244447089430/posts/jnvrsmg65H6

__
#Fractal #Math #Space #Art

Really strange Julia! Not sure how to parse its points quite yet... Humm...

https://plus.google.com/101799841244447089430/posts/ctNSLzGHk4F

__
#Fractal #Julia #Hybrid #Space #Art #Math

A ring of Julias.

https://plus.google.com/101799841244447089430/posts/KFTYQtfgWD2

__
#Fractal #Math #Art #Space #Iteration

Cantor string analysis of the Weeks polynomial and the cubic Cantor Mandelbrot polynomial:
The Weeks hyperbolic 3 manifold is very hexoidal in a von Koch
D6d way. It is very tempting to treat the Cantor dimension
as close to a cantor set. Lapidus’ arguments on page 249 has his p function:
p=2*Pi/Log[b] which very much changes the solitons for {a,b} in Log[a]/Log[b] as:
{a,b}={1638.476363712549`, 71288.29106196499`}
(Mathematica)
(* Lapidus page 249*)
(* Df=Log[a]/Log[b]+f[i]I*2*p/Lop[b])
\
Clear[a, b, f]
r[i_] = x /. NSolve[x^3 - x + 1 == 0, x][[i]]
{a, b} = {Exp[x], Exp[y]} /.
Solve[{Re[r[3]] - x/y == 0, Im[r[3]] - 2*Pi/y == 0}, {x, y}][[1]]
{1638.476363712549`, 71288.29106196499`}
a
b
Log[a]
Log[b]
zD[s_] = 1/(1 - b/a^s)
FindRoot[zD[s] == 0, {s, 0.662358978622373` + 0.5622795120623012` I}]
zD[2]
ContourPlot[Abs[zD[x + I*y]], {x, -3, 4}, {y, -3.5, 3.5}, PlotPoints -> 30,
Contours -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"]
Plot3D[Abs[zD[x + I*y]], {x, -3, 4}, {y, -3.5, 3.5}, PlotPoints -> 30,
Mesh -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"]
(* end*)

Having done that calculation with the monster constants I wanted to look at the vert similar Cantor string cubic Mandelbrot:
{a,b}={551.3106629202787`, 67665.59578201662`}
The constants are again large, and the Cantor fractal zeta functions are both a line of singularities.
(* mathematica*)
(* Lapidus page 249*)
(* Df=Log[a]/Log[b]+f[i]I*2*p/Lop[b])
\
Clear[a, b, f]
r[i_] = z /.
NSolve[0.7278331862085887` - 0.6471531500354583` z + z^3 == 0, z][[i]]
z /. {{z -> -1.1350673254370094`}, {z ->
0.5675336627185047` - 0.5649161220221866` I}, {z ->
0.5675336627185047` + 0.5649161220221866` I}}[[i]]
{a, b} = {Exp[x], Exp[y]} /.
Solve[{Re[r[3]] - x/y == 0, Im[r[3]] - 2*Pi/y == 0}, {x, y}][[1]]
{551.3106629202787`, 67665.59578201662`}
a
b
Log[a]
Log[b]
Log[a]/Log[b]
a/b
zD[s_] = 1/(1 - b/a^s)
FindRoot[zD[s] == 0, {s, 0.5675336627185047` + 0.5649161220221866` I}]
zD[2]
ContourPlot[Abs[zD[x + I*y]], {x, -3, 4}, {y, -3.5, 3.5}, PlotPoints -> 30,
Contours -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"]
Plot3D[Abs[zD[x + I*y]], {x, -3, 4}, {y, -3.5, 3.5}, PlotPoints -> 30,
Mesh -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"]
(* end*)

Going back to coding some reverse hybrid Julia's of mine from scratch, to refresh the mind... ;^)

https://plus.google.com/101799841244447089430/posts/WzTTKTq1txf

__
#Fractal #Math #Art #Space #Hybrid

Re: : alpha sorted bi-state sub-Cyclotomic Molien polynomial quantum 2d levels:
Projecting all the parametrics onto :
z[i_]=1-x ( as a plane)
(* mathematica*)
Clear[f, x, α, v, g]
(http://en.wikipedia.org/wiki/Fine-structure_constant*)
α = 1/137.035999074;
( bonacci polynomials*)
f[x_, n_] = x^n - (x^n - 1)/(x - 1)
Table[f[α, n], {n, 2, 30}]
(* sub-cyclotomic polynomials*)

g[x_, n_] = x^Length[CoefficientList[Cyclotomic[n, x], x]] - Cyclotomic[n, x]

Union[Table[g[α, n], {n, 2, 30}]]
(* tri-state sorted sequence of {1-α,1,1+α}→{1,2,3}*)

v = {-0.9927558987847118`, -1.000053642804989`};
v[[2]] - v[[1]]
Table[(g[x, n] /. x -> α) - v[[2]], {n, 2, 30}]
Table[If[(g[x, n] /. x -> α) - v[[1]] <= α, {1, g[x, n]}, {2, g[x, n]}], {n,
2, 30}]

x[0] = -1 - x^2;
y[0] = -1 + 2 x - x^2 + x^3 - x^4;
z[0] = 1 - x
(* second 12*)
x[1] = -1 + x - x^2;
y[1] = -1 + 2 x - x^2 + x^3 - x^4 + x^5 - x^6;
z[1] = 1 - x
(* Third 12*)
x[2] = -1 - x^2 - x^3 - x^4;
y[2] = -1 + 2 x - x^3 + x^4 - x^5 + x^7 - x^8;
z[2] = 1 - x
(* 4th 12*)
x[3] = -1 - x^2 - x^3 - x^4 - x^5 - x^6;
y[3] = -1 - x^2 - x^3 - x^4 - x^5 - x^6;
z[3] = 1 - x
(* plotting the spectral cyclotomic strings*)
ParametricPlot3D[{Re[{x[0],
y[0], z[0]} /. x -> Exp[I*t]], Re[{x[1], y[1], z[1]} /. x -> Exp[I*t]],
Re[{x[2], y[2], z[2]} /. x -> Exp[I*t]],
Re[{x[3], y[3], z[3]} /. x -> Exp[I*t]]}, {t, -Pi, Pi}, ImageSize -> 1000,
ViewPoint -> {5, 5, 5}]
(* end*)

A Julia set with a lacy, string like border.

__
#Fractal #Math #Art #Space #Julia

#ElenaIvanovaIvEAFineArtDesign #Print #Decor #Interior #Fractal #Abstraction

Re: alpha sorted tri-state Cyclotomic Molien polynomial quantum 3d levels->Corrected:
I made a mistake/ typo in the adding of the Molien states:
(* mathematica*)
Clear[x, a, b, w, y, z]
(http://en.wikipedia.org/wiki/Fine-structure_constant*)
α = 1/137.035999074;
( tri-state sorted sequence of {1-α,1,1+α}→{1,2,3}*)

v = {0.9927026474507269`, 1, 1.0073509953748054};
Table[If[(Cyclotomic[n, x] /. x -> α) - v[[1]] <= 0.0037, {1,
Cyclotomic[n, x]},
If[(Cyclotomic[n, x] /. x -> α) - 1 <= 0.00005, {2, Cyclotomic[n, x]}, {3,
Cyclotomic[n, x]}]], {n, 2, 30}];

(* first 123 state: zero loops*)
x[0] = 1 - x + x^2;
y[0] = 1 + x^4;
z[0] = 1 + x;
(* second 123 state: one loop*)
x[1] = 1 - x + x^2 - x^3 + x^4;
y[1] = 1 + x^3 + x^6;
z[1] = 1 = 1 + x + x^2;
(* Third 123 state: two loops*)
x[2] = 1 - x + x^2 - x^3 + x^4 - x^5 + x^6;
y[2] = 1 - x^2 + x^4;
z[2] = 1 + x^2;
(* 4th 123 state: one loop*)
x[3] = 1 - x + x^3 - x^4 + x^5 - x^7 + x^8;
y[3] = 1 + x^8;
z[3] = 1 + x + x^2 + x^3 + x^4;

w = Table[FullSimplify[Together[1/x[i] + 1/y[i] + 1/z[i]]], {i, 0, 3}]

x = a + I*b
Table[ContourPlot[Abs[w[[i]]], {a, -2, 2}, {b, -2, 2}, PlotPoints -> 30,
Contours -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"], {i,
Length[w]}]
Table[Plot3D[Abs[w[[i]]], {a, -2, 2}, {b, -2, 2}, PlotPoints -> 30,
Mesh -> 30, ImageSize -> 1000, ColorFunction -> "Pastel"], {i, Length[w]}]
(* end*)