First Morley Triangle

Author

Eric W. Weisstein
November 16, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/FirstMorleyTriangle.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/FirstMorleyTriangle.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Equilateral

EquilateralQ[MorleysTriangle[1][RandomTriangle[20]]]

#^2&/@EquilateralQ[CircumtangentialTriangle]

Figure

t=Triangle[{{0,0},{1,0},{.3,.7}}];
mt=MorleysTriangle[1][t];
Show[Graphics[{
t,
{Blue,
Rest/@MapIndexed[RotateLeft[#1,#2+2]&,Cevians[t,#]&/@TrilinearVertexMatrix[MorleysTriangle[1]]]
},
{DarkGreen,
VertexArcs[t,.1],
EqualAngleDivisionTicks[t,3,.1,.02,.07]
},
{Red,mt},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{VertexPoints[mt],{"A'","B'","C'"}}]
],LabelOffset->.03]
}],AspectRatio->Automatic,PlotRange->All]

Trilinear Vertex Matrix

TrilinearVertexMatrix[MorleysTriangle[1]]//TraditionalForm

Side Lengths

Exact

8Circumradius Sin[A/3]Sin[B/3]Sin[C/3]

Numerical

t=RandomTriangle[20]

t=Triangle[{{0.72570079653040926661227011224044041067`19.999999999999996,0.93415908388439769663770842750684462313`20.000000000000004},{0.73704722749559274376288482621670002234`20.,0.76293800395205367385498696753038617101`19.999999999999996},{0.56784118770602725956377203658956984091`20.,0.88064517873338650936372283218628472228`20.}}]

SideLengths[Evaluate[MorleysTriangle[1][t]]]

ToSidelengths[8Circumradius Sin[A/3]Sin[B/3]Sin[C/3]]/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]

Symbolic Attempt

abc=SideLengths[MorleysTriangle[1]]^2

FullSimplify[Together//@(Subtract@@(Most[abc]^2)),TriangleQ[]&&Area>0]//Timing

...hangs...

Sqrt[Factor[Cancel[abc[[1]]]]/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]/.Thread[{A,B,C}->Angles[t]]]

Numerical Check

t=RandomTriangle[20];

Sqrt[Factor[abc[[1]]]]/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]/.Thread[{A,B,C}->Angles[t]]

8Circumradius Sin[A/3]Sin[B/3]Sin[C/3]/.TriangleRules/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]/.Thread[{A,B,C}->Angles[t]]

Gröbner

{numer,denom}=Through[{Numerator,Denominator}[Factor[abc[[1]]]]]

ToSidelengths[Cos[A]]

Factor/@GroebnerBasis[
{
s denom-numer/.{Cos[A/3]->cosa,Cos[B/3]->cosb,Cos[C/3]->cosc},
(cosa^3-3cosa(1-cosa^2))2b c-(c^2+b^2-a^2),
(cosb^3-3cosb(1-cosb^2))2c a-(c^2-b^2+a^2),
(cosc^3-3cosc(1-cosc^2))2a b-(-c^2+b^2+a^2)
},s]

Old Stuff

Factor[Cancel[abc[[1]]]]

Factor[Cancel[abc[[1]]]]/.Thread[{Cos[A/3],Cos[B/3],Cos[C/3]}->{cosa,cosb,cosc}]

poly=TrigExpand[(1+2 Cos[((2 C)/3)]) (5-2 Cos[((4 A)/3)]-2 Cos[((4 B)/3)]+(10+4 Cos[((2 A)/3)]+4 Cos[((2 B)/3)]) Cos[((2 C)/3)]+8 Cos[(A/3)] Cos[(B/3)] (2 (-2+Cos[((2 A)/3)]+Cos[((2 B)/3)]) Cos[(C/3)]-Cos[C]))]/.Thread[{Cos[A/3],Cos[B/3],Cos[C/3],Sin[A/3],Sin[B/3],Sin[C/3]}->{cosa,cosb,cosc,sina,sinb,sinc}]

(Sin[A/3]Sin[B/3]Sin[C/3])

terms=Factor[GroebnerBasis[{poly,cosa^2+sina^2-1,cosb^2+sinb^2-1,cosc^2+sinc^2-1,
cosa^2+cosb^2+cosc^2+2cosa cosb cosc-1},{sina,sinb,sinc},{cosa,cosb,cosc},MonomialOrder->EliminationOrder]]

terms={(sina^4)-2 (sina^2) (sinb^2)+(sinb^4)-2 (sina^2) (sinc^2)-2 (sinb^2) (sinc^2)+4 (sina^2) (sinb^2) (sinc^2)+(sinc^4),81+108 (sina^2)-128 (sina^4)+108 (sinb^2)-32 (sina^2) (sinb^2)-128 (sinb^4)-324 (sinc^2)-32 (sina^2) (sinc^2)+128 (sina^4) (sinc^2)-32 (sinb^2) (sinc^2)+128 (sinb^4) (sinc^2)+304 (sinc^4)-64 (sina^2) (sinc^4)-64 (sinb^2) (sinc^4)-64 (sinc^6),-405-540 (sina^2)+640 (sina^4)-256 (sina^6)+108 (sinb^2)+1024 (sina^2) (sinb^2)-512 (sina^4) (sinb^2)+1504 (sinb^4)-512 (sina^2) (sinb^4)-1024 (sinb^6)+1620 (sinc^2)+160 (sina^2) (sinc^2)-2432 (sinb^2) (sinc^2)-768 (sinb^4) (sinc^2)+1024 (sinb^6) (sinc^2)-1520 (sinc^4)-192 (sina^2) (sinc^4)+2496 (sinb^2) (sinc^4)-512 (sinb^4) (sinc^4)+448 (sinc^6)-512 (sinb^2) (sinc^6),-1863-864 (sina^2)+3456 (sina^4)-3072 (sina^6)+1024 (sina^8)-864 (sinb^2)+5760 (sina^2) (sinb^2)-6144 (sina^4) (sinb^2)+2048 (sina^6) (sinb^2)+3456 (sinb^4)-6144 (sina^2) (sinb^4)+3072 (sina^4) (sinb^4)-3072 (sinb^6)+2048 (sina^2) (sinb^6)+1024 (sinb^8)+7290 (sinc^2)-2664 (sina^2) (sinc^2)-2664 (sinb^2) (sinc^2)-7992 (sinc^4)+2496 (sina^2) (sinc^4)+2496 (sinb^2) (sinc^4)+3168 (sinc^6)-640 (sina^2) (sinc^6)-640 (sinb^2) (sinc^6)-384 (sinc^8)};

