How to create a random zonogon?

Question

A zonogon is a polygon that is convex and is made only out of pairs of parallel sides with the same length. Any regular polygon with an even number of sides is an example of a zonogon.

When I use: Graphics[RandomPolygon[{"StarShaped", 10}]], I get something like this:

When I use: Graphics[RandomPolygon[{"Convex",6}]], I get something like this:

And for regular polygons, we can do something different with: Graphics[RegularPolygon[{randomPositiveReal, randomAngle}, randomInteger]].

But unfortunately there is no option for zonogons. The code: Graphics[RandomPolygon[{"Zonogon",6}]] gives an error.

I found this gives a random hexagon that is a zonogon before a random rotation:

height=500;
width=500;
X6={};AppendTo[X6,RandomReal[{0,width}]];AppendTo[X6,RandomReal[{0,height}]];
X3={};AppendTo[X3,RandomReal[{X6[[1]],width}]];AppendTo[X3,X6[[2]]];
X1={};AppendTo[X1,RandomReal[{X6[[1]],X3[[1]]}]];AppendTo[X1,RandomReal[{0,X3[[2]]}]];
X2={};AppendTo[X2,RandomReal[{X1[[1]],X3[[1]]}]];AppendTo[X2,X1[[2]]];
X4={};X4=X3+X6-X1;
X5={};X5=X3+X6-X2;
ListLinePlot[{X1,X2,X3,X4,X5,X6,X1},Axes->False]

Which gives something like this:

When I look at more examples of zonogons here, I noticed that I believe zonogons can be made by 'stretching' parallel sides of a regular polygon.

How can I do this to make a random zonogon in Mathematica?

Answer 1

You can get some shapes with AffineTransform and Rotate. Define:

zonogon[n_]:=
Rotate[GeometricTransformation[Rotate[RegularPolygon[n],RandomReal[2Pi]],
AffineTransform[RandomReal[1,{2,2}]]],RandomReal[2Pi]]

Then generate a few:

Table[Graphics[zonogon[RandomChoice[Range[4, 14, 2]]]], 10]

Answer 2

We can using Minkowski Sum (RegionDilation) of any Line's from the fixed point p.

• For 3D.

p = {0, 0, 0};
n = 10;
lines = Table[Line[{p, p + RandomReal[{-5, 5}, 3]}], n];
polyhedron = Fold[RegionDilation, lines];
HighlightMesh[polyhedron, {Style[1, White], Style[2, Darker@Cyan]}, 
 ViewProjection -> "Orthographic"]

• For 2D.

p = {0, 0};
n = 4;
lines = Table[Line[{p, p + RandomReal[{-5, 5}, 2]}], n];
poly = Fold[RegionDilation, lines];
Graphics[{FaceForm[Darker@Cyan], EdgeForm[Thick], poly, Thick, 
  Orange, lines /. Line -> Arrow, White, AbsolutePointSize[10], 
  Point[p]}]

• For 2D,we demonstrate the process of the Region Dilation.After that, we want to subdivide the region into some Parallelograms.

