Graphing curves formed by a rolling polygon

Question

I am trying to make a Mathematica graphing function that would generalize common phenomena. How would I do this?

From a circle, we can generate a cycloid (if rolling on a line) or a sine wave (if rolling through a line). Similarly, we could do the same thing for any polygon. From a polygon, we can generate a cyclogon (if rolling on a line). The point that generates the curve can be curated (inside the polygon) or prolated (outside of the polygon). We can "roll" that polygon through space too. Or we can roll the circle or polygon along a different polynomial. It does not have to be a regular polygon either.

So the function would be like:

RollingCurve[polygon_, generatingPoint_, roadPolynomial_, startingPoint_, journeyTime_, distanceTraveled_]

Here is an example of a sine wave being generated from a circle taken from here:

Here is an example of a cycloid being generated from a circle taken from here:

And we have several other examples for the polygonal version from Wikipedia:

Answer 1

Here is a simplified starting point. We restrict the path to a line, the x axis. And the shape that is rolled on the path to a (not necessarily regular) convex polygon. We start with an arbitrary polygon and some points whose movement will be traced..

The first step is to place the polygon, so that the first point is at the origin and the second point is on the x axis. The list of vertices is called "pts".

The point to trace is specified relative to this configuration and appended to "pts".

Next we calculate the angles between the sides.

We define a auxiliary function: "polytrace1" that calculates many micro steps of one whole revolution of the polygon. It returns a list of lists of vertices at different corresponding to different micro steps. It also returns a list of positions of the tracer point corresponding to the micro steps.

Having a list of different configuration for one revolution, the subsequent revolutions are simply translations of the first revolution. "polytrace" then returns a list of polygon configurations corresponding to the micro steps as well as a graphic of the path of the tracer point.

Here is the code:

