Outer Inscribed Squares Triangle

Author

Eric W. Weisstein
November 8, 2005

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

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

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

Figure

p1={((2Area+ a c Cos[B])/a),c Cos[A],-c};
p2={c Cos[B],((2Area+b c Cos[A])/b),-c};
{q1,q2}=Factor[Intersections[Line[#,{0,0,1}],Line[{1,0,0},{0,1,0}]]]&/@{p1,p2};
{l1,l2}=Simplify[PerpendicularLine[TrilinearLine[Line[{1,0,0},{0,1,0}]],#]]&/@{q1,q2};
x1=Intersections[l1,TrilinearLine[Line[{1,0,0},{0,0,1}]]];
x2=-Intersections[l2,TrilinearLine[Line[{0,1,0},{0,0,1}]]];

bigsquares=NestList[RotateRight/@(#/.{a->b,b->c,c->a,A->B,B->C,C->A})&,{{1,0,0},{0,1,0},p2,p1,{1,0,0}},2];

littlesquares=NestList[RotateRight/@(#/.{a->b,b->c,c->a,A->B,B->C,C->A})&,{q1,q2,x2,x1,q1},2];

t=Triangle[{{0,0},{1,0},{.3,.7}}];
g1=Show[Graphics[{
t,
{Red,Line[Cartesian[#[t]][[1]]&/@#]&/@littlesquares[[{1}]]},
{Blue,Line[Cartesian[#[t]][[1]]&/@#]&/@bigsquares[[{1}]]},
{
Green,
Line[Cartesian[#[t]][[1]]&/@{p1,q1,{0,0,1},q2,p2}]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"B","C","A"}}],
{
{Cartesian[p1[t]],"(Subscript[S, AB])",Blue},
{Cartesian[p2[t]],"(Subscript[S, AC])",Blue},
{Cartesian[q1[t]],"(Subscript[Q, A, BC])",Red},
{Cartesian[q2[t]],"(Subscript[Q, A, CB])",Red},
{Cartesian[x1[t]],"(Subscript[Q, AB])",Red},
{Cartesian[x2[t]],"(Subscript[Q, AC])",Red},
{Cartesian[{(SB+S)/a,(SA+S)/b,c}[t]],"(SuperMinus[X])",Red}
}
],LabelOffset->.05,PointSize[.035]]
}],AspectRatio->Automatic,PlotRange->All]

t=Triangle[{{0,0},{1,0},{.3,.7}}];
g2=Show[Graphics[{
{Green,Line[Cartesian[#[t]][[1]]&/@#]&/@bigsquares},
{Blue,Line[Cartesian[#[t]][[1]]&/@#]&/@littlesquares},
t,
{Red,InscribedSquaresTriangle[1][t]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{VertexPoints[InscribedSquaresTriangle[2][t]],{"(SuperPlus[X])","(SuperPlus[Y])","(SuperPlus[Z])"},LabelOffset->#&/@{{.05,.05},{-.06,0},{0,-.07}}}]
],LabelOffset->.05,PointSize[.03]]
}],AspectRatio->Automatic,PlotRange->{{-.1,1.2},{-.1,.9}}]

Show[GraphicsArray[{g1,g2}]]

Factor[Perspector[ReferenceTriangle,InscribedSquaresTriangle]]

IncidentCenters[Take[KimberlingCenters,{450,500}],%47]

CenterName[X[485]]

FullSimplify[Factor[ToSidelengths[Midpoint/@{{q1,x2},{q2,x1}}]],TriangleQ[]]

Factor[Refine[Nest[ToAngles,%8,2],Area>0]]

Factor[-(1/((2 Area+(c^2)) Cos[B])){-(((2 Area+(c^2)) Cos[B] (2 Area+a c Cos[B]))/a),-(((2 Area+(c^2)) (2 Area+b c Cos[A]) Cos[B])/b),-c (2 Area+(c^2)) Cos[B]}]

Refine[ToAngles[ToSidelengths[{(S+SB)/a,(S+SA)/b,c}]],Area>0]

{{a,(S+SC)/b,(S+SB)/c},{(S+SC)/a,b,(S+SA)/c},{(S+SB)/a,(S+SA)/b,c}}

Trilinear Vertex Matrix

TriangleName[InscribedSquaresTriangle[2]]

TrilinearVertexMatrix[InscribedSquaresTriangle[2]]//TraditionalForm

Area

Factor[Area[InscribedSquaresTriangle[2]]]

FullSimplify[Factor[ToSidelengths[%]],TriangleQ[]]

Factor[Refine[ToAngles[%],TriangleQ[]&&Area>0]]

%12//TraditionalForm

Side Lengths

FullSimplify[Sqrt[FullSimplify[ToSidelengths[Factor[SideLengths[InscribedSquaresTriangle[2]]^2]],TriangleQ[]]],TriangleQ[]]

Refine[ToAngles[%25],Area>0&&TriangleQ[]]

%30

%30//ColumnForm//TraditionalForm

f=Factor[Coefficient[eqn=((b^2)+(c^2)-4 Δ) (a^4)-2 ((((b^2)-(c^2)))^2) (a^2)+((((b^2)-(c^2)))^2) ((b^2)+(c^2)+4 Δ),Δ]]

Factor[eqn-Δ f]

ToAngles[%]

Centers

(pts={#,KimberlingLookup[#[InscribedSquaresTriangle[2]]]}&/@Take[KimberlingCenters,100]);//Timing

{#[[1]],Name[#[[1]]],X[#[[2,1]]],Name[X[#[[2,1]]]]}&/@Cases[pts,_?(Last[#]=!={}&)]//TableForm