Triangle Square Inscribing

Author

Eric W. Weisstein
February 10, 2005

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

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

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

Code

TriangleInscribedSquare::usage="TriangleInscribedSquare[triangle] gives the construction of a square inscribed in a triangle (Casey 1888, pp. 10-11)."

TriangleInscribedSquares::usage="TriangleInscribedSquares[triangle] gives the three squares inscribed in a triangle."

TriangleInscribedSquare[tri_List]:=Module[{a,b,c,d,e,f,g,h,i,j,k},a=tri[[1]];b=tri[[3]];c=tri[[2]];
d=PerpendicularLine[c,{a,b}][[1]];
e=b+d-a;
f=AngleBisectors[{c,d,e}][[2,1,2]];
h=Intersections[Line@{a,c},Line@{f,f+b-a}];
g=Intersections[Line@{f,h},Line@{b,c}];
i=PerpendicularLine[g,{a,b}][[1]];
j=PerpendicularLine[h,{a,b}][[1]];
k=PerpendicularLine[f,{a,b}][[1]];
l=Intersections[Line@{h,f},Line@{c,d}];
Graphics[{{Thickness[.01],Triangle[tri]},{Thickness[.007],Line[{i,g,h,j}]},Line[{d,c}],Line[{b,e,c}],Line[{d,f}],Line[{k,f,g}],Text["A",a],Text["B",b],Text["C",c],Text["D",d],Text["E",e],Text["F",f],Text["G",g],Text["H",h],Text["I",i],Text["J",j],Text["K",k],Text["L",l]}]]

TriangleInscribedSquares[tri_List]:=Module[{a,b,c,d,e,f,g,h,i,j,ii},a=tri[[{1,1,3}]];
b=tri[[{2,3,2}]];
c=tri[[{3,2,1}]];
d=Table[PerpendicularLine[c[[ii]],{a[[ii]],b[[ii]]}][[1]],{ii,3}];
e=Table[b[[ii]]+d[[ii]]-a[[ii]],{ii,3}];
f=Table[AngleBisectors[{c[[ii]],d[[ii]],e[[ii]]}][[2,1,2]],{ii,3}];
h=Table[Intersections[Line@{a[[ii]],c[[ii]]},Line@{f[[ii]],f[[ii]]+b[[ii]]-a[[ii]]}],{ii,3}];
g=Table[Intersections[Line@{f[[ii]],h[[ii]]},Line@{b[[ii]],c[[ii]]}],{ii,3}];
i=Table[PerpendicularLine[g[[ii]],{a[[ii]],b[[ii]]}][[1]],{ii,3}];
j=Table[PerpendicularLine[h[[ii]],{a[[ii]],b[[ii]]}][[1]],{ii,3}];
Table[ClosedLine[{i[[ii]],g[[ii]],h[[ii]],j[[ii]]}],{ii,3}]]

Casey

tri={{{0.,-.3},{1.3,1.7},{3.,-.7}},
		{{0.,-.3},{3.,-.7},{1.3,1.7}},
		{{3.,-.7},{0.,-.3},{1.3,1.7}}};
Show[GraphicsArray[{
			Table[
Show[TriangleInscribedSquare[tri[[i]]],PlotRange->{{-.8,4.2},{-1.5,3.8}},
	AspectRatio->Automatic,DisplayFunction->Identity],{i,3}]
		}]]

Erected Externally

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[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}}

Side Lengths of Inscribed Squares

FullSimplify[Together//@ToSidelengths[Distance@@@Partition[#,2,1]&/@bigsquares],TriangleQ[]]

FullSimplify[Together//@ToSidelengths[Distance@@@Partition[#,2,1]&/@littlesquares],TriangleQ[]]

Internally Externally

p1={((-2Area+ a c Cos[B])/a),c Cos[A],-c};
p2={c Cos[B],((-2Area+b c Cos[A])/b),-c};

ac=Intersections[Line[p2,{0,0,1}],Line[{0,1,0},{1,0,0}]]

ab=Intersections[Line[p1,{0,0,1}],Line[{0,1,0},{1,0,0}]]

l=PowerExpand[Sqrt[Factor[Distance[ac,ab]^2]]]

ca=Factor/@ToSidelengths[{α,β,γ}/.Solve[{Distance[{α,β,γ},ab]^2==l^2,Distance[{α,β,γ},ac]^2==2l^2,a α+b β+c γ==2Area},{α,β,γ}]];

ba=Factor/@ToSidelengths[{α,β,γ}/.Solve[{Distance[{α,β,γ},ac]^2==l^2,Distance[{α,β,γ},ab]^2==2l^2,a α+b β+c γ==2Area},{α,β,γ}]];

t=Triangle[{{0,0},{1,0},{.2,.7}}];
g1=Show[Graphics[{
{Green,
Cartesian[#[t]]&/@{Line[ac,p2],Line[p1,ab],Line[ba[[1]],{0,1,0}],Line[{1,0,0},ca[[1]]]}
},
t,
{Blue,ErectPolygons[t,4,-1][[3]]},
{Red,
Line[Coordinates[Cartesian[#[t]]]&/@{ac,ab,ca[[1]],ba[[1]],ac}]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{Cartesian[p1[t]],"(Subscript[P, 1])",Blue},
{Cartesian[p2[t]],"(Subscript[P, 2])",Blue},
{Cartesian[ac[t]],"\!\(
\*InterpretationBox[\(A\_C\%\(\"\<-\>\"\)\),\nSubsuperscript[ A, C, \"-\"],\nEditable->False]\)",Red},
{Cartesian[ab[t]],"\!\(
\*InterpretationBox[\(A\_B\%\(\"\<-\>\"\)\),\nSubsuperscript[ A, B, \"-\"],\nEditable->False]\)",Red},
{Cartesian[ca[[1]][t]],"\!\(
\*InterpretationBox[\(C\_a\%\(\"\<-\>\"\)\),\nSubsuperscript[ C, a, \"-\"],\nEditable->False]\)",Red},
{Cartesian[ba[[1]][t]],"\!\(
\*InterpretationBox[\(B\_a\%\(\"\<-\>\"\)\),\nSubsuperscript[ B, a, \"-\"],\nEditable->False]\)",Red},
{Cartesian[{(SB-S)/a,(SA-S)/b,c}[t]],"(SuperMinus[Z])",Red}
}
]]
}],AspectRatio->Automatic,PlotRange->All]

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

bigsquares=NestList[RotateRight/@(#/.{a->b,b->c,c->a,A->B,B->C,C->A})&,{ac,ab,ca[[1]],ba[[1]],ac},2];

littlesquares=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];

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

Show[GraphicsArray[{g1,g2}],ImageSize->500]

persp=Factor[Perspector[ReferenceTriangle,InscribedSquaresTriangle[2]]]

IncidentCenters[Take[KimberlingCenters,{450,500}],persp]

TriangleName[InscribedSquaresTriangle[2]]

Perspector of Triangles

ToAngles[((a b c)/(16 (Area^2) ((a^2)+(b^2)-(c^2))))Factor[ToSidelengths[Factor[Perspector@@(InscribedSquaresTriangle/@{1,2})]]]]

Trilinears[SymmedianPoint]