Incenter

Author

Eric W. Weisstein
March 5, 2008

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

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

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

Angle Bisctors

t=Triangle[{{0,0},{1,0},{.3,.5}}];
Show[Graphics[{
t,
{Red,AngleBisectors[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{{Incenter[t],"I",Red}}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]

Manipulate

Incenter[p1:{x1_,y1_},p2:{x2_,y2_},p3:{x3_,y3_}]:=Module[{a=Norm[p2-p3],b=Norm[p3-p1],c=Norm[p1-p2]},
Point[Transpose[{p1,p2,p3}].{a,b,c}/(a+b+c)]
]

Incircle[p1:{x1_,y1_},p2:{x2_,y2_},p3:{x3_,y3_}]:=Module[{a=Norm[p2-p3],b=Norm[p3-p1],c=Norm[p1-p2],center,radius},
(*center={a x1+b x2+c x3,a y1+b y2+c y3}/(a+b+c);*)
center=Transpose[{p1,p2,p3}].{a,b,c}/(a+b+c);
radius=Sqrt[(b+c-a)(c+a-b)(a+b-c)/(a+b+c)]/2;
Circle[center,radius]
]

Manipulate[Graphics[{
{Red,Incircle[p1,p2,p3],PointSize[.02],Incenter[p1,p2,p3]},
Line[{p1,p2,p3,p1}]},
PlotRange->1.5],{{p1,{0,0}},{-1,-1},{1,1},ControlType->Locator},{{p2,{1,0}},{-1,-1},{1,1},ControlType->Locator},{{p3,{0,1}},{-1,-1},{1,1},ControlType->Locator}]

Distances

ICl

FullSimplify[ToSidelengths[Distance[Incenter,ClawsonPoint]^2],TriangleQ[]]

Factor[%]

ToAngles[%]

IF

FullSimplify[Together//@ToSidelengths[Distance[Incenter,FeuerbachPoint]^2/.Cos[x_]:>TrigExpand[Cos[x]]],TriangleQ[]]

ToAngles[%]

IG

FullSimplify[ToSidelengths[Distance[Incenter,Centroid]^2],TriangleQ[]]

Factor[%]

ToAngles[%]

IGe

Factor[Distance[Incenter,GergonnePoint]^2]

ToAngles[%]

IH

Factor[FullSimplify[ToSidelengths[Distance[Incenter,Orthocenter]],TriangleQ]^2]

ToAngles[%]

ToAngles[Factor[ToSidelengths[2(Inradius^2)+4(Circumradius^2)-(1/2)((a^2)+(b^2)+(c^2))]]]

IK

Factor//@FullSimplify[Factor[FullSimplify[ToSidelengths[Distance[Incenter,SymmedianPoint]],TriangleQ[]]^2],TriangleQ[]]

ToAngles[%]

IL

Factor[FullSimplify[ToSidelengths[Distance[Incenter,DeLongchampsPoint]^2],TriangleQ[]]]

ToAngles[%]

IM

Factor[Together//@ToSidelengths[Distance[Incenter,Mittenpunkt]^2]]

ToAngles[%]

IO

Factor[FullSimplify[ToSidelengths[Distance[Circumcenter,Incenter]],TriangleQ]^2]

ToAngles[%]

INa

Factor[Together//@ToSidelengths[Distance[Incenter,NagelPoint]^2]]

ToAngles[%]

INi

Factor[Simplify[ToSidelengths[Distance[Incenter,NinePointCenter]^2/.Cos[x_]:>TrigExpand[Cos[x]]],TriangleQ[]]]

ToAngles[%]

ISp

Factor[Together//@ToSidelengths[Distance[Incenter,SpiekerCenter]^2]]

ToAngles[%]

Of Named Triangles

General Triangle

Incenter[Triangle[{{p1,q1,r1},{p2,q2,r2},{p3,q3,r3}}]]

Simplify[%]

Simplify[ToSidelengths[%]]

Named Triangles

t=RandomTriangle[20];

rules=Join[Thread[{a,b,c}->SideLengths[Evaluate[t]]],Thread[{A,B,C}->Angles[Evaluate[t]]]];
kc=KimberlingCenters;

Length[k=Rest[#]/First[#]&/@((Trilinears/@KimberlingCenters)/.TriangleRules/.rules)]//Timing

trips=Triangles;

search::zero="Bad zero encountered `1`";
l={};
Do[
Print[l0={
i,
trips[[i]],
rc=Incenter[trips[[i]]]/.TriangleRules/.rules;
(
pt=Switch[rc,
_?(#=={0,0,0}&),{0,0,0},
Or@@Thread[#==0]&,Message[search:zero,#];rc,
_,Rest[rc]/First[rc]
];
If[pt=={0,0,0},{0},
If[#=={},{},kc[[#]]]&[Flatten[Position[k,_?(#==pt&)]]]
]
)//Timing
}];
AppendTo[l,l0],
{i,Length[trips]}
]

Not in Kimberling

#[[2]]&/@Cases[l,_?(#[[-1,-1]]=={}&)]

Table

{Name[#[[2]]],#[[-1,-1,1]],Name[#[[-1,-1,1]]]}&/@DeleteCases[l,_?(#[[-1,-1]]=={}&)]//TableForm

Structures Passing through It

pt=Incenter;

Circles

First/@Select[{#,IncidentCenters[{pt},#]}&/@Circles,Last[#]=!={}&]

Circle Centers

First/@Select[{#,IncidentCenters[{pt},CircleCenter[#]]}&/@Circles,Last[#]=!={}&]

Conics

First/@Select[{#,IncidentCenters[{pt},#]}&/@Conics,Last[#]=!={}&]

Cubics

First/@Select[{#,IncidentCenters[{pt},#]}&/@TriangleCubics,Last[#]=!={}&]

Lines

First/@Select[{#,IncidentCenters[{pt},#]}&/@Lines,Last[#]=!={}&]

Related to Altitudes

t=Triangle[{{0,0},{1,0},{.2,.7}}];
h=OrthicTriangle[t];
Show[Graphics[{
t,
{Red,h},
{Blue,Incircle[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,Red]&/@Transpose[{VertexPoints[h],{"(Subscript[H, 1])","(Subscript[H, 2])","(Subscript[H, 3])"}}],
{{Incenter[t],"I",Blue}}
],LabelOffset->.03]
}],
AspectRatio->Automatic]