Excentral Triangle

Author

Eric W. Weisstein
November 11, 2005

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

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

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

Figure

t=Triangle[{{0.,0.},{3.,-.2},{1.,2.}}];
Show[Graphics[{
t,
{
Red,
Excircles[t]
},
{
Blue,
ExcentralTriangle[t]
},
{
Green,
Anticevians[t,Incenter[t]]
},
PointLabels[Join[
Append[#,Blue]&/@Transpose[{Excenters[t],{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],Transpose[{Point/@Vertices[t],{"A","B","C"}}],
{
{Incenter[t],"I",Green}
}
],{PointSize[.025],LabelOffset->.3}]
}],AspectRatio->Automatic]

Vertices

AnticevianTrilinears[Incenter]//MatrixForm//TraditionalForm

Side Lengths

<<PlaneGeometry`

abc=FullSimplify[LawOfCosines[ExpandAll[AnticevianTriangleSideLengths[Incenter]]],TriangleQ[]]

Area

area=FullSimplify[AnticevianTriangleArea[Incenter]Δ/TriangleArea[],TriangleQ[]]

FullSimplify[Abs[(a+b-c) (a-b+c) (-a+b+c)],TriangleQ[]]

FullSimplify[area  Inradius[]^2/r^2 Semiperimeter[]/s,TriangleQ[]]

Nested excentral triangles converge to an isosceles triangle

t=Triangle[{{0,0},{1,0},{.2,.6}}];
colors={Red,Orange,Green,Blue,Violet};
es=NestList[ExcentralTriangle,t,4];
points=Transpose[Flatten/@{VertexPoints/@es,Transpose[Table[#<>StringJoin@@Table["'",{n}],{n,0,4}]&/@{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}],
Table[colors[[i]],{i,5},{3}]
}];

Show[Graphics[{
Transpose[{colors,es}],
PointLabels[
points,
{PointSize[.03],LabelOffset->.5}
]
}],
AspectRatio->Automatic,PlotRange->All]

Collinear á la Honsberger

tri={{0,0},{1,0},{.2,.65}};
ext=Take[ExcentralTriangle[tri][[1]],3];
ic=Take[MedialTriangle[tri][[1]],3];
l={
Circumcenter[ext],"(Subscript[O, e])",Orthocenter[tri],"H",Incenter[ic],"(Subscript[I, m])",
		tri[[1]],"A",tri[[2]],"B",tri[[3]],"C",
		ext[[1]],"(Subscript[J, A])",ext[[2]],"(Subscript[J, B])",ext[[3]],"(Subscript[J, C])",
		ic[[1]],"(Subscript[M, A])",ic[[2]],"(Subscript[M, B])",ic[[3]],"(Subscript[M, C])"
};
{pts,str}=Transpose[Partition[l,2]] /. Point->Identity;
Show[Graphics[{
			{Thickness[.01],Triangle[tri]},
			MedialTriangle[tri],Incircle[ic],
			ExcentralTriangle[tri],Circumcircle[ext],
			{PointSize[.02],Point/@pts},
			Line[LongestLine[{Circumcenter[ext][[1]],Incenter[ic][[1]],Orthocenter[tri][[1]]}]],
			Table[Text[str[[i]],pts[[i]]+{.05,.07}],{i,Length[pts]}]
			}],
	AspectRatio->Automatic]

Euler Line analog

tri={{0,0},{1,0},{.2,.65}};
ext=Take[ExcentralTriangle[tri][[1]],3];
l={
		Circumcenter[tri],"O",NinePointCenter[ext],"(Subscript[N, e])",
Circumcenter[ext],"(Subscript[O, e])",Orthocenter[ext],"(Subscript[H, e])",Incenter[tri],"I",
		tri[[1]],"A",tri[[2]],"B",tri[[3]],"C",
		ext[[1]],"(Subscript[J, A])",ext[[2]],"(Subscript[J, B])",ext[[3]],"(Subscript[J, C])"
};
{pts,str}=Transpose[Partition[l,2]] /. Point->Identity;
Show[Graphics[{
			{Thickness[.01],Triangle[tri]},
			Incircle[tri],Circumcircle[tri],
			ExcentralTriangle[tri],Circumcircle[ext],
			{PointSize[.02],Point/@pts},
			Line[LongestLine[{Circumcenter[tri],Circumcenter[ext],Incenter[tri]} /. Point->Identity]],
				Table[Text[str[[i]],pts[[i]]+{.05,.07}],{i,Length[pts]}]
			}],
	AspectRatio->Automatic]

Centers

(pts={#,KimberlingLookup[#[ExcentralTriangle]]}&/@Take[KimberlingCenters,All]);//Timing

l=Map[First,DeleteCases[pts,_?(Last[#]==={}&)],{2}]

moses={{1,164},{2,165},{3,40},{4,1},{5,3},{6,9},{7,166},{8,167},{9,168},{15,1277},{16,1276},{19,173},{24,46},{25,57},{30,517},{31,362},{32,169},{33,258},{46,505},{48,504},{51,2},{52,4},{53,6},{54,191},{57,363},{63,845},{64,2136},{65,188},{68,1490},{69,2951},{75,844},{76,170},{92,503},{95,2938},{96,2939},{97,2941},{98,1282},{107,1054},{110,1768},{113,104},{114,103},{115,101},{122,1293},{125,100},{127,1292},{128,74},{129,98},{130,99},{131,102},{132,105},{133,106},{134,107},{135,108},{136,109},{137,110},{138,111},{139,112},{143,5},{155,84},{158,361},{184,63},{185,8},{186,484},{216,573},{225,266},{230,910},{231,2173},{232,672},{235,56},{249,2958},{250,2957},{252,2940},{254,2956},{264,1742},{275,846},{317,1721},{389,10},{393,1743},{403,36},{418,1764},{421,1758},{427,55},{428,354},{429,260},{460,241},{467,1754},{468,1155},{511,516},{512,514},{523,513},{526,900},{542,2801},{546,1385},{570,71},{571,19},{577,1766},{647,649},{804,926},{847,1745},{924,522},{973,442},{974,1145},{1093,978},{1105,2943},{1112,11},{1113,2448},{1114,2449},{1136,1507},{1141,2948},{1147,1158},{1154,30},{1263,399},{1312,1381},{1313,1382},{1503,518},{1510,523},{1560,2291},{1562,644},{1593,1697},{1594,35},{1596,999},{1609,2270},{1637,1635},{1799,2942},{1824,174},{1826,259},{1827,1488},{1828,2089},{1829,177},{1838,1130},{1843,7},{1844,1128},{1856,289},{1879,48},{1899,200},{1968,2082},{1974,1445},{1986,80},{1990,44},{1993,1709},{2052,43},{2072,2077},{2165,610},{2262,236},{2351,1763},{2393,527},{2489,657},{2501,650},{2679,927},{2777,2802},{2781,528},{2782,2808},{2790,2810},{2794,2809},{2797,2821},{2799,2820},{2848,2832},{2904,90},{3003,2183},{3018,2265}};

l==moses

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