|
- UID
- 610
- 帖子
- 370
- 精华
- 3
- 积分
- 747
- 来自
- 山东济南
|
101# xiaongxp
看不懂，中国研究分形的人太少了，想查阅相关资料都找不到
下面这个程序也看不懂，是否与此问题有关
Kleinian Double Cusp Group - Mathematica 4.2, POV-Ray 3.6.1, 8/10/05
Here is my first attempt to create a double cusp group as described in the book Indra’s Pearls. Thanks to Dr. William Goldman for helping me get started with this. I hope to improve this code when I find some spare time.
(* runtime: 10 seconds *)
ta = 1.958591030 - 0.011278560I; tb = 2; tab = (ta tb + Sqrt[ta^2tb^2 - 4(ta^2 + tb^2)])/2;
z0 = (tab - 2)tb/(tb tab - 2ta + 2I tab);
a = {{ta, (ta tab - 2tb + 4I)/((tab + 2)z0)}, {(ta tab - 2tb - 4I)z0/(tab - 2), ta}}/2;
b = {{tb - 2I, tb}, {tb, tb + 2I}}/2; A = Inverse[a]; B = Inverse;
Affine[{z1_, z2_}] := z1/z2; Fix[M_] := Affine[Eigenvectors[M][[1]]];
z1 = Fix; z2 = Affine[A.{z1, 1}]; z3 = Fix[A.B.a.b];
ToMatrix[{z_, r_}] := (I/r){{z, r^2 - z Conjugate[z]}, {1, -Conjugate[z]}};
C0 = ToMatrix[{x0 + I y0, r}] /. Solve[Map[(Re[#] - x0)^2 + (Im[#] - y0)^2 == r^2 &, {z1,z2, z3}], {x0, y0, r}][[2]];
Reflect[C_, n_] := Module[{M = {a, b, A, B}[[n]]}, {M.C.Inverse[Conjugate[M]], n}];
Children[{C_, n_}] := Map[Reflect[C, #] &, Delete[Range[4], {3, 4, 1, 2}[[n]]]];
Orbit[1] := {Reflect[C0, 1],Reflect[C0, 3]}; Orbit[depth_] := Flatten[Map[Children, Orbit[depth - 1]], 1];
ToCircle[{{a_, b_}, {c_, d_}}] := Module[{z = a/c}, Circle[{Re[z], Im[z]}, Chop[I/c]]];
Show[Graphics[Map[ToCircle[#[[1]]] &, Orbit[10]]],AspectRatio -> 1, PlotRange -> 60{{-1, 1}, {-1, 1}}];
Links
Explanation - by David J. Wright, coauthor of Indra’s Pearls
Kleinian Gallery - by Jos Leys
Limit Sets - interesting animations by Jeffrey Brock, see his 3D bending
Indra’s Pearls course - Kleinian groups with David Wright |
|
