Tangent Circles

Author

Eric W. Weisstein
March 15, 2005

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

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

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

Additional Authors

Threewise tangent circles by 
Michael Trott
March 26, 2004

Code

TwoTangentCircles::usage="TwoTangentCircles[R,{x,y}] plots the two configurations of mutually tangent circles, where the first is centered at (0,0) and is of radius R, and the second is centered at (x,y)."

TwoTangentCircles[R_,{x_,y_}]:=Module[{dr1=R+Sqrt[x^2+y^2],dr2=Abs[R-Sqrt[x^2+y^2]]},{Graphics[{Disk[{0,0},R],{GrayLevel[1],Disk[{x,y},Abs[R-Sqrt[x^2+y^2]]]},Circle[{x,y},Abs[R-Sqrt[x^2+y^2]]]},AspectRatio->Automatic,PlotRange->{{Min[-R,x-dr1,x-dr2],Max[R,x+dr1,x+dr2]},{Min[-R,y-dr1,y-dr2],Max[R,y+dr1,y+dr2]}}],Graphics[{{GrayLevel[1],Disk[{x,y},Abs[R+Sqrt[x^2+y^2]]]},Circle[{x,y},Abs[R+Sqrt[x^2+y^2]]],Disk[{0,0},R]},AspectRatio->Automatic,PlotRange->{{Min[-R,x-dr1,x-dr2],Max[R,x+dr1,x+dr2]},{Min[-R,y-dr1,y-dr2],Max[R,y+dr1,y+dr2]}}]}]

Two Tangent Circles

FullSimplify[Solve[x^2+y^2==(r+R)^2,r]]

FullSimplify[Solve[x^2+y^2==(r-R)^2,r]]

TangentCircles[R_,{x_,y_}]:=Module[
{
dr1=R+Sqrt[x^2+y^2],
dr2=Abs[R-Sqrt[x^2+y^2]]
},
{
Graphics[{
Disk[{0,0},R],{GrayLevel[1],Disk[{x,y},Abs[ R-Sqrt[x^2+y^2]]]},
Circle[{x,y},Abs[ R-Sqrt[x^2+y^2]]]},
AspectRatio->Automatic,
PlotRange->{{Min[-R,x-dr1,x-dr2],Max[R,x+dr1,x+dr2]},{Min[-R,y-dr1,y-dr2],Max[R,y+dr1,y+dr2]}}
],
Graphics[{
{GrayLevel[1],Disk[{x,y}, Abs[R+Sqrt[x^2+y^2]]]},
Circle[{x,y}, Abs[R+Sqrt[x^2+y^2]]],Disk[{0,0},R]},
AspectRatio->Automatic,
PlotRange->{{Min[-R,x-dr1,x-dr2],Max[R,x+dr1,x+dr2]},{Min[-R,y-dr1,y-dr2],Max[R,y+dr1,y+dr2]}}
]
}
]

Show[GraphicsArray[{
TwoTangentCircles[1,{.4,.4}],
TwoTangentCircles[1,{1.2,1.2}]
}]]

Circles Tangent to Side Extensions of a Triangle (i.e., Excircles)

v={{0,0},{1,0},{.2,.6}};
pts=Flatten[{NinePointCenter[v],"N",
Incenter[v],"I",
Transpose[{Excenters[v],{"(Subscript[J, 1])","(Subscript[J, 2])","(Subscript[J, 3])"}}]}];
Show[Graphics[{{Thickness[.008],Triangle[v]},
{RGBColor[1,0,0],Incircle[v]},
{RGBColor[0,0,1],Excircles[v]},
{Purple,NinePointCircle[v]},
PointLabels[pts]
},AspectRatio->Automatic]]

Three Tangent Circles with Given Centers

t=Triangle[{{0,0},{1,0},{.2,.6}}];
Show[Graphics[{
t,
{Blue,TangentCircles[t]},
(*
{Blue,OuterSoddyCircle[t],InnerSoddyCircle[t]},
*)
{Purple,Incircle[t]},
{Red,ContactTriangle[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,Red]&/@Transpose[{VertexPoints[ContactTriangle[t]],{"(Subscript[C, 1])","(Subscript[C, 2])","(Subscript[C, 3])"}}]
],PointSize[.022],LabelOffset->.055]
},AspectRatio->Automatic]
]

2ExternalSimilitudeCenter@@@Subsets[Circles[TangentCircles],{2}]

NobbsPoints

Incident Centers

