Polygon Area

Author

Eric W. Weisstein
March 21, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polygons/PolygonArea.nb.

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

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

Polygon

PolygonArea[l_List?MatrixQ]:=Total[Det/@Partition[l,2,1,1]]/2/;Dimensions[l][[2]]==2

RegularPolygonArea[n_Integer,R_:1]:=n R^2Sin[2Pi/n]/2/;n≥3

http://arxiv.org/pdf/1410.5115.pdf

PolygonCentroid[v_List?MatrixQ]:=Module[{X,Y,i,x,y,n=Length[v]},
{X,Y}=Transpose[v];
x[i_]:=X[[Mod[i-1,n]+1]];
y[i_]:=Y[[Mod[i-1,n]+1]];
Sum[{(x[i]+x[i+1])(x[i]y[i+1]-x[i+1]y[i]),(y[i]+y[i+1])(x[i]y[i+1]-x[i+1]y[i])},{i,0,n-1},Method->"Procedural"]/(6 PolygonArea[v])
]/;Dimensions[v][[2]]==2

PolygonCircumcenterCenterOfMass[v_List?MatrixQ]:=Module[{X,Y,i,x,y,n=Length[v]},
{X,Y}=Transpose[v];
x[i_]:=X[[Mod[i-1,n]+1]];
y[i_]:=Y[[Mod[i-1,n]+1]];
Sum[{y[i](((x[i-1])^2)+((y[i-1])^2)-((x[i+1])^2)-((y[i+1])^2)),-x[i](((x[i-1])^2)+((y[i-1])^2)-((x[i+1])^2)-((y[i+1])^2))},{i,0,n-1},Method->"Procedural"]/(4 PolygonArea[v])
]/;Dimensions[v][[2]]==2

Triangle

tri=Table[{x[i],y[i]},{i,3}];

Area

Area[Polygon[tri]]

PolygonArea[tri]

Det[Table[{x[i],y[i],1},{i,3}]]/2

Centroid

RegionCentroid[Polygon[tri]]

PolygonCentroid[tri]//Simplify

Circumcenter Center of Mass

PolygonCircumcenterCenterOfMass[tri]//FullSimplify

Quadrilateral

Area[Evaluate[Polygon[Table[{x[i],y[i]},{i,4}]]]]

<<DiscreteMath`ComputationalGeometry`

?ConvexHull

Table[Show[GraphicsArray[{
Graphics[
q=Quadrilateral[Table[Random[],{4},{2}]],
PlotLabel->Area[Evaluate[Polygon@@q]]],
Graphics[
r=Quadrilateral[Vertices[q][[ConvexHull[Vertices[q]]]]],
PlotLabel->Area[Evaluate[Polygon@@r]]]
}]],{10}]

Concave

Show[Graphics[q=Quadrilateral[{{0,0},{.5,.4},{1,0},{.5,1}}]]]

Area[Evaluate[Polygon@@q]]

Area/@{Polygon[{{0,0},{.5,.4},{1,0}}],
Polygon[{{0,0},{1,0},{.5,1}}]}

Plus@@%

Self-Intersecting

Show[Graphics[q=Quadrilateral[{{0,0},{1,0},{0,1},{1,1}}]]]

Area[Evaluate[Polygon@@q]]

Show[Graphics[q=Quadrilateral[{{0,0},{1,0},{.3,1},{1,1}}]],AspectRatio->Automatic]

Area[Evaluate[Polygon@@q]]

<<Graphics`Colors`

q=Quadrilateral[{{.3,0},{1,0},{0,1},{1,1}}];
v=Vertices[q];

i=Intersections[Line[v[[{1,4}]]],Line[v[[{2,3}]]]][[1]]

Show[Graphics[{
{Black,
t1=Polygon[{{.3,0},{1,0},i}]},{Red,t2=Polygon[{{0,1},{1,1},i}]},
q,
PointLabels[Transpose[{Point/@v,Subscript["v",ToString[#]]&/@Range[4]}],LabelOffset->.03]
}],AspectRatio->Automatic]

Area[Evaluate[Polygon@@q]]

Area/@{t1,t2}

Subtract@@%

Plus@@Abs[%51]