Rigby Points

Author

Eric W. Weisstein
May 19, 2003

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

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

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

Initialization

<<PlaneGeometry`;
<<KimberlingCenters`;

Oldknow's Rigby Point

Figure

t=Triangle[{{0,0},{1,0},{.4,.7}}];
s1=InnerSoddyTriangle[t];
s2=OuterSoddyTriangle[t];

t1=TangentialTriangle[s1];
t2=TangentialTriangle[s2];

Show[GraphicsArray[{
Graphics[{
t,
{Red,t1},
{Blue,s1},
{Orange,Line/@Transpose[Vertices/@{t1,s1}]},
{Green,TangentCircles[t]},
{Green,SoddyCircles[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{VertexPoints[s1],{"P","Q","R"}}],
Append[#,Red]&/@Transpose[{VertexPoints[t1],{"X","Y","Z"}}],
{
{InnerRigbyPoint[t],"Ri",Orange}
}
],LabelOffset->.03,PointSize[.025]]
},
AspectRatio->Automatic],
Graphics[{
t,
{Red,t2},
{Blue,s2},
{Orange,Line/@Transpose[Vertices/@{t2,s2}]},
{Green,TangentCircles[t]},
{Green,SoddyCircles[t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{VertexPoints[s2],{"P'","Q'","R'"}}],
Append[#,Red]&/@Transpose[{VertexPoints[t2],{"X'","Y'","Z'"}}],
{
{OuterRigbyPoint[t],"Ri'",Orange}
}
],LabelOffset->.07,PointSize[.025]]
},
AspectRatio->Automatic]
}]]

Trilinears

FullSimplify[{1,1,1}+4Area[]/{a(s-a),b(s-b),c(s-c)}/.s->Semiperimeter[]/.(Sqrt[(a+b-c) (a-b+c) (-a+b+c) (a+b+c)])->4Δ]

CenterFunction/@{InnerRigbyPoint,OuterRigbyPoint}

BisymmetricQ/@{InnerRigbyPoint,OuterRigbyPoint}

IncidentCenters[KimberlingCenters,#]&/@{InnerRigbyPoint,OuterRigbyPoint}

Honsberger's Rigby Point

tri={{0.,0.},{1.,.7},{1.6,-.9}};

a={.2,2.3};
circ={Circumcenter[tri][[1]],Circumradius[tri]};
c=Chord[circ,a];
AppendTo[a,SimsonLinePoleAngle[tri,c[[1]]]];
pqr=Table[CircumcirclePoint[tri,a[[addn[i,2,3]]]],{i,3}] /. Point->Identity;
spqr=Table[SimsonLinePoints[tri,a[[addn[i,2,3]]]],{i,3}];
r=RigbyPoint[tri,a[[{1,2}]]];
range={{-.5,2.5},{-1.3,1.6}};

pts=Table[{Circumcenter,"O",r,"X",
		pqr[[1]],"P",pqr[[2]],"Q",pqr[[3]],"R",
		spqr[[i,1]],"",spqr[[i,2]],"",spqr[[i,3]],"",
	tri[[1]],"A",tri[[2]],"B",tri[[3]],"C"},{i,3}];

abca=Table[ArcTan@@(tri[[i]]-circ[[1]]),{i,3}];
sabc=Table[SimsonLinePoints[pqr,abca[[addn[i,2,3]]]],{i,3}];
ptsabc=Table[{Circumcenter,"O",r,"X",
		pqr[[1]],"P",pqr[[2]],"Q",pqr[[3]],"R",
		sabc[[i,1]],"",sabc[[i,2]],"",sabc[[i,3]],"",
	tri[[1]],"A",tri[[2]],"B",tri[[3]],"C"},{i,3}];

Show[GraphicsArray[
{Table[
Show[Graphics[{
			Triangle[tri],
			Circle@@circ,
			SimsonLine[tri,a[[addn[i,2,3]]],2],
		  {GrayLevel[.5],Chord[circ,a[[{i,addn[i,1,3]}]]]},
			PointLabels[tri,pts[[i]],.035],
			PerpSquare[{
										Chord[circ,a[[{i,addn[i,1,3]}]]],
										SimsonLine[tri,a[[addn[i,2,3]]],2]} /. Line->Identity,
								.12,3],
			{Dashing[{.02,.02}],SimsonLineFeet[tri,a[[addn[i,2,3]]]]}
			}],AspectRatio->Automatic,PlotRange->range,
			DisplayFunction->Identity],
			{i,3}],
		Table[
Show[Graphics[{
			Triangle[pqr],
			Circle@@circ,
			SimsonLine[pqr,abca[[addn[i,2,3]]],2],
		  {GrayLevel[.5],Chord[circ,abca[[{i,addn[i,1,3]}]]]},
			PointLabels[pqr,ptsabc[[i]],.035],
			PerpSquare[{
										Chord[circ,abca[[{i,addn[i,1,3]}]]],
										SimsonLine[pqr,abca[[addn[i,2,3]]],2]} /. Line->Identity,
								.12,3],
			{Dashing[{.02,.02}],SimsonLineFeet[pqr,abca[[addn[i,2,3]]]]}
			}],AspectRatio->Automatic,PlotRange->range,
			DisplayFunction->Identity],
			{i,3}]
		}]]

tri={{0.,0.},{1.,.6},{1.6,-.9}};
a={.2,2.3};
circ={Circumcenter[tri][[1]],Circumradius[tri]};
c=Chord[circ,a];
AppendTo[a,SimsonLinePoleAngle[tri,c[[1]]]];
pqr=Table[CircumcirclePoint[tri,a[[addn[i,2,3]]]],{i,3}] /. Point->Identity;
spqr=Table[SimsonLinePoints[tri,a[[addn[i,2,3]]]],{i,3}];

abca=Table[ArcTan@@(tri[[i]]-circ[[1]]),{i,3}];
sabc=Table[SimsonLinePoints[pqr,abca[[addn[i,2,3]]]],{i,3}];

range={{-.5,2.5},{-1.3,1.6}};
r=RigbyPoint[tri,a[[{1,2}]]];

pts={Circumcenter,"O",r,"X",
	tri[[1]],"A",tri[[2]],"B",tri[[3]],"C"};

pts2={pqr[[1]],"P",pqr[[2]],"Q",pqr[[3]],"R"};

Show[Graphics[{
			{GrayLevel[.5],PointLabels[tri,pts2,.025]},
			Circle@@circ,
			{Thickness[.008],Triangle[tri],{GrayLevel[.5],Triangle[pqr]}},
			Table[SimsonLine[tri,a[[i]],1],{i,3}],
			{GrayLevel[.5],Table[SimsonLine[pqr,abca[[i]],1],{i,3}]},
						PointLabels[tri,pts,.025]
			}],AspectRatio->Automatic]