First Eppstein Point

Author

Eric W. Weisstein
July 23, 2003

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

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

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

Initialization

<<PlaneGeometry`;

Figure

t=Triangle[{{0,0},{1,0},{.4,.7}}];
ep1=EppsteinPoint[1][t];
Show[Graphics[{t,
{DarkGreen,TangentCircles[t]},
{Blue,OuterSoddyCircle[t]},
{Purple,OuterSoddyTriangle[t]},
{Red,LongestLine[#,1]&/@Transpose[{SoddyCircleContactPoints[t],Vertices[OuterSoddyTriangle[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[OuterSoddyTriangle[t]],{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
{
{ep1,"(Subscript[Ep, 1])",Red}
(*{InnerSoddyCenter[t],"s",Red}*)
}
],LabelOffset->.07,PointSize[.025]]
}],AspectRatio->Automatic,
PlotRange->{{-.5,1.7},{-.8,1.3}}]

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Show[Graphics[{
t,
{Blue,TangentCircles[t]},
{Red,ot=TangentialTriangle[OuterSoddyTriangle[t]]},
{Orange,OuterSoddyCircle[t]},
{Purple,LongestLine[#,2]&/@Transpose[Vertices/@{t,ot}]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{VertexPoints[ot],{"X'","Y'","Z'"}}],
{
{EppsteinPoint[1][t],"(Subscript[Ep, 1])",Purple}
}
],PointSize[.025],LabelOffset->.08]
}],AspectRatio->Automatic,PlotRange->{{-1,2},{-1,1.5}}]

Center

CenterName[X[481]]

CenterFunction[X[481]]

CenterFunction[EppsteinPoint[1]]

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

<<PlaneGeometry`

Numerical Verification

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

Analytic Verification

Through[{EppsteinPoint[1],InnerOldknowPoint}[t]]

id=Subtract@@First[Transpose[ExactTrilinears/@{EppsteinPoint[1],InnerOldknowPoint}]]

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