id1=FullSimplify[terms[[1]]/.Thread[{sina,sinb,sinc}->{Sin[A],Sin[B],Sin[C]}],TriangleQ[]]

id2=FullSimplify[terms[[2]]/.Thread[{sina,sinb,sinc}->{Sin[A],Sin[B],Sin[C]}],TriangleQ[]]

id3=FullSimplify[terms[[3]]/.Thread[{sina,sinb,sinc}->{Sin[A],Sin[B],Sin[C]}],TriangleQ[]]

terms[[3]]/.Thread[{sina,sinb,sinc}->{Sin[A],Sin[B],Sin[C]}]

{Sin[A/3]Sin[B/3]Sin[C/3], id}/.Thread[{A,B,C}->Angles[Evaluate[Triangle[Table[Random[],{3},{2}]]]]]

Area

FullSimplify[Area[MorleysTriangle[1]] Δ/Area[]]

Perspectors

tris=DeleteCases[Triangles,MorleysTriangle[1]];

pts=DeleteCases[{#,k=KimberlingLookup[Perspector[MorleyTriangle[1],#]]}&/@Take[tris,All],_?(Last[#]==={}&)]

{Name[#[[1]]],X[#[[2,1]]],Name[X[#[[2,1]]]]}&/@Cases[pts,_?(Last[#]=!={}&)]//TableForm

Misc.

Show[MorleysTriangle[{{0,0},{1,.2},{.4,.8}}],AspectRatio->Automatic,PlotRange->All]

Code

This is old and can probably be deleted

MorleysTriangles::usage="MorleysTriangles gives a Graphics object showing Morley's triangles created by trisection exterior as well as interior angles."

uv[v1_,v2_]:=(v2-v1)/Sqrt[(v2-v1).(v2-v1)]
rot[a_]:={{Cos[a],-Sin[a]},{Sin[a],Cos[a]}}

MorleysTriangles[t_Triangle]:=Module[{dv,i,ang=Angles[t],v=Vertices[t],u1,u2,t,ts,tb},dv=Table[{uv[v[[i]],v[[addn[i,1,3]]]],uv[v[[i]],v[[addn[i,2,3]]]]},{i,3}];
u1=Table[{v[[i]],v[[i]]+rot[ang[[i]]j/3].dv[[i,1]]},{j,2},{i,3}];
u2=Table[{v[[i]],v[[i]]+rot[(-Pi+ang[[i]])j/3].dv[[i,1]]},{j,2},{i,3}];
t={Intersections[Line@u1[[1,1]],Line@u1[[2,2]]],Intersections[Line@u1[[1,2]],Line@u1[[2,3]]],Intersections[Line@u1[[1,3]],Line@u1[[2,1]]]};
ts={Intersections[Line@u2[[2,1]],Line@u1[[1,3]]],Intersections[Line@u2[[1,2]],Line@u1[[2,3]]],Intersections[Line@u2[[2,3]],Line@u1[[1,2]]],Intersections[Line@u2[[1,1]],Line@u1[[2,2]]],Intersections[Line@u2[[2,2]],Line@u1[[1,1]]],Intersections[Line@u2[[1,3]],Line@u1[[2,1]]]};
tb={Intersections[Line@{ts[[1]],ts[[6]]},Line@{ts[[2]],ts[[3]]}],Intersections[Line@{ts[[1]],ts[[6]]},Line@{ts[[4]],ts[[5]]}],Intersections[Line@{ts[[2]],ts[[3]]},Line@{ts[[4]],ts[[5]]}]};
Graphics[{ClosedLine[v],{Thickness[.01],ClosedLine[t],ClosedLine[ts]},Line/@{{v[[1]],ts[[6]]},{v[[1]],ts[[5]]},{v[[2]],ts[[3]]},{v[[2]],ts[[4]]},{v[[3]],ts[[1]]},{v[[3]],ts[[2]]}},Line/@{{ts[[1]],tb[[3]]},{ts[[2]],tb[[2]]},{tb[[2]],ts[[3]]},{ts[[6]],tb[[3]]},{ts[[4]],tb[[1]]},{tb[[1]],ts[[5]]}}}]]

Show[MorleysTriangles[{{0,0},{1,.2},{.5,.8}}],
	AspectRatio->Automatic,PlotRange->All]

Centers

(pts={#,KimberlingLookup[#[MorleysTriangle[1]]]}&/@Take[KimberlingCenters,10]);//Timing

{#[[1]],Name[#[[1]]],X[#[[2,1]]],Name[X[#[[2,1]]]]}&/@Cases[pts,_?(Last[#]=!={}&)]//TableForm