Re: Aufgabe::Satz von Morley

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Liebe Freundinnen und Freunde der Planimetrie

> On Thu, 25 Sep 2008 19:00:00 +0200, Bernhard Schnizer <snip>@<snap>  
> wrote:
>
> Wikipedia verweist auf folgenden elementaren Beweis:
> http://www.cut-the-knot.org/triangle/Morley/index.shtml

und rechnerisch kann man sich mit

Clear[morleyS];
morleyS::nonumtrian = "Numerical not a triangle.";
morleyS::nomode  = "The mode value `1` belongs not to {0, 1, 2, 3}.";
morleyS[{x1_, y1_}, {x2_, y2_}, {x3_, y3_}, (* Dreieck *)
                p_, (* Winkelteiler *)
                q_Integer: 1  (* Mode *)] :=
 Module[{v = {x1, x2, x3, y1, y2, y3}, preC = 32,
    e1, e2, e3, (* Ecken *)
    k1, k2, k3, (* Kanten *)
    w1, w2, w3, (* Winkel *)
    p1, p2, p3, (* Winkel-p-Teilendendreieck *)
    xD (* Defekt *),
    x = If[p > 1, 1/p, p], o = {{0, -1}, {1, 0}}},
   If[! VectorQ[v, NumericQ] ||
     Chop[N[Det[Join[{{1, 1, 1}}, Partition[v, 3]]]]] == 0,
    Message[morleyS::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]];
   If[ Chop[p] == 0,
    p1 = e1 + k1/(1 + w1/w2);
    p2 = e2 + k2/(1 + w2/w3);
    p3 = e3 + k3/(1 + w3/w1),
    p1 = e1 + (Sqrt[k1.k1]/(#1 + Cot[x w2]) (#1 #2 + o.#2)) &[
      Cot[x w1], Normalize[k1]];
    p2 = e2 + (Sqrt[k2.k2]/(#1 + Cot[x w3]) (#1 #2 + o.#2)) &[
      Cot[x w2], Normalize[k2]];
    p3 = e3 + (Sqrt[k3.k3]/(#1 + Cot[x w1]) (#1 #2 + o.#2)) &[
      Cot[x w3], Normalize[k3]]
    ];
   xD = 1 -
     Dot[Normalize[{1, 1, 1}],
      Normalize[ {(p2 - p1).(p2 - p1), (p3 - p2).(p3 - p2), (p1 -
           p3).(p1 - p3)}]];
   Switch[ q,
    0, SetAccuracy[xD, preC], (* defect *)
    1, 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}]},
     PlotLabel ->
      "Winkelteiler = " <> ToString[x, InputForm] <>
       " Gleichseitigkeitsdefekt = " <>
       ToString[N[Abs[xD]], InputForm], PlotRange -> All,
     Frame -> True],
    2, SetPrecision[{p1, p2, p3}, preC/2], (* points 2D *)
    3, SetPrecision[Map[Join[#, {5 x}] &, {p1, p2, p3}], preC/2], (*
    points 3D *)
    _, Message[morleyS::nomode, q]; Return[$Failed]
    ]
   ] /; 0 <= p

einen Überblick verschaffen. Wenn der Winkelteiler p = 1 ist, dann wird  
das Ausgangsdreieck gezeichnet, für p = 1/3 (~= 3) wird das Morleydreieck  
gezeichnet.

Für irgendein Dreieck ist die Evidenz durch

In[14]:= FindRoot[ morleyS[{7, -8}, {-4, -1}, {3/7, 6/5}, x, 0] == 0, {x,  
1, 5}]
Out[14]= {x -> 3.}

In[15]:= FindMinimum[ morleyS[{7, -8}, {-4, -1}, {3/7, 6/5}, x, 0], {x, 1}]
Out[15]= {0., {x -> 3.}}

gegeben, da in morleyS[] Werte mit p > 1 auf den reziproken Wert  
abgebildet werden. Man kann sich die inneren Dreiecke für verschiedene  
Teiler ansehen:

Show[morleyS[{-7, 8}, {-4, 2}, {-1, 1}, 1/3, 1],
 Graphics[
  Thread[Line[
    Transpose[
     morleyS[{-7, 8}, {-4, 2}, {-1, 1}, #, 2] & /@
      Range[0, 1, 0.005]]]]]
 ]

Alle möglichen bis auf Ähnlichkeit verschiedenen Dreiecke können mit einer  
Seite Line[{{0,0},{1,0}}] und dem dritten Punkt in der oberen Halbebene  
dargestellt werden. Damit kann man die drei Punkte des inneren Dreiecks  
als Funktion der beiden Winkel mit Scheitel in {0,0} bzw. in {1,0} und des  
Winkelteilers z darstellen

Remove[pp1, pp2, pp3];
pp1[w1_, w2_, z_] := {Cos[w1 z] Csc[(w1 + w2) z] Sin[w2 z], 1/(
  Cot[w1 z] + Cot[w2 z])}
pp2[w1_, w2_, z_] := {1 - (1 + Cot[w2] Cot[w2 z])/((Cot[w1] +
      Cot[w2]) (Cot[(Pi - w1 - w2) z] + Cot[w2 z])),
  Csc[w1 + w2] Csc[(Pi - w1) z] Sin[
    w1] Sin[(Pi - w1 - w2) z] Sin[w2 - w2 z]}
pp3[w1_, w2_, z_] := {Cos[w1 - w1 z] Csc[w1 + w2] Csc[(Pi - w2) z] Sin[
    w2] Sin[(Pi - w1 - w2) z],
  Csc[w1 + w2] Csc[(Pi - w2) z] Sin[
    w2] Sin[(Pi - w1 - w2) z] Sin[w1 - w1 z]}

und mit der Eingabe

 ContourPlot3D[
 Normalize[pp1[w1, w2, z] - pp3[w1, w2, z]] .
   Normalize[pp2[w1, w2, z] - pp3[w1, w2, z]] == 1/2,
 {w1, 0, \[Pi]}, {w2, 0, \[Pi]}, {z, 0, 1/2}]

(analog für die beiden Winkel mit Scheitel in pp2 bzw. pp1) einen  
Sichtbeweis für alle Dreiecke führen. Es resultiert eine Ebene z = 1/3 und  
eine dazu senkrechte, von z unabhängige Fläche, die natürlich den Fall  
darstellt, dass nur der Winkel in pp3 60° beträgt. Alle drei Winkel (mit  
Scheitel in pp1, pp2, pp3) sind nur dann unabhängig von w1 und w2 60°,  
wenn z = 1/3 ist.

Gruss
Udo.