Function Repository Resource:

ReverseMidpointPolygon

Source Notebook

Create a polygon from a list of midpoints

Contributed by: Ed Pegg Jr

ResourceFunction["ReverseMidpointPolygon"][mid]

returns a polygon or polyline with given midpoints mid.

Details

For a given polygon, connecting the midpoints of neighboring sides yields the midpoint polygon.
For an odd number of midpoints, ResourceFunction["ReverseMidpointPolygon"] creates a polygon with the given list.
Varignon's theorem states that the midpoint polygon of a quadrilateral is a parellelogram. In addition, the midpoints of the diagonals coincide. Generalizing, for an even-sided midpoint polygon, the mean of even vertices and the mean of odd vertices coincide.
For 2n points, let d be the distance between the even vertex mean and odd vertex mean. If d=0, infinite solutions exist and one of them is returned. Otherwise, a polyline with 2n+1 points are returned, with the first and last points 2n d apart.

Examples

Basic Examples (3) 

Find the vertices of a reverse midpoint polygon (rvp) for a given list of midpoints:

In[1]:=
p = Round[50 (CirclePoints[7] + .01)];
rvp = ResourceFunction["ReverseMidpointPolygon"][p]
Out[2]=

Check that the midpoints of rvp match the given list of midpoints:

In[3]:=
Mean /@ Partition[rvp, 2, 1, 1] == p
Out[3]=

Show both:

In[4]:=
Graphics[{Opacity[.5], Green, Polygon[p], Gray, Polygon[rvp], Black}]
Out[4]=

Repeat a few more times:

In[5]:=
Graphics[{Opacity[.5], EdgeForm[Black], White, Polygon /@ Reverse[NestList[ResourceFunction["ReverseMidpointPolygon"][#] &, p, 3]]}]
Out[5]=

For a square, find one of the many reverse midpoint polygons:

In[6]:=
p = CirclePoints[4];
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[7]=

Show it:

In[8]:=
Graphics[{Opacity[.5], Green, Polygon[p], Gray, Polygon[r]}]
Out[8]=

Try a skew quadrilateral:

In[9]:=
p = {{1, -1}, {4, 0}, {1, 3}, {0, 2}};
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[10]=

One of many possible polylines is returned with the given midpoints. For any solution, the ends of the polyline are separated by a vector four times the magnitude of the vector between diagonal midpoints:

In[11]:=
Graphics[{Opacity[.5], Green, Polygon[p], Black, Line[r], Blue, Line[p[[{1, 3}]]], Line[p[[{2, 4}]]], Thick, Red, Line[{Mean[p[[{1, 3}]]], Mean[p[[{2, 4}]]]}]}]
Out[11]=

Scope (2) 

Find one of the many solutions for the regular hexagon:

In[12]:=
Graphics[{Opacity[.5], Green, Polygon[CirclePoints[6]], Gray, Polygon[ResourceFunction["ReverseMidpointPolygon"][
    CirclePoints[6]]]}]
Out[12]=

Find one of many polylines with a given set of six midpoints:

In[13]:=
p = Round[10 Drop[CirclePoints[7], 1]];
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[14]=

Check that the polyline ends have 6 times the separation of the even and odd centroids:

In[15]:=
(EuclideanDistance @@ r[[{1, 7}]])/(EuclideanDistance @@ {Mean[p[[{1, 3, 5}]]], Mean[p[[{2, 4, 6}]]]})
Out[15]=

Show the polyline with the displacement between the even and odd centroids:

In[16]:=
Graphics[{Opacity[.5], Green, Polygon[p], Black, Line[r], Thick, Red, Line[{Mean[p[[{1, 3, 5}]]], Mean[p[[{2, 4, 6}]]]}]}]
Out[16]=

Neat Examples (2) 

Find a Varignon-balanced extension for a pentagon:

In[17]:=
p = Append[Round[10 (CirclePoints[5] + .5)], {x, y}]
Out[17]=
In[18]:=
{x, y} /. Solve[Mean[p[[{1, 3, 5}]]] == Mean[p[[{2, 4, 6}]]]]
Out[18]=

Find the ReverseMidpointPolygon:

In[19]:=
p = {{11, -3}, {15, 8}, {5, 15}, {-5, 8}, {-1, -3}, {5, -7}};
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[20]=

Show it:

In[21]:=
Graphics[{Opacity[.5], Green, Polygon[p], Gray, Polygon[r]}]
Out[21]=

If an even number of points is even slightly unbalanced, a polyline is returned instead:

In[22]:=
p = {{11, -3}, {15, 8}, {5, 15}, {-5, 8}, {-1, -3}, {5, -7.01}};
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[23]=

Find a polygon with midpoints on an octagon:

In[24]:=
p = Round[10 Drop[CirclePoints[9], 1]];
r = ResourceFunction["ReverseMidpointPolygon"][p]
Out[25]=

Check that the polyline ends have 8 times the separation of the even and odd centroids:

In[26]:=
(EuclideanDistance @@ r[[{1, 9}]])/(EuclideanDistance @@ {Mean[p[[{1, 3, 5, 7}]]], Mean[p[[{2, 4, 6, 8}]]]})
Out[26]=

Show the polyline with the displacement between the even and odd centroids:

In[27]:=
Graphics[{Opacity[.5], Green, Polygon[p], Black, Line[r], Thick, Red, Line[{Mean[p[[{1, 3, 5, 7}]]], Mean[p[[{2, 4, 6, 8}]]]}]}]
Out[27]=

Requirements

Wolfram Language 14.0 (January 2024) or above

Version History

  • 1.0.0 – 27 September 2024

Related Resources

Author Notes

I thought this would be easy. Varignon got in my way.

License Information