polytrace[poly_, trace_, revol_Integer : 1] := 
 Module[{angles, pts = poly // N, dx, gr, tr},
  AppendTo[pts, pts[[1]]];
  pts = RotationMatrix[{pts[[2]] - pts[[1]], {1, 0}}] . (# - 
        pts[[1]]) & /@ pts;
  angles = Subtract @@@ Partition[pts, 2, 1];
  AppendTo[angles, angles[[1]]];
  angles =  VectorAngle @@@ Partition[angles, 2, 1];
  AppendTo[pts, trace];
  
  pts = polytrace1[pts, angles];
  
  If[revol > 1,
   dx = pts[[-1, 1, 1]];
    pts = Most[pts];
   pts = 
    Table[pts /. {x_?NumericQ, y_} :> {x + i dx, y}, {i, 0, 
      revol - 1}]; pts = Flatten[pts, 1]; 
   AppendTo[pts, pts[[1]] /. {x_?NumericQ, y_} :> {x + revol dx, y}];
   ];
  
  gr = (Graphics[{Line[Most[#]], Red, PointSize[0.02], 
        Point[#[[-1]]]}, Axes -> True, 
       PlotRange -> {MinMax[pts[[All, All, 1]]], 
         MinMax[pts[[All, All, 2]]]}]) & /@ pts;(*polygons*)
  tr = Graphics[{Cyan, Line[pts[[All, -1, All]]]}]; (*trace*)
  
  {gr, tr}
  ]

polytrace1[pts0_, angles_] := 
 Module[{i, rotmat, n = 20, tr, pts = {ptsn = pts0}},
  rotate[pt_, pt0_] := rotmat . (pt - pt0) + pt0;
  i = 1;
  Function[ang,
    i++;
    rotmat = RotationMatrix[-ang/n] // N;
    center = pts[[-1, i]] ;
    Do[ ptsn = rotate[#, center] & /@  ptsn; AppendTo[pts, ptsn], n];
    ] /@ angles;
  pts
  ]

To give an example, we define a regular pentagon and a tracer point outside the pentagon:

 cp = CirclePoints[5];
{gr, tr} = polytrace[cp, {1.6, 1.6}, 2];
Manipulate[
 Show[gr[[Round@i]], tr]
 , {i, 1, Length[gr]}]

Answer 2

This is a partial answer with probable mistakes that will slowly get updates. I want to give the closed analytic solution. This means the answer will be more math-y than code-y, but at the end of the day it can be put in Mathematica. This is fun art for me.

Note, that there are somewhat separate parts to the question. One is when the point is going around along a polygon's border. The other is over curves. Regardless, each process is completely deterministic. For the first part, it is obviously periodic and when it goes on a line it is also periodic.

CONVEX POLYGON

randPoly = RandomPolygon[{"Convex",RandomInteger[{3,10}]}]

which is constructed by line segments.

Please note that the equation of a line when we plug in the first and second point for slope and the intercept is:

$$y:= (\frac{y_2-y_1}{x_2-x_1})(x-x_1)+y_1, \{x_1,x_2\}$$

and the arc length for a line segment, $ℓ$ to to a value $t$ in-between the bounded domain is:

$$ℓ := \sqrt{(\frac{y_2-y_1}{x_2-x_1})^2+1} \cdot (t-x_1)$$

Part I: Point moves along the boundary of the polygon.

The function is in essence a periodic piecewise function $\overline{\rm y} = f(\sigma)$, $\sigma$ is the arclength and $\overline{\rm y}$ is the value for the current line segment where it then repeats. There are two possible directions, clockwise and counterclockwise. Since we know that the solution is periodic, we can just have a chosen method for the first vertex being the reference starting point then shift the function appropriately to the left or right depending on the distance from the chosen reference point to the de facto point given the chosen direction. We will call this shift $\phi$

The reference point is be the point that is the most right out of the highest vertices. Here is how it is calculated in Mathematica:

referencePoint = Flatten[MaximalBy[MaximalBy[randPoly[[1]],Last],First]]

The name of the vertices then go up by 1 as we go clockwise and go in the reveser order as we go counterclockwise. This is the same conventional as a clock.

Given:

• $a$ as the starting value, which is always 1 for us.
• $p$ as the period length
• $n$ as the position in the sequence,

1. Clockwise, $\newcommand{\clockwisePolygon}[1]{\overset{\text{⟳}}{#1}}\clockwisePolygon{P}$

In Mathematica, we can go through the names clockwise of the vertices however many times we like by this code:

clockwiseSequence[startValue_, periodLength_, sequenceLength_] := 
Table[
  Mod[startValue + Mod[n - 1, periodLength] - 1, periodLength] + 1,
{n, sequenceLength}]

which is mathematically notated by:

$\newcommand{\clockwiseSequence}[1]{\overset{\text{⟳}}{#1}}\clockwiseSequence{a}_n = (( a + (n - 1) \mod p - 1) \mod{p}) + 1$

which leads to the closed analytic solution:

$\newcommand{\clockwiseSequence}[1]{\overset{\text{⟳}}{#1}} f(\sigma) = \begin{cases} f_{\clockwiseSequence{a}_1}(\sigma) & \text{if } 0 \leq \sigma + \phi< \ell_1 \\ f_{\clockwiseSequence{a}_2}(\sigma - \ell_1) & \text{if } \ell_1 \leq \sigma + \phi < \ell_1 + \ell_2 \\ \vdots & \vdots \\ f_{\clockwiseSequence{a}_p}(\sigma - \sum_{i=1}^{p-1} \ell_i) & \text{if } \sum_{i=1}^{p-1} \ell_i \leq \sigma + \phi < \sum_{i=1}^{p} \ell_i \\ \end{cases}$

2. Counterclockwise, $\newcommand{\counterClockwisePolygon}[1]{\overset{\text{⟲}}{#1}}\counterClockwisePolygon{P}$

In Mathematica, we can go through the names counterclockwise of the vertices however many times we like by this code:

counterClockwiseSequence[startValue_, periodLength_, sequenceLength_] := 
Table[
  Mod[periodLength - Mod[n, periodLength, 1] + startValue, periodLength] + 1,
{n, sequenceLength}]

which is mathematically notated by:

$\newcommand{\counterClockwiseSequence}[1]{\overset{\text{⟲}}{#1}}\counterClockwiseSequence{a}_n := ( p − ((n − 1)\mod{p}) + a − 1)\mod{p} + 1$

which leads to the closed analytic solution:

$\newcommand{\counterClockwiseSequence}[1]{\overset{\text{⟲}}{#1}} f(\sigma) = \begin{cases} f_{\counterClockwiseSequence{a}_1}(\sigma) & \text{if } 0 \leq \sigma + \phi< \ell_1 \\ f_{\counterClockwiseSequence{a}_2}(\sigma - \ell_1) & \text{if } \ell_1 \leq \sigma + \phi< \ell_1 + \ell_2 \\ \vdots & \vdots \\ f_{\counterClockwiseSequence{a}_p}(\sigma - \sum_{i=1}^{p-1} \ell_i) & \text{if } \sum_{i=1}^{p-1} \ell_i \leq \sigma + \phi < \sum_{i=1}^{p} \ell_i \\ \end{cases}$

Part II: Polynomials

• Linear

  In progress

• Quadratic & Higher Order

  Bumpier, not quite periodic.

Part III: Other Curves