Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

kiss ellipses

• To: mathgroup at smc.vnet.net
• Subject: [mg101396] kiss ellipses
• From: Roger Bagula <rlbagula at sbcglobal.net>
• Date: Sat, 4 Jul 2009 06:45:15 -0400 (EDT)
• References: <h2fe37$ppu$1@smc.vnet.net> <h2kjf0$imr$1@smc.vnet.net>

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]