Incircle

Author

Eric W. Weisstein
December 6, 2004

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

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

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

Angle Bisectors

tri=Triangle[{{0.,0.},{1.3,1.7},{3.,0.}}];
bis[i_]:=AngleBisectors[tri][[i,1,2]];
vert[i_]:=Vertices[tri][[i]];
perpfoot[i_]:=(Perpendicular[Coordinates@Incenter[tri],#]&/@Sides[tri])[[i,1]];
pts={
Incenter,"I",
vert[1],"A",vert[2],"B",vert[3],"C",
};
bluepts={bis[1],"(Subscript[B, A])",bis[2],"(Subscript[B, B])",bis[3],"(Subscript[B, C])"};
redpts={perpfoot[1],"(Subscript[M, A])",perpfoot[2],"(Subscript[M, B])",perpfoot[3],"(Subscript[M, C])"};

Show[Graphics[{
{Red,
Line@Perpendicular[Coordinates@Incenter[tri],#]&/@Sides[tri],
PerpSquare[{#,Perpendicular[Coordinates@Incenter[tri],#]},.1,3]&/@Sides[tri]
},
{Thickness[.01],Incircle[tri]},
{
Blue,
Line[{Coordinates@Incenter[tri],#}]&/@Vertices[tri],
EqualAngleTicksAboutBisectors[tri,.2,.05,.07],
VertexArcs[tri,.2]
},
tri,
PointLabels[tri,pts],
{Red,PointLabels[tri,redpts]}
  }],
  AspectRatio->Automatic,PlotRange->All]

Right Angle Theorem

tri={{0,0},{1,0},{.2,.5}};
i=Incenter[tri][[1]];
c=ContactTriangle[tri][[1]][[{1,2}]];
p=LineLineIntersection[{tri[[3]],i},c];
l={
		Incenter[tri],"I",
		tri[[1]],"A",tri[[2]],"B",tri[[3]],"C",
		c[[1]],"(Subscript[T, A])",c[[2]],"(Subscript[T, B])",p,"P"
};
{pts,str}=Transpose[Partition[l,2]] /. Point->Identity;
Show[Graphics[{
			{Thickness[.01],Triangle[tri]},
			Incircle[tri],
			{PointSize[.02],Point/@pts},
			Line[c],Line[{tri[[3]],p}],Line[{tri[[1]],p}],
				Table[Text[str[[i]],pts[[i]]+{.03,.03}],{i,Length[pts]}]
			}],
	AspectRatio->Automatic]

Circle Equation

From Kimberling

Expand[CircleEquation[{l,m,n},k]]==Plus@@CyclicTrilinears[(α^2)Cos[A/2]^4-2β γ Cos[B/2]^2Cos[C/2]^2]

CircleEquation[Incircle]

FullSimplify[DistanceTrilinears[CircleEquation[Incenter,Inradius[]]],TriangleQ[]]

eqn=((((a (a-b-c) α+b (a-b+c) β))^2)+2 (a+b-c) c (a (a-b-c) α-b (a-b+c) β) γ+(((a+b-c))^2) (c^2) (γ^2));

FullSimplify[Coefficient[eqn,#]&/@{α^2,β^2,γ^2,α β,α γ,β γ}]

Center

Coefficient[CircleEquation[{l,m,n},k],#]&/@{α β,α γ,β γ,α^2}

eqn=(α^2) ((Cos[(A/2)])^4)-2 α β ((Cos[(A/2)])^2) ((Cos[(B/2)])^2)+(β^2) ((Cos[(B/2)])^4)-2 α γ ((Cos[(A/2)])^2) ((Cos[(C/2)])^2)-2 β γ ((Cos[(B/2)])^2) ((Cos[(C/2)])^2)+(γ^2) ((Cos[(C/2)])^4);

soln=Solve[{
c k+b l+a m==Coefficient[eqn,α β],
b k+c l+a n==Coefficient[eqn,α γ],
a k+c m+b n==Coefficient[eqn,β γ],
a l ==Coefficient[eqn,α^2]},{l,m,n,k}][[1]]

FullSimplify[l/k/.soln,TriangleQ[]]

FullSimplify[DistanceTrilinears[(b+c+c Cos[B]+b Cos[C])]]

FullSimplify[Together//@DistanceTrilinears[TrigExpand[TrigReduce[-((((a^2)-(b^2)-(c^2)) ((Cos[(A/2)])^4))/(-2 b c ((Cos[(A/2)])^4)+2 (a^2) ((Cos[(B/2)])^2) ((Cos[(C/2)])^2)-a ((Cos[(A/2)])^2) (a+b+c)))]]]]

Circle Function

IncidentCenters[KimberlingCenters,CyclicTrilinears[CircleFunction[Incircle]]]

Through[{CenterName,CenterFunction}[X[220]]]

FullSimplify[DistanceTrilinears[((Cos[(A/2)])^2) Cot[(A/2)]],TriangleQ[]]

Circle Center

FullSimplify[Together//@DistanceTrilinears[CircleCenter[CyclicTrilinears[-((((-a+b+c))^2)/(4 b c))]]]]

Radius

FullSimplify[Together//@DistanceTrilinears[CircleRadius[CyclicTrilinears[-((((-a+b+c))^2)/(4 b c))]]],TriangleQ[]]

Simplify[%^2-Inradius[]^2]

Incident Points

<<MathWorld KimberlingCenters`

(ctrs=IncidentCenters[KimberlingCenters,CircleEquation[Incircle]])//Timing

{#,CenterName[#]}&/@ctrs//TableForm

c given a, b, r

SetOptions[Roots,Cubics->False]

Simplify[Solve[r==Sqrt[(s-a)(s-b)(s-c)/s] /. s->(a+b+c)/2,c]]

FullSimplify[ToRadicals[%]]

Altitude

Solve[{Tan[t1]==h/x1,Tan[t2]==h/(d-x1)},{h,x1}]

Incircle

Solve[{Tan[t1/2]==a/x1,Tan[t2/2]==a/(d-x1)},{x1,a}]

IncirclePlot[t1_,t2_,d_]:=Module[
		{
		tan1=Tan[t1/2],
		tan2=Tan[t2/2],
			x1,a,xh,h
		},
	x1=d tan2/(tan1+tan2);
		a=d tan1 tan2/(tan1+tan2);
		h=d Tan[t1]Tan[t2]/(Tan[t1]+Tan[t2]);
		xh=d Tan[t2]/(Tan[t1]+Tan[t2]);
	Show[Graphics[{
					Line[{{0,0},{d,0},{xh,h},{0,0}}],
					Circle[{x1,a},a]
					}],AspectRatio->Automatic]
	]

IncirclePlot[.7,1.6,2.]

2 Equal Incircles, Solving for Angles and Lengths

Solve[{
		x1==Tan[t12/2]d1/(Tan[t11/2]+Tan[t12/2]),
		x2==Tan[t22/2]d2/(Tan[t21/2]+Tan[t22/2]),
		a==Tan[t11/2]Tan[t12/2]d1/(Tan[t11/2]+Tan[t12/2]),
		a==Tan[t21/2]Tan[t22/2]d2/(Tan[t21/2]+Tan[t22/2]),
		d==d1+d2,
			t12+t21==Pi,
			h==d1 Tan[t11]Tan[t12]/(Tan[t11]+Tan[t12]),
		h==d2 Tan[t21]Tan[t22]/(Tan[t21]+Tan[t22])},
	{x1,x2,a,d1,d2},{h,t12,t21}
]

2 Equal Incircles, Solving for Lengths only

s[a_,b_,c_]:=(a+b+c)/2
d1=Sqrt[c^2+b1^2-b1/b(b^2+c^2-a^2)];
Solve[{r^2==(s[c,b1,d1]-c)(s[c,b1,d1]-b1)(s[c,b1,d1]-d1)/s[c,b1,d1],
		r^2==(s[a,b-b1,d1]-a)(s[a,b-b1,d1]-(b-b1))(s[a,b-b1,d1]-d1)/s[a,b-b1,d1]},
	{r,b1}]

Incircles2[t11_,t22_,d_]:=Module[{soln,
		h=d Tan[t11]Tan[t22]/(Tan[t11]+Tan[t22]),
		xh=d Tan[t22]/(Tan[t11]+Tan[t22])
},
soln=FindRoot[{
		x1==Tan[t12/2]d1/(Tan[t11/2]+Tan[t12/2]),
		x2==Tan[t22/2]d2/(Tan[t21/2]+Tan[t22/2]),
		a==Tan[t11/2]Tan[t12/2]d1/(Tan[t11/2]+Tan[t12/2]),
		a==Tan[t21/2]Tan[t22/2]d2/(Tan[t21/2]+Tan[t22/2]),
		d==d1+d2,
			t12+t21==Pi,
			d1 Tan[t11]Tan[t12]/(Tan[t11]+Tan[t12])==d2 Tan[t21]Tan[t22]/(Tan[t21]+Tan[t22])},
			{x1,.1,.5},{x2,.1,.5},{d1,.1,.5},{d2,.1,.5},{t12,.1,.5},{t21,.1,.5},{a,.1,.5},
		MaxIterations->5000];
	Show[Graphics[{
					{Thickness[.007],Line[{{0,0},{d,0},{xh,h},{0,0}}],
					Line[{{xh,h},{d1,0}}]},
					Circle[{x1,a},a],
					Circle[{d1+x2,a},a],
					Line[{{0,0},{x1,a},{d1,0}}],
						Line[{{d1,0},{d1+x2,a},{d,0}}],
					{Dashing[{.01,.01}],
						Line[{{d1+x2,0},{d1+x2,a}}],
					Line[{x1{Cos[t11],Sin[t11]},{x1,a},{x1,a}+a{Sin[Pi-t12],-Cos[Pi-t12]}}],
						Line[{{x1,a},{x1,0}}],
						Line[{{d1+x2,a},{d1+x2,a}-a{Sin[Pi-t21],Cos[Pi-t21]}}],
							Line[{{d1+x2,a},{d-(d2-x2) Cos[t22],(d2-x2)Sin[t22]}}]}
					} /. soln],AspectRatio->Automatic,PlotRange->All]
]

Incircles2[.5,.85,1.]

Incircles2[1.6,.4,1.]

vars=Flatten[{Table[x[i],{i,n}],
	Table[d[i],{i,n}],
	Flatten[Table[t[i,j],{i,2,n-1},{j,2}],1],t[1,2],t[n,1],h,a}];

soln=Flatten[{Table[{.2,.3},{3}],Table[{.2,.3},{3}],
	Table[{.4,.5},{4}],{{1.,1.1},{.2,.3}}},1]

Incircles[3,{1.6,.8,1.},soln]

n=4;
var=Flatten[{Table[x[i],{i,n}],
	Table[d[i],{i,n}],
	Flatten[Table[t[i,j],{i,2,n-1},{j,2}],1],
	t[1,2],t[n,1],h,a}]

Incircles[n_,{t11_,tn2_,dd_},s0_:{}]:=Module[{soln,t,d,
			x,i,j,a,h,vars,s,
		xh=dd Tan[tn2]/(Tan[t11]+Tan[tn2])
},
		s=If[s0=={},Table[{.1,.5},{4n}],s0];
		t[1,1]=t11;
		t[n,2]=tn2;
		d[0]=0;
	vars=Flatten[{Table[x[i],{i,n}],
	Table[d[i],{i,n}],
	Flatten[Table[t[i,j],{i,2,n-1},{j,2}],1],t[1,2],t[n,1],h,a}];
soln=FindRoot[Evaluate[Flatten[{
Table[x[i]==Tan[t[i,2]/2]d[i]/(Tan[t[i,1]/2]+Tan[t[i,2]/2]),{i,n}],
		Table[a==Tan[t[i,1]/2]Tan[t[i,2]/2]d[i]/(Tan[t[i,1]/2]+Tan[t[i,2]/2]),{i,n}],
					Table[h==d[i] Tan[t[i,1]]Tan[t[i,2]]/(Tan[t[i,1]]+Tan[t[i,2]]),{i,n}],
		dd==Sum[d[i],{i,n}],
			Table[t[i,2]+t[i+1,1]==Pi,{i,n-1}]},1]],
		Evaluate[Sequence@@(Table[{vars[[i]],s[[i]]}//Flatten,{i,4n}])],
		MaxIterations->5000,DampingFactor->2];
		Print[soln];
	Show[Graphics[{
					Line[{{0,0},{dd,0},{xh,h},{0,0}}],
					Table[Line[{{xh,h},{d[i],0}}],{i,0,n-1}],
					Table[Circle[{d[i-1]+x[i],a},a],{i,n}]
					} /. soln],AspectRatio->Automatic]
]

Tangent Circles

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

t=Triangle[{{0,0},{1,0},{.3,.5}}];
Show[Graphics[{
t,
{Red,Incircle[t]},
{Blue,NinePointCircle[t]},
PointLabels[{
Sequence@@Transpose[{VertexPoints[t],{"A","B","C"}}],
{Incenter[t],"I",Red},
{NinePointCenter[t],"N",Blue}
},LabelOffset->{.04,-1}.04]
}],AspectRatio->Automatic,PlotRange->All]