How to create a random belt polygon or belt polyhedron?

Question

A zonogon is a convex polygon that is made up of parallel sides. Generating a random zonogon in Mathematica can be found here. A natural generalization of zonogons is called belt polygons. A belt polygon is a convex polygon that is made up of parallel line segments, but they are not necessarily the same length. I generalized SHuisman's solution to get the Mathematica code below for a random belt polygon (not always correct at making belt polygons):

ClearAll[CreateRandomBeltPolygon]
CreateRandomBeltPolygon[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, 2*m];
  Polygon[Accumulate[MapThread[AngleVector[{#1, #2}] &, {lengths, dirs}]]]
  ]
 Graphics[{EdgeForm[Thick],White,CreateRandomBeltPolygon[6, {0.5, 1}] }, AspectRatio->Automatic]

For example might give:

_{$\color{magenta}{\star}$ Boltyanski, V., Martini, H., & Soltan, P. S. (1997). [Combinatorial geometry of belt bodies. In Excursions into Combinatorial Geometry (pp. 319–363)]. Springer Berlin Heidelberg. https://doi.org/10.1007/978-3-642-59237-9_7}

Answer 1

There are at least two ways to do this.The Minkowski Sum (RegionDilation) still work.The other way does not depend on RegionDilation, but we need times to modify the code.

• We start from a random convex polygon with k edges where k=n/2.(As the convex polygon degenerate to a point, the result become a zonogon)
• And we extract the lines of the convex polygon and using RegionDilation.

beltPoly[n_?EvenQ] := Module[{k, poly, lines},
  k = n/2;
  poly = RandomPolygon[{"Convex", k}];
  lines = MeshPrimitives[poly, 1];
  Fold[RegionDilation, poly, lines]]
regs = beltPoly /@ {6, 8, 10, 12};
GraphicsGrid[
 Partition[Graphics[{FaceForm[], EdgeForm[Thick], #}] & /@ regs, 2, 
  2]]

• We can also extend the edges of the convex polygon at first.

Clear["Global`*"];
SeedRandom[1234];
n = 8;
k = n/2;
poly = RandomPolygon[{"Convex", k}];
lines = MeshPrimitives[poly, 1];
extendLines = 
  lines /. 
   Line[{a_, b_}] :> Line[{a, b + RandomReal[{.3, .6}]*(b - a)}];
{Graphics[{poly, Orange, extendLines /. Line -> Arrow}], 
 Graphics[{FaceForm[], EdgeForm[Blue], 
   Fold[RegionDilation, poly, extendLines]}]}

• Subdivided the region to several parallelograms and one convex polygon still not so easy. At first we add parallelograms around the convex polygon.

Clear["Global`*"];
SeedRandom[1234];
n = 10;
k = n/2;
poly = RandomPolygon[{"Convex", k}];
lines = MeshPrimitives[poly, 1];
extendLines = 
  lines /. Line[{a_, b_}] :> 
    Line[{a, b + RandomReal[{.4, .6}]*(b - a)}];
{Graphics[{poly, Orange, extendLines /. Line -> Arrow}, 
  ImageSize -> Medium],
 Graphics[{poly, FaceForm[], EdgeForm[Blue], 
   Partition[extendLines, 2, 1, 
     1] /. {Line[{a_, b_}], Line[{c_, d_}]} :> 
     Polygon[{c, b, b + d - c, d}]}, ImageSize -> Medium]}

• When the Counterclockwise angle less then π, we extend one parallelogram, until the outer polygon become a n=2k sides convex polygon.

Clear["Global`*"];
SeedRandom[1234];
k = 5;
n = 2 k;
poly = RandomPolygon[{"Convex", k}];
lines = MeshPrimitives[poly, 1];
extendLines = 
  lines /. Line[{a_, b_}] :> 
    Line[{a, b + RandomReal[{.4, .6}]*(b - a)}];
polys0 = 
  Partition[extendLines, 2, 1, 
    1] /. {Line[{a_, b_}], Line[{c_, d_}]} :> 
    Polygon[{c, b, b + d - c, d}];
pairs = Partition[extendLines, 2, 1, 
    1] /. {Line[{a_, b_}], Line[{c_, d_}]} :> Point[{b, b + d - c, d}];
countAngles[pts_] := 
  Thread[PlanarAngle[#, "Counterclockwise"] & /@ 
     Partition[pts, 3, 1, {2}] > π];
test[pts_] := And @@ countAngles[pts];
extend[pts_] := Module[{n, pos, p, poly, a, b, c, d}, n = Length@pts;
   pos = First@FirstPosition[countAngles@pts, False];
   a = pts[[Mod[pos - 1, n, 1]]];
   b = pts[[pos]];
   c = pts[[Mod[pos + 1, n, 1]]];
   d = a + c - b;
   Sow[Polygon[{a, b, c, d}]];
   ReplacePart[pts, pos -> d]];
pts = Flatten[pairs[[;; , 1]][[;; , 1 ;; 2]], 1];
result = Reap@NestWhileList[extend, pts, Not@*test]; 
g = Graphics[{LightYellow, 
   poly, {EdgeForm[Black], FaceForm[LightBlue], polys0}, {FaceForm[Orange], EdgeForm[Black], #} & /@ 
    First@result[[2]]}]

• The animation.

AbsoluteOptions[g, PlotRange];
ani = Manipulate[
  Graphics[{LightYellow, 
    poly, {EdgeForm[Black], FaceForm[LightBlue], polys0}, 
    Take[{FaceForm[Orange], EdgeForm[Black], #} & /@ 
      First@result[[2]], i]}, 
   First@AbsoluteOptions[g, PlotRange]], {i, 0, 
   Length@First@result[[2]], 1}, SaveDefinitions -> True]

Answer 2

Naive approach:

belt[n_] := Module[{rp, poly}, rp = RandomPolygon[{"Convex", n}];
   poly = Polygon[# - RegionCentroid[rp] & /@ MeshCoordinates@rp];
   Graphics[{EdgeForm[Black], FaceForm[None], 
     RegionIntersection[poly, 
      ReflectionTransform[{1, 0}][
       ReflectionTransform[{0, -1}][poly]]]}]];
GraphicsGrid[Partition[belt /@ Range[4, 10], 3]]