Johnson Circles

Author

Eric W. Weisstein
February 7, 2006

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

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

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

Centers

Factor[Outer[Factor[ToSidelengths[TrilinearEquation[Circles[JohnsonCircles][[#1]]]]/.Thread[{α,β,γ}->#2]]&,Range[3],IdentityMatrix[3]]/.Sqrt[s_]:>Simplify[Sqrt[s],TriangleQ[]]/.Sqrt[s_]Sqrt[t_]:>Simplify[Sqrt[s t],TriangleQ[]]]

Circles[JohnsonCircles]

Figure

t=Triangle[{{0,0},{1,0},{.7,.8}}];
ctrs=Center/@JohnsonCircles[t];
Show[Graphics[{
t,
{Red,Circumcircle[t]},
{Blue,JohnsonCircles[t]},
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}}}
}
],LabelOffset->.06]
}],AspectRatio->Automatic]

Point of Concurrence

rc=RadicalCircle[JohnsonCircles];//Timing

rcs=Symmetrize[ToAngles[Factor[ToSidelengths[Center[rc]]/.c_Cos:>TrigExpand[c]/.Sqrt[s_]Sqrt[t_]:>Simplify[Sqrt[s t],TriangleQ[]]][[1]]]]

KimberlingLookup[CyclicTrilinears[rcs]]

Name[X[4]]

t=Triangle[{{0,0},{1,0},{.5,.7}}];
Show[Graphics[{
t,
{Blue,JohnsonCircles[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{Center/@JohnsonCircles[t],{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
{
{Orthocenter[t],"H",Red}
}
],LabelOffset->.06,PointSize[.025]]
}],AspectRatio->Automatic]

Circumcscribing circle

t=Triangle[{{0,0},{1,0},{.2,.7}}];
Show[Graphics[{
t,
{Blue,j=JohnsonCircles[t]},
{Red,
{Dashing[{.02}],
Circle[Coordinates[h=Orthocenter[t]],CircleRadius[JohnsonCircles[t][[1]]]]
},
c2=Circle[Coordinates[h],2CircleRadius[j[[1]]]]
},
{Green,
Line/@(l=Map[Coordinates,(Intersections[Line[Coordinates/@{#,h}],c2]&/@j),{2}])
},
{Purple,
at=AnticomplementaryTriangle[t],
EqualSideTicksAboutMidpoints[at,.03,.02]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Purple]&/@Transpose[{VertexPoints[at],{"(Subscript[P, A])","(Subscript[P, B])","(Subscript[P, C])"}}],
Append[#,Blue]&/@Transpose[{Center/@j,{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
{
{h,"H",Red}
}
],LabelOffset->.06,PointSize[.025]]
}],AspectRatio->Automatic]