|
Guest
|
Trifurcation in a cubic Mandelbrot set simulation ( chicken feet):
http://www.mathematica-users.org/mathematica/images/4/4c/JM_cochleoid_tree.gif
The cochleoid resonance here seems unique when compared
to the quadratic Mandelbrot set Hubbard-Douady binary trees
( bifurcations).
Mathematica:
Clear[x, y, a, b, z, w, f, fa, ga, ha, f1, f2, f3, r]
RandomSeed[];
a0 = 1 + 5/9;
sd = Sqrt[7];
p0 = 4/5;
f0[r_] := p*(r^3 + (a0)*r^2 - (r/(a0) - 1))/sd + (1 - p)*(r^2 + (1 -
r - r^2 + r^3)/3)
p = 9/10 + 0.0001;
fa[w_] = N[r] /. NSolve[f0[r] - w == 0, r][[1]];
ga[w_] = N[r] /. NSolve[f0[r] - w == 0, r][[2]];
ha[w_] = N[r] /. NSolve[f0[r] - w == 0, r][[3]];
z = x + I*y;
(*Wellin IFS program type*)
f1[{x_, y_}] = N{Re[fa[z]],
Im[fa[z]]}];
f2[{x_, y_}] = N[{Re[ga[z]], Im[ga[z]]}];
f3[{x_, y_}] = N[{Re[ha[z]], Im[ha[z]]}];
f4[{x_, y_}] N[ {(2*x*y*(x^2 - y^2)/(y^2 + x^2)^2)*If[Abs[Re[1/Arg[x + I*y]]]
[quote:5a80fa8b9a]
0, Re[1/Arg[x + I*[/quote:5a80fa8b9a]
y]], 0.00001], ((2*x*y)/(y^2 + x^2))^2*If[Abs[Im[1/Arg[x + I*y]]]
[quote:5a80fa8b9a]0,
Im[1/Arg[x + I*y]], 0.00001]}/2.3];[/quote:5a80fa8b9a]
f[x_] := Which[(r = Random[]) ≤ 1/4, f1[x], r ≤ 2/4, f2[x], r ≤ 3/4, f3
[x], r \
≤ 1.00, f4[x]]
ifs[n_] := Show[Graphics[{PointSize[.001],
Map[Point, NestList[f, {0.5, 0.75}, n]]}], AspectRatio ->
Automatic, PlotRange -> All]
Table[ifs[10000], {n, 1, 20}]
Show[%] |
|
|
