Johnson Midpoint

Author

Eric W. Weisstein
November 18, 2005

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

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

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

Code

TrilinearVertexMatrix[NotTheJohnsonTriangle]:={{(a^3-a*b^2+2*a*b*c-2*b^2*c-a*c^2-2*b*c^2)/(2*a*b*c),2+Cos[A-C],2+Cos[A-B]},{2+Cos[B-C],(-(a^2*b)+b^3-2*a^2*c+2*a*b*c-2*a*c^2-b*c^2)/(2*a*b*c),2+Cos[A-B]},{2+Cos[B-C],2+Cos[A-C],(-2*a^2*b-2*a*b^2-a^2*c+2*a*b*c-b^2*c+c^3)/(2*a*b*c)}}

Figure

t=Triangle[{{0,0},{1,0},{.7,.8}}];
ctrs=Center/@NotTheJohnsonCircles[t];
Show[Graphics[{
t,
{Red,Circumcircle[t]},
{Blue,JohnsonCircles[t]},
{Green,lines=Line/@Transpose[{Coordinates/@ctrs,Vertices[t]}],
MapIndexed[EqualSideTicksAboutMidpoint[#1,#2[[1]],.03]&,lines]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{ctrs,{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
{
{Circumcenter[t],"O",{Red,LabelOffset->{-.08,0}}},
{X[495][t],"(Subscript[X, 495])",{Green,LabelOffset->{0,-.1}}}
}
],LabelOffset->.06]
}],AspectRatio->Automatic]

Derivation

ConcurrentQ[lines=TrilinearLine/@Line@@@Transpose[TrilinearVertexMatrix/@{ReferenceTriangle,JohnsonTriangle}]]

Symmetrize[Intersections@@Take[lines,2]]

KimberlingLookup[%]

Derivation

Factor[ToSidelengths[{α,β,γ}/.Simplify[Solve[Append[Thread[Simplify[ExactTrilinears[Midpoint[{{α,β,γ},#}]]]==ExactTrilinears[X[495]]],4Area^2==(a α+b β+c γ)^2],{α,β,γ}]]/.c_Cos:>TrigExpand[c]]/.Sqrt[s_]Sqrt[t_]:>Simplify[Sqrt[s t],TriangleQ[]]]&/@IdentityMatrix[3]

circs=Circle[Symmetrize[ToAngles[Symmetrize[First[#]]]],Circumradius]&/@%178

circs2=CircleTriplet[{(((a^3)-a (b^2)+2 a b c-2 (b^2) c-a (c^2)-2 b (c^2))/(2a b c)), (2+Cos[A-C]),(2+Cos[A-B])},Circumradius]

Center/@circs2

Perspector

Simplify[PerspectiveQ[ReferenceTriangle,JohnsonMidpointTriangle],TriangleQ[]]

persp=Symmetrize[Simplify[Perspector[ReferenceTriangle,JohnsonMidpointTriangle],TriangleQ[]]]

KimberlingLookup[persp]

Name[X[495]]

CenterFunction[X[495]]

t=Triangle[{{0,0},{1,0},{.7,.8}}];
ctrs=Center/@JohnsonCircles[t];
Show[Graphics[{
t,
{Green,Circumcircle[t]},
{Blue,NotTheJohnsonCircles[t]},
{Red,NotTheJohnsonTriangle[t]},
{Orange,Line/@Transpose[Map[Vertices,{JohnsonTriangle[t],t},{1}]]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{ctrs,{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
{
{Circumcenter[t],"O",{Green}},
{X[495][t],"(Subscript[X, 495])",Orange}
}
],LabelOffset->.06]
}],AspectRatio->Automatic]