Quadrilateral

Author

Eric W. Weisstein
March 6, 2004

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

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

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

Figure

<<Graphics`Arrow`
<<Graphics`Colors`

SetOptions[Arrow,HeadLength->.07];

{a,b,c}=Reverse[{{0.5,-.2},{0.35,0.4},{-0.2,0.39}}];
d=-Plus@@{a,b,c};
{p,q}={b+c,a+b};
v=FoldList[Plus,{0,0},{a,b,c,d}];
Show[Graphics[{
{Blue,
Arrow[q,{0,0}],
Arrow[a+p,a]
},
Arrow@@@Partition[v,2,1,1]
}],AspectRatio->Automatic]

Example 1

{a,b,c}=Table[Random[],{3},{2}];
d=-Plus@@{a,b,c};
{p,q}={b+c,a+b};
v=FoldList[Plus,{0,0},{a,b,c,d}];
Show[Graphics[{
PointSize[.02],Point/@v,
Line/@Partition[v,2,1,1]
}],AspectRatio->Automatic]

{a,b,c,d}

Plus@@Abs/@Det/@{{a,q},{d,q}}/2

Det[{p,q}]/2

Example 2

{a,b,c}=Table[Random[],{3},{2}];
d=-Plus@@{a,b,c};
{p,q}={b+c,a+b};
v=FoldList[Plus,{0,0},{a,b,c,d}];
Show[Graphics[{
PointSize[.02],Point/@v,
Line/@Partition[v,2,1,1]
}],AspectRatio->Automatic]

{a,b,c,d}

Plus@@Abs/@Det/@{{a,q},{d,q}}/2

Det[{p,q}]/2

Angle Bisectors

q=Quadrilateral[{{0,0},{1,0},{.7,.4},{.2,.3}}];
bis=Line/@AngleBisectors[q];
p={Intersections@@@Partition[bis,2],
Intersections@@@Partition[RotateLeft[bis],2]};

ConcyclicQ[Quadrilateral[Coordinates/@Flatten[p]]]

Show[Graphics[{
q,
{Red,bis},
{
PointSize[.02],
p
},
{Purple,Circumcircle[Coordinates/@Most[Flatten[p]]]},
{Blue,EqualAngleDivisionTicks[q,2,.07,.015,.1]}
}],AspectRatio->Automatic,PlotRange->All]

Quadrilateral Centroid

d[i_][tri_]:=DiagonalMidpoints[tri][[i]];
m[i_][tri_]:=Midpoints[tri][[i]];
vert[i_][tri_]:=tri[[i]];
pts={Centroid,"G",d[1],"(Subscript[M, AC])",d[2],"(Subscript[M, BD])",
	vert[1],"A",vert[2],"B",vert[3],"C",vert[4],"D",
	m[1],"(Subscript[M, AB])",m[2],"(Subscript[M, BC])",m[3],"(Subscript[M, CD])",m[4],"(Subscript[M, AD])"};
v={{0.99,0.1},{0.54,0.84},{-0.90,0.42},{-0.40,-0.91}};

quad[v_]:=Show[Graphics[{
	Quadrilateral[v],
				MidpointDiagonals[v],
				{PointSize[.04],Point/@v,Midpoints[v]},
	Line[DiagonalMidpoints[v] /. Point->Identity],
	PointLabels[v,pts,.04,{.04,.06}],
				{Dashing[{.03,.03}],Diagonals[v]}
}],AspectRatio->Automatic,DisplayFunction->Identity]

Show[GraphicsArray[{
			quad[{{0.99,0.1},{0.54,0.84},{-0.90,0.42},{-0.40,-0.91}}],
				quad[{{0,0},{1,-.2},{.7,.5},{.3,.4}}],
			quad[{{0,0},{1,-.2},{.3,.4},{.7,.5}}]
	}]]

Distance Relationships

NumberOfRelationships[n_]:=1/2(n-2)(n-3)

Table[NumberOfRelationships[n],{n,20}]

dd[i_,j_]:=(x[i]-x[j])^2+(y[i]-y[j])^2

Relationships[n_]:=Module[{i,j},
Eliminate[Table[dd[i,j]==d[i,j]^2,{j,2,n},{i,j-1}]//Flatten,
	Table[{x[i],y[i]},{i,n}]//Flatten]
]

Relationships[1]

Relationships[2]

Relationships[3]

Relationships[4]/.d[i_,j_]:>(Subscript[d, i,j])//TraditionalForm

TimeConstrained[Relationships[5],1800]/.d[i_,j_]:>(Subscript[d, i,j])//TraditionalForm

Relationships2[n_]:=Module[{i,j},
Factor/@GroebnerBasis[Table[dd[i,j]-d[i,j]^2,{j,2,n},{i,j-1}]//Flatten,
Table[d[i,j],{i,n},{j,i+1,n}]//Flatten,
	Table[{x[i],y[i]},{i,n}]//Flatten,MonomialOrder->EliminationOrder]
]

(r4=Relationships2[4])//Timing

Length[r4]

Relationships2[4]/.d[i_,j_]:>(Subscript[d, i,j])//TraditionalForm

(r5=Relationships2[5])//Timing

Length[r5]

Select[Union[r5],Union[Flatten[Rest[Reap[#/.d[i_,j_]:>Sow[{i,j}]]]]]==Range[5]&]

Length[%]