| Frühere | Chronologischer Index | Spätere | ||
| Vorherige | Thematischer Index | Nächste |
Liebe Freundinnen und Freunde der Planimetrie,nur als Nachlese und seitliche Arabeske, die in den Beweisen erwähnten 17 weiteren gleichseitigen Dreiecke kann man etwa mittels
Clear[morleyConnes];
morleyConnes::nonumtrian = "Numerical not a triangle.";
morleyConnes[{x1_, y1_}, {x2_, y2_}, {x3_, y3_}, (* Dreieck *)
{j1_Integer, j2_Integer, j3_Integer} (* Potenzen von j an f, g, h *)
] :=
Module[{v = {x1, x2, x3, y1, y2, y3},
e1, e2, e3, (* Ecken *)
k1, k2, k3, (* Kanten *)
w1, w2, w3, (* Winkel *)
\[Lambda]f, \[Lambda]g, \[Lambda]h, \[Mu]f, \[Mu]g, \[Mu]h,
p1, p2, p3 (* Morleydreieck *)},
If[! VectorQ[v, NumericQ] ||
Chop[N[Det[Join[{{1, 1, 1}}, Partition[v, 3]]]]] == 0,
Message[morleyConnes::nonumtrian];
Return[$Failed],
If[ Det[Join[{{1, 1, 1}}, Partition[v, 3]]] > 0,
e1 = {x1, y1}; e2 = {x2, y2}; e3 = {x3, y3},
e1 = {x1, y1}; e2 = {x3, y3}; e3 = {x2, y2}
]
];
k1 = e2 - e1;
k2 = e3 - e2;
k3 = e1 - e3;
w1 = \[Pi] - ArcCos[Normalize[k3].Normalize[k1]];
w2 = \[Pi] - ArcCos[Normalize[k1].Normalize[k2]];
w3 = \[Pi] - ArcCos[Normalize[k2].Normalize[k3]];
(* nach den Fixpunktformeln *)
\[Lambda]f = Exp[2 I (w1 + j1 \[Pi])/3];
\[Mu]f = (#1 + I #2) & @@ e1 (1 - \[Lambda]f);
\[Lambda]g = Exp[2 I (w2 + j2 \[Pi])/3];
\[Mu]g = (#1 + I #2) & @@ e2 (1 - \[Lambda]g);
\[Lambda]h = Exp[2 I (w3 + j3 \[Pi])/3];
\[Mu]h = (#1 + I #2) & @@ e3 (1 - \[Lambda]h);
p1 = {Re[#],
Im[#]} &[(\[Lambda]f \[Mu]g + \[Mu]f)/(1 - \[Lambda]f \
\[Lambda]g)];
p2 = {Re[#],
Im[#]} &[(\[Lambda]g \[Mu]h + \[Mu]g)/(1 - \[Lambda]g \
\[Lambda]h)];
p3 = {Re[#],
Im[#]} &[(\[Lambda]h \[Mu]f + \[Mu]h)/(1 - \[Lambda]h \
\[Lambda]f)];
Graphics[{{Thickness[0.01],
Line[{e1, e2, e3, e1}], {RGBColor[1, 0, 0],
Line[{p1, p2, p3, p1}]}},
Line[{e1, p3}], Line[{e1, p1}], Line[{e2, p1}], Line[{e2, p2}],
Line[{e3, p2}], Line[{e3, p3}]},
PlotRange -> All, Frame -> True]
] /; Mod[j1 + j2 + j3, 3] != 2
zeichnen lassen, indem man j1, j2, j3 aus 0, 1, 2 wählt. Alle 18 zusammen
mit dem Ursprungsdreieck Polygon[{-3, 6}, {-2, 2}, {0, 4}}]in Schwarz
ergeben das Bildchen.
Gruss Udo. -- Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
morleyS18.jpeg
Description: JPEG image
| Frühere | Chronologischer Index | Spätere | ||
| Vorherige | Thematischer Index | Nächste |
DMUG-Archiv, http://www.mathematica.ch/archiv.html