Second Eppstein Point

Author

Eric W. Weisstein
March 29, 2003

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

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

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

Initialization

<<PlaneGeometry`;

Figure

t=Triangle[{{0,0},{1,0},{.2,.5}}];
ep2=X[482][t];
Show[Graphics[{t,
{DarkGreen,TangentCircles[t]},
{Blue,SoddyCircles[t][[1]]},
{Purple,InnerSoddyTriangle[t]},
{Red,LongestLine[#,1]&/@Transpose[{SoddyCircleContactPoints[t],Vertices[InnerSoddyTriangle[t]]}]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,DarkGreen]&/@Transpose[{Point/@SoddyCircleContactPoints[t],{"(Subscript[E, A])","(Subscript[E, B])","(Subscript[E, C])"}}],
Append[#,Blue]&/@Transpose[{VertexPoints[InnerSoddyTriangle[t]],{"(Subscript[I, A])","(Subscript[I, B])","(Subscript[I, C])"}}],
{
{ep2,"(Subscript[Ep, 2])",Red}
(*{InnerSoddyCenter[t],"s",Red}*)
}
],LabelOffset->.02,PointSize[.025]]
}],AspectRatio->Automatic,PlotRange->{{-.05,.6},{-.1,.55}}]

t=Triangle[{{0,0},{1,0},{.3,.7}}];
inner=Show[Graphics[{
t,
{Blue,TangentCircles[t]},
{Red,it=TangentialTriangle[InnerSoddyTriangle[t]]},
{Orange,InnerSoddyCircle[t]},
{Purple,LongestLine[#,2]&/@Transpose[Vertices/@{t,it}]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{VertexPoints[it],{"X","Y","Z"}}],
{
{InnerOldknowPoint[t],"Ol",Purple}
}
],PointSize[.025],LabelOffset->.05]
}],AspectRatio->Automatic,PlotRange->{{-.3,1.2},{-.4,.8}}]

Center

CenterName[X[482]]

CenterFunction[X[482]]

CenterFunction[EppsteinPoint[2]]

CenterFunction[OuterOldknowPoint]:=1+4Area[]/a/(-a+b+c)

<<PlaneGeometry`

Numerical Verification

Subtract@@@Table[t=Triangle[Table[Random[Real],{3},{2}]];
Coordinates[#[t]]&/@{EppsteinPoint[2],OuterOldknowPoint},{100}]//Chop

Analytic Verification

Through[{EppsteinPoint[2],OuterOldknowPoint}[t]]

id=Subtract@@First[Transpose[ExactTrilinears/@{EppsteinPoint[2],OuterOldknowPoint}]]

id/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]/.Thread[{A,B,C}->Angles[t]]/.Δ->Area[Evaluate[t]]

id2=DistanceTrilinears[id/.{
Cos[x_/2]:>Sqrt[(1+Cos[x])/2],
Sec[x_/2]:>Sqrt[2/(1+Cos[x])]
}]//.Times[Power[x_?(!NumberQ[#]&),Rational[1,2]],Power[y_?(!NumberQ[#]&),Rational[1,2]]]:>Sqrt[x y]/.(Sqrt[(a+b-c) (a-b+c) (-a+b+c) (a+b+c)])->4Δ

n=FullSimplify[(2 (1+(Sqrt[2]) (Sqrt[(((1+(((a^2)+(b^2)-(c^2))/(2 a b))) (1+(((a^2)-(b^2)+(c^2))/(2 a c))))/(1+((-(a^2)+(b^2)+(c^2))/(2 b c))))])) Δ),TriangleQ[]]

d=Simplify[Together//@(a (1+(Sqrt[2]) (Sqrt[(((1+(((a^2)+(b^2)-(c^2))/(2 a b))) (1+(((a^2)-(b^2)+(c^2))/(2 a c))))/(1+((-(a^2)+(b^2)+(c^2))/(2 b c))))]))+b (1+(Sqrt[2]) (Sqrt[(((1+(((a^2)+(b^2)-(c^2))/(2 a b))) (1+((-(a^2)+(b^2)+(c^2))/(2 b c))))/(1+(((a^2)-(b^2)+(c^2))/(2 a c))))]))+c (1+(Sqrt[2]) (Sqrt[(((1+(((a^2)-(b^2)+(c^2))/(2 a c))) (1+((-(a^2)+(b^2)+(c^2))/(2 b c))))/(1+(((a^2)+(b^2)-(c^2))/(2 a b))))]))),TriangleQ[]]

r=FullSimplify[((2 Δ (1+((4 Δ)/(a (-a+b+c)))))/(c (1+((4 Δ)/((a+b-c) c)))+b (1+((4 Δ)/(b (a-b+c))))+a (1+((4 Δ)/(a (-a+b+c)))))),TriangleQ[]]

id3=n/d-r