# On rolling polygons and Reuleaux polygons

Posted 2 years ago
4742 Views
|
2 Replies
|
11 Total Likes
|
 By this time, people are already familiar with Stan Wagon's demonstration of rolling regular polygons over a piecewise catenary road, as first shown in his paper with Leon Hall.The purpose of this post is to show a particularly compact Manipulate[] demonstration for rolling regular polygons, as well as a variation where the wheel is a Reuleaux polygon.This hinges on two things: NDSolve[]'s ability to cope with discontinuous differential equations, and the existence of a usable polar equation in both the regular and Reuleaux polygon cases.For the conventional regular polygon example, we can use the polar equation $$r=\frac{\cos\left(\frac{\pi}{n}\right)}{\cos\left(\left(\left(\theta-\frac{\pi}{n}+\frac{\pi}{2}\right)\bmod \frac{2\pi}{n}\right) -\frac{\pi}{n}\right)}$$which is a rotated modification of the formula in this Math Stack Exchange answer. Manipulate[DynamicModule[{road, sol}, sol = NDSolveValue[{\[FormalTheta]'[x] == 1/ngon[n, \[FormalTheta][x]], \[FormalTheta][0] == -?/2}, \[FormalTheta], {x, -1, 6}]; road = Plot[-ngon[n, sol[x]], {x, -1, 6}]; Show[road, Graphics[{{Directive[EdgeForm[GrayLevel[1/4]], ColorData[97, 3]], Dynamic[RegularPolygon[{t, 0}, {1, ?/n - ? - sol[t]}, n]]}, {Directive[AbsolutePointSize[6], ColorData[97, 4]], Point[Dynamic[{t, 0}]]}}], AspectRatio -> Automatic, Axes -> None, GridLines -> {None, {0}}, Method -> {"GridLinesInFront" -> True}, PlotRange -> {All, {-1, 1}}]], {{n, 4, "sides"}, 3, 12, 1}, {t, 0, 5, Animator}, Initialization :> (ngon[n_Integer, ?_] := Cos[?/n] Sec[Mod[? - ?/n + ?/2, 2 ?/n] - ?/n]), SaveDefinitions -> True, SynchronousUpdating -> False]  Now, let us turn to the Reuleaux polygon case. I (relatively) recently derived a polar equation for the Reuleaux polygons to finally solve a longstanding problem of mine of seeing what the corresponding road for a Reuleaux polygon looks like. The polar equation is understandably a little more elaborate: $$\small r=\sqrt{1+2\cos\frac{\pi}{n}+\cos^2\left(\left(\left(\theta+\frac{\pi}{2}+\frac{\pi}{n}\right)\bmod{\frac{2\pi}{n}}\right)-\frac{\pi}{n}\right)}-\cos\left(\left(\left(\theta+\frac{\pi}{2}+\frac{\pi}{n}\right)\bmod{\frac{2\pi}{n}}\right)-\frac{\pi}{n}\right)$$The formula can be compacted a bit in Mathematica by using the three-argument form of Mod[]. Manipulate[DynamicModule[{road, sol, wheel}, sol = NDSolveValue[{\[FormalTheta]'[x] == 1/reuleaux[n, \[FormalTheta][x]], \[FormalTheta][0] == -?/2}, \[FormalTheta], {x, -1, 6}]; road = Plot[-reuleaux[n, sol[x]], {x, -1, 6}]; wheel = First[Cases[Normal[PolarPlot[reuleaux[n, ?], {?, 0, 2 ?}, Exclusions -> None]], Line[pts_] :> pts, ?]]; Show[road, Graphics[{{Directive[EdgeForm[GrayLevel[1/4]], ColorData[97, 3]], Polygon[Dynamic[ AffineTransform[{RotationMatrix[-?/2 - sol[t]], {t, 0}}][wheel]]]}, {Directive[AbsolutePointSize[6], ColorData[97, 4]], Point[Dynamic[{t, 0}]]}}], AspectRatio -> Automatic, Axes -> None, GridLines -> {None, {0}}, Method -> {"GridLinesInFront" -> True}, PlotRange -> {All, {-1, 1}}]], {{n, 3, "sides"}, 3, 11, 2}, {t, 0, 5, Animator}, Initialization :> (reuleaux[n_Integer, ?_] := Sqrt[1 + 2 Cos[?/n] + Cos[Mod[? + ?/2, 2 ?/n, -?/n]]^2] - Cos[Mod[? + ?/2, 2 ?/n, -?/n]]), SaveDefinitions -> True, SynchronousUpdating -> False] Here is an animation I did much earlier:Using the same equation, I tried to derive a closed form for the road, but got stymied when it involved the inversion of the elliptic integral of the second kind, EllipticE[]. Attachments:
2 Replies
Sort By:
Posted 2 years ago
 - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!