Napoleon's Theorem

Author

Eric W. Weisstein
August 10, 2010

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

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

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

Outer

V5

t=Triangle[{{0.,0.},{.9,.7},{2.,-.3}}];
Show[
Graphics[{
{Thickness[.01],t},
{Red,nt=NapoleonTriangle[1][t],
EqualSideTicks[nt,4,.04,.03]
},
{Blue,
Transpose[{e=ErectPolygons[t,1],MapIndexed[EqualSideTicks[#1,#2[[1]],.04,.02]&,e]}]
},
{Purple,
Circumcircle/@e},
{DarkGreen,
LongestLine[{Sequence@@#,Coordinates[FermatPoint[1][t]]}]&/@Transpose[{Vertices[t],RotateLeft[#[[2]]&/@Vertices/@e]}]
},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{Point/@Vertices[nt],{"(Subscript[N, AB])","(Subscript[N, BC])","(Subscript[N, AC])"}}],
Append[#,Blue]&/@Transpose[{Point/@(#[[2]]&/@Vertices/@e),{"(Subscript[E, AB])","(Subscript[E, BC])","(Subscript[E, AC])"}}],
{
{FermatPoint[1][t],"X",DarkGreen}
}
],{PointSize[.025],LabelOffset->.08}
]
}],AspectRatio->Automatic,PlotRange->All]

V6

Needs["Graphics`Colors`"]//Quiet

t=Triangle[{{0.,0.},{2.,-.3},{.9,.7}}];
Graphics[{
{Thickness[.01],t},
{Red,nt=OuterNapoleonTriangle[t],EqualSideTicks[nt,4,.04,.03]},
{Blue,Transpose[{e=ErectPolygons[t,3,1]//Chop,MapIndexed[EqualSideTicks[#1,#2[[1]],.04,.02]&,e/.Line[x_]:>Triangle[Take[x,3]]]}]},
{Purple,Circumcircle/@Triangle/@(Take[#,3]&/@e[[All,1]])},
{DarkGreen,
LongestLine[{Sequence@@#,Coordinates[FermatPoint[1][t]]}]&/@Transpose[{Vertices[t],RotateLeft[#[[2]]&/@Take[#,3]&/@e[[All,1]]]}]
},
PointLabels[Transpose[{{"A","B","C"},Vertices[t],{LabelOffset->{-.12,-.02},LabelOffset->{.12,-.04},LabelOffset->{0,.13}}}]],{Red,PointLabels[Transpose[{Subscript["N",#]&/@{"AB","BC","AC"},Point/@Vertices[nt],offs={LabelOffset->{.14,.12},LabelOffset->{-.12,.12},LabelOffset->{0,-.17}}}]]},
{Blue,PointLabels[Transpose[{Subscript["E",#]&/@{"AB","BC","AC"},e[[All,1]][[All,1]],offs}]]},
{DarkGreen,PointLabels[{{"X",FermatPoint[1][t],LabelOffset->{.05,-.15}}}]}
}]

Inner

V5

t=Triangle[{{0.,0.},{.9,.7},{2.,-.3}}];
Show[
Graphics[{
{Thickness[.01],t},
{Red,nt=NapoleonTriangle[2][t],
EqualSideTicks[nt,4,.04,.06]
},
{Blue,
Transpose[{e=ErectPolygons[t,-1],MapIndexed[EqualSideTicks[#1,#2[[1]],.04,.02]&,e]}]
},
{Purple,Circumcircle/@e},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{Point/@First/@Vertices/@e,{"E(Subscript[', AB])","E(Subscript[', BC])","E(Subscript[', AC])"}}],
Append[#,Red]&/@Transpose[{Point/@Vertices[nt],{"N(Subscript[', AB])","N(Subscript[', BC])","N(Subscript[', AC])"}}],
{
{FermatPoint[2][t],"X'",Purple}
}
],{PointSize[.025],LabelOffset->.08}
]
}],AspectRatio->Automatic]

Generalization

v={{0,0},{1,1.8},{-1,2}};
a={1.7,.9};
Show[Graphics[{ScaleneTriangularize[v,a],
			{Thickness[.01],Triangle[v]},
		{Dashing[{.02,.02}],NapoleonTriangle[v,a,{1,1,1}]}
		}],
	AspectRatio->Automatic]