Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
Discussion Groups
Mathematics
General TopicsResearchOperations ResearchStatisticsMathematical LogicNumerical AnalysisUndergraduate MathAlgebra HelpRecreational Math
Math Software
MapleMathematicaMATLABScilabSASSPSS

Math Forum / Math Software / Mathematica / July 2009


Tip: Looking for answers? Try searching our database.

Eye of Ra :ellipse_self_similar

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Roger Bagula - 01 Jul 2009 11:34 GMT
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@sbcglobal.net
Reply to this Message
Roger Bagula - 02 Jul 2009 12:12 GMT
http://local.wasp.uwa.edu.au/~pbourke/fractals/trianguloid/
http://www.geocities.com/rlbagulatftn/trianguloid_ifs.gif
Mathematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
dlst = Table[ Random[Integer, {1, 3}], {n, 50000}];
f[1, {x_, y_}] := N[ {2*x*y/(x2 + y2) , (y2 - x2)/(y2 + x2)}];

f[2, {x_, y_}] := N[ {2/(x + 2) - 1, 2/(y + 2) - 1}];

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]
Reply to this Message
Roger Bagula - 03 Jul 2009 10:36 GMT
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]

>  
Reply to this Message
Roger Bagula - 04 Jul 2009 11:37 GMT
http://www.geocities.com/rlbagulatftn/eyeofra_ifs.gif
The Eye of Ra fractal
by doing an affine inside the
kiss ellipse with reduced the number of transforms in
Mathematica:
Clear[f, dlst, pt, cr, ptlst, x, y]
RandomSeed[];
dlst = Table[ Random[Integer, {1, 2}], {n, 100000}];
f[1, {x_, y_}] := N[ {2*x*y/(x^2 + y^2) , (y^2 - x^2)/(y^2 + x^2)}];
f[2, {x_, y_}] := N[ {(2*((x - y)/
Sqrt[2]) - (x + y)/Sqrt[2])/(
   2.83), (2*((x - y)/Sqrt[2]) + (x + y)/Sqrt[2])/(2.83)}];
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]
Reply to this Message
Roger Bagula - 04 Jul 2009 11:39 GMT
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]
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]
Reply to this Message
Roger Bagula - 09 Jul 2009 06:51 GMT
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]
Reply to this Message
Roger Bagula - 10 Jul 2009 11:43 GMT
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]

>  
Reply to this Message
Roger Bagula - 12 Jul 2009 10:50 GMT
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]
Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2010 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.