This is a multi-part message in MIME format.
--------------020302050005060300050801
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
"Dimension and measures for a curvilinear Sierpinski gasket or
Apollonian packings "
<http://www.math.unt.edu/%7Emauldin/papers/no104.pdf>(with
M. Urbanski),
_Advances in Mathematics_, 136(1998), 26-38.
http://www.math.unt.edu/~mauldin/papers/no104.pdf
I got a two transform version of this fractal going in True Basic
that I haven't been able to get up in Mathematica using a toral inverse
algorithm.
This version is different than the Russian algorithm that Paul Bourke
has at his site.
Basic idea it the original circle like transform rotated by 2*Pi/3 plus
and minus.
I just translated this into Mathematica:
Clear[f1, f1a, f2, f2a, f3, f3a, z, x, y, s]
(* http : // local.wasp.uwa.edu.au/~pbourke/fractals/apollony/*)
s = Sqrt[3];
z = x + I*y;
f1a[z_] = ComplexExpand[ ((s - 1)*z + 1)/(-z + (s + 1))];
f2a[z_] = ComplexExpand[((s - 1)*z + 1)/(-z + (s + 1))*Exp[I*2*Pi/3]];
f3a[z_] = ComplexExpand[((s - 1)*z + 1)/(-z + (s + 1))*Exp[-I*2*Pi/3]];
f1[{x_, y_}] = N[{Re[f1a[z]], Im[f1a[z]]}];
f2[{x_, y_}] = N[{Re[f2a[z]], Im[f2a[z]]}];
f3[{x_, y_}] = N[{Re[f3a[z]], Im[f3a[z]]}];
f[x_] := Which[(r = Random[]) <= 1/3, f1[x],
r <= 2/3, f2[x],
r <= 1.00, f3[x]]
(* initial iteration of center*)
b = NestList[f, {0, 0}, 10000];
(* complex inversion*)
c = Table[{b[[n]][[1]], -b[[n]][[2]]}/(b[[n]][[1]]^2 + b[[n]][[
2]]^2), {n, 2, Length[b]}];
(* putting the two together*)
d = Join[b, c];
a = Map[Point, d];
Dimensions[a]
{20001}
(* twice the points and the whole set for half the calculations*)
Show[Graphics[{PointSize[.001],
a}], AspectRatio -> Automatic]
g1 = Show[Graphics[{PointSize[.001], RGBColor[0, 0, 1],
Map[Point, b]}], AspectRatio -> Automatic]
g2 = Show[Graphics[{PointSize[.001], RGBColor[1, 0, 0],
Map[Point, c]}], AspectRatio -> Automatic]
Show[{g1, g2}]
--------------020302050005060300050801
Content-Type: text/html; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
</head>
<body bgcolor="#ffffff" text="#000000">
<font size="-1"><a
href="http://www.math.unt.edu/%7Emauldin/papers/no104.pdf">"Dimension
and measures
for a curvilinear Sierpinski gasket or Apollonian packings " </a>(with
M. Urbanski), <u>Advances in Mathematics</u>, 136(1998), 26-38.<br>
<a class="moz-txt-link-freetext"
href="http://www.math.unt.edu/~mauldin/papers/no104.pdf">http://www.math.unt.edu/~mauldin/papers/no104.pdf</a><br>
<br>
I got a two transform version of this fractal going in True
Basic<br>
that I haven't been able to get up in Mathematica using a toral inverse
algorithm.<br>
This version is different than the Russian algorithm that Paul
Bourke
has at his site.<br>
Basic idea it the original circle like transform rotated by 2*Pi/3 plus
and minus.<br>
I just translated this into Mathematica:<br>
Clear[f1, f1a, f2, f2a, f3, f3a, z, x, y, s]<br>
(* http : // local.wasp.uwa.edu.au/~pbourke/fractals/apollony/*)<br>
s = Sqrt[3];<br>
z = x + I*y;<br>
f1a[z_] = ComplexExpand[ ((s - 1)*z + 1)/(-z + (s + 1))];<br>
f2a[z_] = ComplexExpand[((s - 1)*z + 1)/(-z + (s + 1))*Exp[I*2*Pi/3]];<br>
f3a[z_] = ComplexExpand[((s - 1)*z + 1)/(-z + (s +
1))*Exp[-I*2*Pi/3]];<br>
f1[{x_, y_}] = N[{Re[f1a[z]], Im[f1a[z]]}];<br>
f2[{x_, y_}] = N[{Re[f2a[z]], Im[f2a[z]]}];<br>
f3[{x_, y_}] = N[{Re[f3a[z]], Im[f3a[z]]}];<br>
f[x_] := Which[(r = Random[]) <= 1/3, f1[x],<br>
r <= 2/3, f2[x],<br>
r <= 1.00, f3[x]] <br>
(* initial iteration of center*)<br>
b = NestList[f, {0, 0}, 10000];<br>
(* complex inversion*)<br>
c = Table[{b[[n]][[1]], -b[[n]][[2]]}/(b[[n]][[1]]^2 + b[[n]][[<br>
2]]^2), {n, 2, Length[b]}];<br>
(* putting the two together*)<br>
d = Join[b, c];<br>
a = Map[Point, d];<br>
Dimensions[a]<br>
{20001}<br>
(* twice the points and the whole set for half the calculations*)<br>
Show[Graphics[{PointSize[.001],<br>
a}], AspectRatio -> Automatic]<br>
g1 = Show[Graphics[{PointSize[.001], RGBColor[0, 0, 1],<br>
Map[Point, b]}], AspectRatio -> Automatic]<br>
g2 = Show[Graphics[{PointSize[.001], RGBColor[1, 0, 0],<br>
Map[Point, c]}], AspectRatio -> Automatic]<br>
Show[{g1, g2}]<br>
</font>
</body>
</html>
--------------020302050005060300050801--
|
