|
Guest
|
I've been using polynomial based IFS Julias for years
but never thought to try higher polynomial
with known complex roots like this theta Pisot
polynomial:
Mathematica:
Clear[x, y, a, b, z, w, f, fa, ga, ha, ka, f1, f2, f3, r, ft, ff, r,
r0]
NSolve[r^4 - r^3 - 1 == 0, r]
f0[r_] := r^4 - r^3 - 1
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]];
ka[w_] = N[r] /. NSolve[f0[r] - w == 0, r][[4]];
r0 = 1.3802775690976141
z = x + I*y;
(*Wellin IFS program type*)
f1[{x_, y_}] = {Re[fa[z]], Im[fa[z]]}*r0;
f2[{x_, y_}] = {Re[ga[z]], Im[ga[z]]}*r0;
f3[{x_, y_}] = {Re[ha[z]], Im[ha[z]]}*r0;
f4[{x_, y_}] = {Re[ka[z]], Im[ka[z]]}*r0;
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.000001, 0}, n]]}], AspectRatio -> Automatic]
ifs[50000]
http://www.flickr.com/photos/fractalmusic/3934279297/
Respectfully, Roger L. Bagula
11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://
www.geocities.com/rlbagulatftn/Index.html
alternative email: rlbagula at (no spam) sbcglobal.net |
|
|
