DMUG-Archiv 2008

Frühere   Chronologischer Index   Spätere
Vorherige   Thematischer Index   Nächste

Re[2]: Aufgabe::Satz von Morley

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/

Attachment: morleyS18.jpeg
Description: JPEG image

Verweise:
Frühere   Chronologischer Index   Spätere
Vorherige   Thematischer Index   Nächste

DMUG DMUG-Archiv, http://www.mathematica.ch/archiv.html