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] != 2zeichnen 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