 |
|
| Science Forum Index » Fractals Science Forum » Eye of Ra :ellipse_self_similar... |
|
Page 1 of 1 |
|
| Author |
Message |
| Roger Bagula... |
 Posted: Tue Jun 30, 2009 4:14 pm |
|
|
|
Guest
|
http://www.geocities.com/rlbagulatftn/ellipse_self_similar.jpg
I orginially did this in the 60's inspired by the CBS logo of a eye.
This is the first time I figured out a mathematical form for a
self-similar ellipse of thios sort:
The figure alternates ellipses and inscribed ellises.
It also tiles a disk in an hyperbolic reduction scaling of scale of
powers of two.
I really doubt this is a new fractal, but it is pretty anyway.
I call it the "Eye of Ra" as
reading about Akhenaten made me think of it.
Mathematica:
Clear[x, y, i, t, g]
x[i_, t_] = If[Mod[i, 2] == 0, Cos[t]/2^(i - 1), Cos[t]/2^i]
y[i_, t_] = If[Mod[i, 2] == 0, Sin[t]/2^(i + 1), Sin[t]/2^i]
g = Table[ParametricPlot[{x[i, t], y[i, t]}, {t, -
Pi, Pi}, Axes -> False], {i, 0, 10}]
Show[g, PlotRange -> All]
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 |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Wed Jul 01, 2009 12:44 pm |
|
|
|
Guest
|
Look at:
http://local.wasp.uwa.edu.au/~pbourke/fractals/trianguloid/
which uses triangular ellipses made by an IFS.
It is a triangular shape tiling of a triangular disk too.
SET MODE "color"
SET WINDOW 0,1920,0,1024
SET BACKGROUND COLOR "white"
LET x=.5
LET y=.75
LET a=0
LET b =0
LET s1=850
LET s2 =s1*1024/1920
RANDOMIZE
PRINT"trianguliod FRACTION I.F.S. "
PRINT"BY R.L.BAGULA 14 feb 2002 "
FOR n= 1 TO 3000000
LET a =RND
LET b=RND
IF a <= 1/3 THEN
LET x1= 2*X*Y/(X^2+Y^2)
LET y1=(Y^2-X^2)/(Y^2+X^2)
END IF
IF a<=2/3 AND a>1/3 THEN
LET x1=2/(X+2)-1
LET y1=2/(Y+2)-1
END IF
IF a<= 1 AND a>2/3 THEN
LET x1=(X^2-Y^2)/(X^2+Y^2)
LET y1=2*X*Y/(Y^2+X^2)
END IF
SET COLOR 255
LET x=x1
LET y=y1
IF n>10 THEN PLOT 1920/2+s1*x,1024/2+s2*y
NEXT n
END |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Thu Jul 02, 2009 3:31 pm |
|
|
|
Guest
|
A cantor staircase standing wave fractal:
http://www.flickr.com/photos/fractalmusic/3682265002/
Mathematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
(* phase locking Cantor staircase function : http : // \
mathworld.wolfram.com/DevilsStaircase.html*)
f0[{omega_, t_}] := {omega, t + omega - Sin[2Pi t]/(2Pi)};
WindingNumber[n_, {omega_, t_}] := (Nest[f0, {omega, t}, n][[2]] - t)/n;
dlst = Table[ Random[Integer, {1, 3}], {n, 100000}];
f[1, {x_, y_}] := N[ {2*x*y/(x2 + y2) , (y2 - x2)/(y2 + x2)}];
f[2, {x_, y_}] := N[ {WindingNumber[2, {y, x}], WindingNumber[2, {x, y}]}];
f[3, {x_, y_}] := N[ {-(y2 - x2)/(y2 + x2), 2*x*y/(x2 + y2) }];
pt = {0.5, 0.75};
cr[n_] := If[n - 1 == 0, RGBColor[0, 0, 1], If[n - 2 == 0,
RGBColor[0, 1, 0], If[n - 3 == 0, RGBColor[1, 0, 0], RGBColor[0,
0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio -> Automatic, \
PlotRange -> All] |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Fri Jul 03, 2009 10:52 am |
|
|
|
Guest
|
http://www.flickr.com/photos/fractalmusic/3684969722/
A third elliptical fractal tiling type:
the ellipse kisses the previous scale and is rotated slightly.
Mathematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
f0[{omega_, t_}] := {omega, t + omega - Sin[2Pi t]/(2Pi)};
WindingNumber[n_, {omega_, t_}] := (Nest[f0, {omega, t}, n][[2]] - t)/n;
dlst = Table[ Random[Integer, {1, 3}], {n, 100000}];
f[1, {x_, y_}] := N[ {2*x*y/(x2 + y2) , (y2 - x2)/(y2 + x2)}];
f[2, {x_, y_}] := N[ {(2*x - y)/(2.83), (2*x + y)/(2.83)}];
f[3, {x_, y_}] := N[ {-(y2 - x2)/(y2 + x2), 2*x*y/(x2 + y2) }];
pt = {0.5, 0.75};
cr[n_] :=
If[n - 1 == 0,
RGBColor[0, 0, 1], If[n - 2 == 0, RGBColor[0, 1, 0], If[
n - 3 == 0, RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio -> Automatic,
PlotRange -> All] |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Wed Jul 08, 2009 8:31 am |
|
|
|
Guest
|
http://www.geocities.com/rlbagulatftn/op_eye_ifs.gif
Another of the nested ellipse types that I found yesterday.
A very simple op art type tiling of a circle:
Clear[f, dlst, pt, cr, ptlst, x, y]
dlst = Table[ Random[Integer, {1, 2}], {n, 250000}];
f[1, {x_, y_}] := N[{-x/2 - y/2, x/2 - y/2 + 7/24}];
f[2, {x_, y_}] := N[ {2*x*y/(x2 + y2) , (x2 - y2)/(y2 + x2)}];
pt = {0.5, 0.75};
cr[n_] := If[n - 1 == 0, RGBColor[0, 0, 1], If[n - 2 ==
0, RGBColor[0, 0, 0], If[n - 3 == 0, RGBColor[1, 0, 0], RGBColor[0, 1, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio -> Automatic,
PlotRange -> All] |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Thu Jul 09, 2009 10:44 am |
|
|
|
Guest
|
http://www.geocities.com/rlbagulatftn/fractal_teardrops.gif
I was wondering if I could do the self-similar trick with othher figures
besides ellipses and circles and
I remembered the teardrop or piriform shape:
Clear[f, dlst, pt, cr, ptlst, x, y]
RandomSeed[];
dlst = Table[ Random[Integer, {1, 2}], {n, 250000}];
f[1, {x_,
y_}] := N[ {((
x^2 - y^2)/(y^2 + x^2))^2*2*x*y/(x^2 + y^2) , (x^2 - y^2)/(
y^2 + x^2)}];
f[2, {x_, y_}] := N[{7/24 - x/2 - y/2, x/2 - y/2}];
pt = {0.5, 0.75};
cr[n_] := If[n - 2 == 0, RGBColor[0, 0, 1], If[n - 3 == 0, RGBColor[0, 1,
0], If[n - 1 == 0, RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio ->
Automatic, PlotRange -> All] |
|
|
| Back to top |
|
|
|
| Roger Bagula... |
| Posted: Sat Jul 11, 2009 8:34 am |
|
|
|
Guest
|
http://www.geocities.com/rlbagulatftn/limacon_kiss.gif
So far there are four working parametric ifs projection types:
circle-ellipse
piriform-drop
lemniscape
limacon
There are two ways to get a kissing Limacon:
inner and outer:
Mathematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
RandomSeed[];
dlst = Table[ Random[Integer, {1, 2}], {n, 250000}];
f[1, {x_,
y_}] := N[ {(1 - 2*(x2 - y2)/(y2 + x2))*2*x*y/(x2 + y2) , (
1 - 2*(x2 - y2)/(y2 + x2))*(x2 - y2)/(y2 + x2)}];
f[2, {x_, y_}] := N[{-x/(1/0.085) - y/((1/0.085)), -1/2 + x/((1/0.085))
- y/(
1/0.085)}];
pt = {0.5, 0.75};
cr[n_] :=
If[n - 2 == 0, RGBColor[0, 0, 1], If[n - 3 == 0, RGBColor[0, 1,
0], If[n - 1 == 0, RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]],
AspectRatio -> Automatic, PlotRange -> All]
http://www.geocities.com/rlbagulatftn/limacon_2ndkiss.gif
MATHEMATICA:
Clear[f, dlst, pt, cr, ptlst, x, y]
RandomSeed[];
dlst = Table[ Random[Integer, {1, 2}], {n, 100000}];
f[1, {x_,
y_}] := N[ {(1 - 2*(x2 - y2)/(y2 + x2))*2*x*y/(x2 + y2) , (
1 - 2*(x2 - y2)/(y2 + x2))*(x2 - y2)/(y2 + x2)}];
f[2, {x_, y_}] := N[{-
x/(1/0.255) - y/(1/0.255), -1/2 + x/(1/0.255) - y/(1/0.255)}];
pt = {0.5, 0.75};
cr[n_] := If[
n - 2 == 0, RGBColor[0, 0, 1], If[n - 3 == 0, RGBColor[0, 1, 0],
If[n - 1 == 0, RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]],
AspectRatio -> Automatic, PlotRange -> All]
http://www.geocities.com/rlbagulatftn/lemniscape_kiss_iff.gif
A kissing lemniscape fractal ifs:
Mathhematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
RandomSeed[];
dlst = Table[ Random[Integer, {1, 2}], {n, 250000}];
f[1, {x_,
y_}] := N[ {Sqrt[Abs[(((2*x)2 - (2*y)2)/((2*y)2 + (2*x)2))]]*2*x*y/(
x2 + y2) , Sqrt[Abs[(((2*x)2 - (2*y)2)/((2*y)2 + (2*
x)2))]]*(x2 - y2)/(y2 + x2)}];
f[2, {x_, y_}] := N[{-x/(1/0.370) - y/(1/0.370), 1/2 +
x/(1/0.370) - y/(1/0.370)}];
pt = {0.5, 0.75};
cr[n_] := If[
n - 2 == 0,
RGBColor[
0, 0, 1], If[n - 3 == 0, RGBColor[0, 1, 0], If[n - 1 == 0,
RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]]
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]],
AspectRatio -> Automatic, PlotRange -> All] |
|
|
| Back to top |
|
|
|
|
|
All times are GMT - 5 Hours
The time now is Sun Dec 06, 2009 3:30 pm
|
|