SeedRandom[1111];
p = {0, 0};
n = 9;
dirs = RandomPoint[Circle[{0, 0}, 1, {-(π/2), π/2}], n];
lines = Line[{p, p + #}] & /@ dirs;
polys = FoldList[RegionDilation, lines];
parts = Most@MapThread[RegionDifference, {Rest@polys, Most@polys}];
Graphics[{EdgeForm[{Thick, White}], FaceForm@RandomColor[], #} & /@ 
  parts]

• One way to subdivede the zonogon into Parallelograms.

SeedRandom[1];
p = {0, 0};
n = 11;
dirs = RandomPoint[Circle[{0, 0}, 1], n];
lines = Line[{p, p + #}] & /@ dirs;
polys = FoldList[RegionDilation, lines];
parts = Most@MapThread[RegionDifference, {Rest@polys, Most@polys}];
pts = MapThread[
    Complement, {Rest[First /@ polys], Most[First /@ polys]}][[2 ;; 
     n - 2]];
Animate[Graphics[{MapIndexed[{ColorData[97][First@#2], #1} &, parts], 
   Arrowheads[.025], White, 
   Take[MapThread[
     Arrow /@ Thread[{#1 - Threaded@#2, #1}] &, {pts, 
      dirs[[3 ;; n - 1]]}], i]}], {i, 1, n - 3, 1}, AnimationRate -> 1]

• By lifting the 2D data to 3D, we can found that subdivede the zonogon into Parallelograms is not unique.

SeedRandom[1];
p = {0, 0};
n = 11;
dirs = RandomPoint[Circle[{0, 0}, 1], n];
 pic = 
 Graphics3D[
  Fold[RegionDilation, 
   Line[{{0, 0, 0}, {0, 0, 0} + #}] & /@ (PadRight[#, 3] & /@ dirs)], 
  ViewPoint -> Top, 
  ViewProjection -> "Orthographic"]; SeedRandom[]; 
pics = 
 Table[Graphics3D[
   Fold[RegionDilation, 
    Line[{{0, 0, 0}, {0, 0, 0} + #}] & /@ 
     MapThread[Append, {dirs, RandomReal[{0, 1}, n]}]], 
   ViewPoint -> Top, ViewProjection -> "Orthographic"], 
  4]; 
GraphicsRow[{pic, pics} // Flatten]

Edit

• To subdivide the 2D case to varies several Parallelograms is still not so easy. Here we only provided one possible way. I think if we can find the way to change the hexagons in the figure, we will get many subdivides.

k = 7;
es = RandomReal[{0, 1}, k]*
   SortBy[RandomPoint[Circle[{0, 0}, 1, {0, π}], k], 
    VectorAngle[{1, 0}, #] &];
level[j_] := 
  MapThread[
   Polygon[Join[#1, Reverse@#2]] &, {Partition[#, 2, 1] &@
     FoldList[Plus, Take[es, -j]], 
    Partition[#, 2, 1] &@
     Prepend[FoldList[Plus, Take[es, -j + 1]], {0, 0}]}];
Graphics[
 Table[{FaceForm[ColorData[97][j]], EdgeForm[{White, Thick}], 
   level[j]}, {j, 1, k}]]

• Change the direction of vectors, we can draw a picture similar with https://pershmail.substack.com/p/shape-of-the-week-zonogon

Clear[k, es, level];
k = 13;
es = AngleVector /@ Table[-(π/(2 k)) + j*π/k, {j, 1, k}];
es = CirclePoints[{1, π + π/(2 k)}, 2 k];
level[j_] := 
  MapThread[
   Polygon[Join[#1, Reverse@#2]] &, {Partition[#, 2, 1] &@
     FoldList[Plus, Take[es, -j]], 
    Partition[#, 2, 1] &@
     Prepend[FoldList[Plus, Take[es, -j + 1]], {0, 0}]}];
Graphics[
 Table[{FaceForm[ColorData[97][j]], EdgeForm[{White, Thick}], 
   level[j]}, {j, 1, k}]]

• Transpose the data to get the same pattern of colors.

lear[k, es, level];
k = 13;
es = CirclePoints[{1, π + π/(2 k)}, 2 k];
level[j_] := 
  MapThread[
   Polygon[Join[#1, Reverse@#2]] &, {Partition[#, 2, 1] &@
     FoldList[Plus, Take[es, -j]], 
    Partition[#, 2, 1] &@
     Prepend[FoldList[Plus, Take[es, -j + 1]], {0, 0}]}];
polys = Flatten[Table[level[j], {j, 1, k}], {{2}, {1}}];
Graphics[
 Table[{FaceForm[ColorData[97][i]], EdgeForm[{Thick, White}], 
   polys[[i]]}, {i, 1, k - 1}]]

a mathematical conjecture

It seems that every "StarShaped" can be extend to a unique "Convex" by extend Parallelogram.(the code need to be improved)

And every "StarShaped" which construct by Parallelograms can be extend to a unique "Zonogon".

Answer 3

You can start with a regular 2n polygon that has 2 sides parallel to the x axis. Then stretch the polygon along the x axis. Afterwards, you rotate the polygon so that the next side is parallel to the x axis and stretch again. After you did this n times, you have your zonogon.

n = 3;
pts = CirclePoints[2 n];
Do[
  add = RandomReal[1];
  pts[[;; n]] = (# + {add, 0}) & /@ pts[[;; n]];
  pts[[n + 1 ;;]] =  (# - {add, 0}) & /@ pts[[n + 1 ;;]];
  pts = RotateRight[pts];
  , {n}];
AppendTo[pts, pts[[1]]];
Graphics[Line[pts], Axes -> True]

Answer 4

A much cheaper way is by just creating directions and line pieces and assembling (over the much more expansive Minkowski sum/RegionDilation), and much more random than the stretched regular polygons:

ClearAll[CreateRandomZonogon]
CreateRandomZonogon[sides_?EvenQ, lendist : {min_, max_}] := 
 Module[{m, angles, dirs, lengths},
  m = sides/2;
  angles = RandomReal[{0, 1}, m];
  angles /= Total[angles]/(Pi);
  angles = Join[angles, angles];
  dirs = Accumulate[angles];
  dirs += RandomReal[{0, 2 Pi}];
  lengths = RandomReal[lendist, m];
  lengths = Join[lengths, lengths];
  Polygon[Accumulate[MapThread[AngleVector[{#1, #2}] &, {lengths, dirs}]]]
  ]
CreateRandomZonogon[8, {0.5, 1}] // Graphics

here the first argument is the number of sides (should be even). And then the second specification is the range of lengths for the sides, which i set to 0.5 to 1, but can be anything (positive).