Timing[IncidentCenters[KimberlingCenters,CircleEquation[#]]]&/@Circles[TangentCircles]

Radical Circle of Three Tangent Circles = Incircle

Derivation

t=Triangle[{{0,0},{1,0},{.2,.6}}];
TangentCircles[t]

CircleTriplet[{1,0,0},(-a+b+c)/2]

Through[CircleTriplet[{1,0,0},(-a+b+c)/2][t]]

eqns=Symmetrize/@Simplify[Together//@ToSidelengths[CircleEquation/@TangentCircles],TriangleQ[]]

CircleFunction/@eqns

ctr=-Symmetrize/@RadicalCenter[%100,{1,1,1}]

Trilinears[Incenter]

Factor[Together//@(Distance[ctr,CircleCenter[TangentCircles[[1]]]]^2-CircleRadius[TangentCircles[[1]]]^2)]

Symmetrize[Simplify[Together//@ToSidelengths[CircleEquation[Circle[{1,1,1},Sqrt[(-a+b+c)(a+b-c)(a-b+c)/(a+b+c)]/2]]],TriangleQ[]]]

CircleFunction[%111]

InputForm[%113[[1]]]

Center

CircleCenter[TangentCirclesRadicalCircle]

Radius

CircleRadius[TangentCirclesRadicalCircle]

Circle Function

CircleFunction[TangentCirclesRadicalCircle]

Factor[%121]

CircleFunction[Incircle]

IncidentCenters[KimberlingCenters,CyclicTrilinears[CircleFunction[TangentCirclesRadicalCircle]]]//Timing

CenterName[X[220]]

Orthogonality Check

Together//@OrthogonalQ[Circle[TangentCirclesRadicalCircle],#]&/@TangentCircles

Threewise Tangent Circles

Michael Trott
March 26, 2004

newThreeCirclesAndTouchingPoints[{Circle[{xM_,yM_},r_],{Point[{x1_,y1_}],Point[{x2_,y2_}],Point[{x3_,y3_}]}},opts___]:={{Circle[{xM1,yM1},r1],Circle[{xM2,yM2},r2],Circle[{xM3,yM3},r3]},{Point[{xP12,yP12}],Point[{xP13,yP13}],Point[{xP23,yP23}]}}/.FindRoot[{
(x1-xM1)^2+(y1-yM1)^2-r1^2==0,
(x2-xM2)^2+(y2-yM2)^2-r2^2==0,
(x3-xM3)^2+(y3-yM3)^2-r3^2==0,
(xP12-xM1)^2+(yP12-yM1)^2-r1^2==0,
(xP13-xM3)^2+(yP13-yM3)^2-r3^2==0,
(xP23-xM2)^2+(yP23-yM2)^2-r2^2==0,
(xM2-xM1)^2+(yM2-yM1)^2-(r1+r2)^2==0,
(xM3-xM1)^2+(yM3-yM1)^2-(r1+r3)^2==0,
(xM3-xM2)^2+(yM3-yM2)^2-(r2+r3)^2==0,
(x1-xM)(y1-yM1)-(x1-xM1)(y1-yM)==0,
(x2-xM)(y2-yM2)-(x2-xM2)(y2-yM)==0,
(x3-xM)(y3-yM3)-(x3-xM3)(y3-yM)==0,
(xP12-xM1)(yP12-yM2)-(xP12-xM2)(yP12-yM1)==0,(xP13-xM1)(yP13-yM3)-(xP13-xM3)(yP13-yM1)==0,(xP23-xM2)(yP23-yM3)-(xP23-xM3)(yP23-yM2)==0,
1-ζ (r-r1) (r-r2) (r-r3)==0
},{xM1,(x1+xM)/2},{xM2,(x2+xM)/2},{xM3,(x3+xM)/2},{yM1,(y1+yM)/2},{yM2,(y2+yM)/2},{yM3,(y3+yM)/2},{xP12,(x1+x2)/2},{xP13,(x1+x3)/2},{xP23,(x2+x3)/2},{yP12,(y1+y2)/2},{yP13,(y1+y3)/2},{yP23,(y2+y3)/2},{r1,r/2},{r2,r/2},{r3,r/2},{ζ,1},opts]

newThreeCirclesAndPoints[data:{c_,{p1_,p2_,p3_}},opts___]:=({{𝒸1,𝒸2,𝒸3},{𝓅12,𝓅13,𝓅23}}=newThreeCirclesAndTouchingPoints[data,opts];
{{𝒸1,{p1,𝓅12,𝓅13}},{𝒸2,{p2,𝓅12,𝓅23}},{𝒸3,{p3,𝓅13,𝓅23}}})

φ1=2Pi/3;
φ2=-2Pi/3;
NL=NestList[Flatten[newThreeCirclesAndPoints[#,AccuracyGoal->{Automatic,15}]&/@#,1]&,{{Circle[{0,0},1],{Point[{1,0}],Point[{Cos[φ1],Sin[φ1]}],Point[{Cos[φ2],Sin[φ2]}]}}},6];

Show[Graphics[NL],AspectRatio->Automatic]

φ1=Pi/2;
φ2=-2Pi/3;
NL=NestList[Flatten[newThreeCirclesAndPoints[#,AccuracyGoal->{Automatic,15}]&/@#,1]&,{{Circle[{0,0},1],{Point[{1,0}],Point[{Cos[φ1],Sin[φ1]}],Point[{Cos[φ2],Sin[φ2]}]}}},6];
Null

Show[Graphics[NL],AspectRatio->Automatic]

Table

t=Triangle[Table[Random[Real,{0,1},30],{3},{2}]];

Length[pairs=Subsets[CentralCircles,{2}]]

l={};
Do[
Print[{i,pairs[[i]],expr=TimeConstrained[TangentQ@@Through[pairs[[i]][t]],500]//Timing;
If[Last[expr]=!=False,AppendTo[l,{pairs[[i]],Last[expr]}]];expr}],
{i,Length[pairs]}
]

tangent=First/@Select[l,Last[#]===True&]

Function[cc,{cc,Sort[Flatten[Complement[#,{cc}]&/@Select[tangent,MemberQ[#,cc]&]]]}]/@Union[Flatten[tangent]]//ColumnForm

Specific Cases

Incircle, Nine-Point Circle

Simplify[Together//@ExpandAll[Refine[Together//@ToSidelengths[TangentQ[NinePointCircle,Incircle]/.Cos[x_]:>TrigExpand[Cos[x]]],TriangleQ[]]],TriangleQ[]]//Timing

FullSimplify[Together//@ToSidelengths[Solve[{TrilinearEquation[Incircle]==TrilinearEquation[NinePointCircle],2Area[]==(a α+b β+c γ),γ==1},{α,β,γ}]],TriangleQ[]]

Moses Circle, Nine-Point Circle

Simplify[Refine[Together//@ToSidelengths[TangentQ[NinePointCircle,MosesCircle]/.Cos[x_]:>TrigExpand[Cos[x]]],TriangleQ[]],TriangleQ[]]//Timing

Moses Circle, Incircle

Simplify[Factor//@Factor[Together//@TangentQ[Incircle,MosesCircle]/.Cos[x_]:>TrigExpand[Cos[x]]]/.Sqrt[x_]Sqrt[y_]:>FullSimplify[Sqrt[x y],TriangleQ[]],TriangleQ[]]

Figure

t=Triangle[{{0,0},{1,0},{-1,7}/10}]//N[#,10]&;
Show[Graphics[{
t,
{Red,NinePointCircle[t]},
{Green,MosesCircle[t]},
{Blue,Incircle[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{FeuerbachPoint[t],"F",Purple},
{Center[MosesCircle[t]],"(Subscript[X, 39])",{Red}},
{NinePointCenter[t],"N",{Green}},
{Incenter[t],"I",{Blue}}
}
],LabelOffset->.03]
}],AspectRatio->Automatic,PlotRange->All]

Three Tangent Circles on a Line

TangentCirclesOnALine[r1_,r2_]:=Module[{d=Sqrt[r1]+Sqrt[r2],r3,x2=2Sqrt[r1]Sqrt[r2]},r3=r1 r2/d^2;
{Disk[{0,r1},r1],Disk[{x2,r2},r2],Disk[{2r1 Sqrt[r2]/d,r3},r3],Line[{{-r1,0},{x2+r2,0}}]}]

TangentCirclesOnALine::usage="TangentCirclesOnALine[r1,r2] draws a figure of three mutually tangent circles (the outer two of radius r1 and r2) which are also tangent to a line."

Solve[(Subscript[x, 2])^2+((Subscript[r, 1])-(Subscript[r, 2]))^2==((Subscript[r, 1])+(Subscript[r, 2]))^2,(Subscript[x, 2])]

(Subscript[x, 2])=2 (Sqrt[(Subscript[r, 1])]) (Sqrt[(Subscript[r, 2])])

Simplify[Solve[{(Subscript[x, 3])^2+((Subscript[r, 1])-(Subscript[r, 3]))^2==((Subscript[r, 1])+(Subscript[r, 3]))^2,
((Subscript[x, 3])-(Subscript[x, 2]))^2+((Subscript[r, 2])-(Subscript[r, 3]))^2==((Subscript[r, 2])+(Subscript[r, 3]))^2},{(Subscript[x, 3]),(Subscript[r, 3])}]]

Together//@(1/(1/Sqrt[(Subscript[r, 1])]+1/Sqrt[(Subscript[r, 2])])^2)

TangentCirclesOnALine[r1_,r2_]:=Module[{d=Sqrt[r1]+Sqrt[r2],r3,x2=2Sqrt[r1]Sqrt[r2]},
r3=r1 r2/d^2;
{Disk[{0,r1},r1],Disk[{x2,r2},r2],Disk[{2r1 Sqrt[r2]/d,r3},r3],
Line[{{-r1,0},{x2+r2,0}}]}
]

r1=1.;
r2=.7;
pts={{0,r1},"(Subscript[C, 1]) = (0, (Subscript[r, 1]))",
{2Sqrt[r1]Sqrt[r2],r2},"(Subscript[C, 2]) = ((Subscript[x, 2]), (Subscript[r, 2]))",
{2r1 Sqrt[r2]/(Sqrt[r1]+Sqrt[r2]),r1 r2/(Sqrt[r1]+Sqrt[r2])^2},"(Subscript[C, 3]) = ((Subscript[x, 3]), (Subscript[r, 3]))"
};
Show[Graphics[{
TangentCirclesOnALine[1,.7] /. Disk[x__]:>{{GrayLevel[.7],Disk[x]},Circle[x]},
PointLabels[pts]
}],AspectRatio->Automatic]