A Minimalist Approach to Rolling Wheels

Antonín Slavík, Faculty of Mathematics and Physics, Charles University, Prague, Czech Republic ⟨slavik@karlin.mff.cuni.cz⟩

Stan Wagon, Macalester College, St. Paul, MN, USA ⟨wagon@macalester.edu⟩

Abstract.  In 1960, G. B. Robison discovered the general equations relating roads and wheels, where either can have an unusual shape (e.g., the square wheel rolls smoothly on a catenary). But he used some inobvious assumptions regarding the meaning of rolling. Here we derive the equations for the road appropriate for a given wheel using only the single assumption that rolling occurs with no slipping. We do not require that the wheel be differentiable, so this allows the construction of a wheel–road pair when the wheel is a continuous, nowhere differentiable function.

.  INTRODUCTION.

The appropriate road for a round wheel is a horizontal line: the wheel rolls smoothly along the line. The converse question is classic: What is the appropriate road for a wheel that is a horizontal line? The answer is a catenary; this is the basis of the famous construction of a road of linked catenaries on which a square wheel will roll smoothly (Figures  and ; a version where the road loops around in a circle is at the National Museum of Mathematics in New York City []; a recently completed bridge near London, England, is a large square that rolls on giant catenaries []).

The square wheel problem was posed and solved in 1960 by G. B. Robison []; see also []. He discovered general equations relating wheels and roads, but his work is problematic because it is based on certain assumptions as to what rolling means. In particular, Robison assumed an “equilibrium property”: the wheel’s center stays directly above the contact point of the wheel with the road during rolling. He also assumed that the arc lengths of the wheel and road to the point of contact match. These properties are also assumed in []. One can justify the equilibrium property, but it is not obvious that it should be taken as an axiom. Our goal here is to show how the theory of rolling wheels can be derived solely from the assertion that rolling occurs with no slipping. Thus a teacher who wishes to present the mathematics underlying the square wheel can do so from a single intuitive assumption. By avoiding arc length, our approach does not require that the wheel be differentiable, and so one can imagine a smoothly rolling wheel that arises from a continuous, nowhere differentiable function (Example 7).  In fact, the arc length condition by itself is insufficient to guarantee proper rolling; see section .

.  THE ROAD–WHEEL RELATIONSHIP: x'=r=-y.

Suppose we have a wheel W, given in polar coordinates in the nonstandard form W(θ)=r(θ)(sin θ,-cos θ), with (0,0) as the specified center. The wheel need not be a closed curve: r(θ) might not be periodic. Assume that r is continuous and defined on a nondegenerate, possibly infinite, interval I containing 0, and r(θ)>0 for each θ. Then W(0)=(0,-r(0)) is directly below the origin; this is taken to be the initial contact point with the road.

We wish to consider wheels that roll smoothly along a road in that the center of the wheel moves neither up nor down. If the wheel is used on a vehicle such as a bicycle or cart, we do not want the vehicle to bounce up and down. The center can be the geometrical center of the wheel, but it can also be any point that rides along with the wheel. A wheel rolling smoothly along a road from left to right undergoes clockwise rotation around its center followed by horizontal translation as the contact point moves along the road. The horizontal condition enforces the smoothness property. If the center is the physical center of gravity of the wheel, then the smooth rolling means that no work will be done against gravity during the rolling. This can be important: the 27,000-pound square-wheel bridge at Cody Dock in East London can be rolled along giant catenaries, by hand, into an upside-down position so that a boat can pass beneath it [].

Suppose that the wheel has rotated by an angle ϕ and let τ(ϕ) be the horizontal displacement associated with this rotation. Then if P is any point on the wheel, its position during rolling is (Subscript[σ, P])(ϕ)=M(ϕ)·P+(τ(ϕ),0), where M(ϕ)=(({{cos ϕ, sin ϕ}, {-sin ϕ, cos ϕ}})) is the matrix for clockwise rotation by ϕ. Now let ρ(θ) denote the rotation angle required for a point P=W(θ) to come into contact with the road (Figure ). After the corresponding rotation and translation, the position of P becomes (Subscript[σ, P])(ρ(θ))=M(ρ(θ))·P+(τ(ρ(θ)),0). To summarize, rolling requires the existence of two functions, ρ(θ) and τ(ϕ), where the domain of ρ is the interval I, ρ(0)=0, the domain of τ is the codomain of ρ, ρ is continuous, and τ is differentiable. We then impose only the following single condition, which will suffice to derive the shape of the road. The main point is that the condition implies that ρ(θ)=θ.

mxy=FindMaximum[((Sqrt[17])-Cos[2 ArcCot[(1/4) (1+(Sqrt[17])) Cot[2 θ]]]) Sin[θ], {θ}][[1]];
mxx=((Sqrt[17])-Cos[2 ArcCot[(1/4) (1+(Sqrt[17])) Cot[2 θ]]])Cos[θ]/. FindMaximum[((Sqrt[17])-Cos[2 ArcCot[(1/4) (1+(Sqrt[17])) Cot[2 θ]]]) Sin[θ], {θ}][[2]];
Module[{rad, wheel,θ,x,ffffff,road, θFcn , r},
fTemp[x_] := Cos[x]-(Sqrt[17]);
rTemp[θ_]:=((Sqrt[17])-Cos[2 ArcCot[(1/4) (1+(Sqrt[17])) Cot[2 θ]]]);
f[xx_]:=Cos[xx]-(Sqrt[17]);

road=Plot[f[xx],{xx,0,2.6},PlotStyle->{AbsoluteThickness[2], Blue}];
road1=Plot[f[xx],{xx,2.6,4.5 π},PlotStyle->{AbsoluteThickness[1.4], Blue, Dashed}];
temp=θFcn=θ[x] /. NDSolve[{θ'[x]==-1/f[x], θ[0]==-π/2},θ[x],{x,0,8 π}][[1]];
r[xx_]:=-f[xx] {Cos[θFcn],Sin[θFcn]}/. x-> xx;
wheelPts=Table[((Sqrt[17])-Cos[2 ArcCot[(1/4) (1+(Sqrt[17])) Cot[2 θ]]]){Cos[θ], Sin[θ]}, {θ, 0, 2π,.01}];
rad = 0.175 0.6;
im1=Show[road,road1,
Graphics[{{EdgeForm[{AbsoluteThickness[2],Orange}],FaceForm[Lighter@White],
{Polygon[wheelPts]},
LL={Blue, Line[{r[0],r[2.6]}]};LL={},
AbsoluteThickness[1], Line[{{2.6,0},{2.6,f[2.6]}}];Line[{{0,0},r[2.6]}], Line[{{0,0},{0,-π}}],{}},
{AbsoluteThickness[1],AbsoluteDashing[{5,3}],Black, Line[{{0,0}, {11,0}}]},
{{{ef=EdgeForm[AbsoluteThickness[0.7]], Disk[#, rad]}}&/@ {r[2.6],{0,f[0]},{2.6,f[2.6]} },
Black,{ef,FaceForm[GrayLevel[1]],Disk[#1,rad]}&/@{{0,0}}},
     Text["W", {-2.49,2.4}],Text["r(θ)", {1.98, -1.7}, {0,0}, {1, -1.2}],Text["θ",{0.256,-.9}],Text["P", {3.4, -4.33}];Text["P",{3.5,-4.3}],Text["r = r (θ)",{3.85,1.2},{-1,0}];{}}],
AspectRatio->Automatic,Axes->False,PlotRange->(pr={{-4.4,10},{-6.15,5.5}}),BaseStyle->{FontFamily->"Times",10},
PlotRangePadding->0,ImageSize-> 300,
FrameTicksStyle->10,FrameTicks->{{0,4,8, -4},{-4,0,4}, {},{}}, Frame->True];
rule= {x_?NumericQ, y_?NumericQ}:>(RotationMatrix[-.661].{x,y}+{2.6,0});
im2 = Show[Graphics[{dL={Dashed,AbsoluteThickness@1, Line[{{-mxx, mxy}, {8,mxy}}],
α=π-(π/2-θFcn[[0]][2.6]);
rr=RotationMatrix[-α];
Line[{rr.{-mxx, mxy}+{2.6,0},rr. {4,mxy}+{2.6,0}}]}}];road,road1,
Graphics[{{EdgeForm[{AbsoluteThickness[.78], Orange}],
FaceForm[],EdgeForm[AbsoluteThickness[.85]],Polygon[wheelPts]},
{EdgeForm[{AbsoluteThickness[1.5],Black}],FaceForm[],
{AbsoluteThickness[15],EdgeForm[{AbsoluteThickness[2],Orange}],CapForm[None],
 LL,Polygon[wheelPts]}/. rule,
AbsoluteThickness[1], Line[{{2.6,0},{2.6,f[2.6]}}],Line[{{0,0},r[2.6]}]; Line[{{0,0},{0,-π}}];{}},
{AbsoluteThickness[1],AbsoluteDashing[{5,3}],Black, Line[{{0,0}, {11,0}}]},
{{{ef=EdgeForm[AbsoluteThickness[0.7]], Disk[#, rad]}}&/@ {r[2.6];{2.6,f[2.6]}, {0,f[0]}/. rule },
Line[{{0,0}, {0, -rTemp[-π/2]}}/. rule],Red,{ef,FaceForm[GrayLevel[1]],Disk[#1,rad]}&/@{{2.6,0}}},
        Text["r(θ)", {3.07, -2.3}, {0,0}, {0,-1}],
Text["(Subscript[σ, ρ (θ)])(P)",{1.41,-5.5}],
Text["τ(ρ(θ))", {1.3, .38}],
Text["θ",{2.35,-0.97}],
Text["ρ(θ)", {5.87, 3.4}],
dL,

{FaceForm[White],EdgeForm[AbsoluteThickness[.7]],Disk[{0,0}, rad], FaceForm[Black],Disk[{0, f[0]},rad]}}],
AspectRatio->Automatic,Axes->False,PlotRange->pr,BaseStyle->{FontFamily->"Times",10},
PlotRangePadding->0,ImageSize-> 300,
FrameTicksStyle->10,FrameTicks->{{0,4,8,-4},{-4,0,4}, {},{}}, Frame->True]];
GraphicsRow[{im1, im2}, ImageSize-> 600]

The No-slipping Condition.  During rolling at constant angular speed, each point on the wheel instantaneously stops when it is a contact point. That is, for each P=W(θ), (Subscript[σ, P]^′)(ρ(θ))=(0,0).

The following result gives the location of the contact point, which defines the appropriate road for the given wheel. The concise form of the formula is nice, but not really surprising. The road must conform to the shape of the wheel and, if we accept the aforementioned equilibrium property, that explains y=-r. The horizontal distance traveled by a rolling object is proportional to the radius—a larger bicycle wheel moves faster than a smaller one for the same amount of pedalling—and that explains x'=r.

Theorem.  When a wheel W rolls smoothly along a road, the contact point of W(θ) as the wheel rolls is ((∫_0^θ)r(t)dt,-r(θ)).

Proof.  We use these simple facts: M'(ϕ)=M(ϕ+(π/2)); M(ϕ+(π/2))·(0,b)=M(ϕ)·(b,0); M(α)·M(β)=M(α+β); and W(θ)=M(-θ)(0,-r(θ)). By the no-slipping condition,

(0,0)=(Subscript[σ, W(θ)]^′)(ρ(θ))=M'(ρ(θ))·W(θ)+(τ'(ρ(θ)),0)
    =M(ρ(θ)+(π/2))·M(-θ)·(0,-r(θ))+(τ'(ρ(θ)),0)=M(-θ)·M(ρ(θ)+(π/2))·(0,-r(θ))+(τ'(ρ(θ)),0)=M(ρ(θ)-θ)·(-r(θ),0)+(τ'(ρ(θ)),0).

To preserve the 0 in the y-coordinate, the rotation in M(ρ(θ)-θ) must be through either 0 or π; therefore ρ(θ)=θ+n π. But ρ is continuous and ρ(0)=0, so ρ(θ)=θ. This means that the contact point is M(θ)·W(θ)+(τ(θ),0)=M(θ)·M(-θ)·(0,-r(θ))+(τ(θ),0)=(τ(θ),-r(θ)), which proves the y-coordinate of the theorem. Because ρ(θ)=θ, the x-component of the vanishing derivative is τ'(θ)-r(θ) so τ'(θ)=r(θ), which, because the contact point’s x-coordinate is τ(θ), yields the desired integral.  □

The theorem implies that the road must have the form ((∫_0^θ)r(t)dt,-r(θ)). It is easy to see that this parametrized curve works. Just set ρ(θ)=θ and τ(ϕ)=(∫_0^ϕ)r(t)dt; then

(Subscript[σ, W(θ)]^′)(ρ(θ))=(Subscript[σ, W(θ)]^′)(θ)=M(θ-θ)·(-r(θ),0)+(τ'(θ),0)=(-r(θ),0)+(r(θ),0)=(0,0).

From now on, we use (x(θ),y(θ)) for the road for a polar wheel given by r(θ); then (x(θ),y(θ))=((∫_0^θ)r(t)dt,-r(θ)). A more useful description is that x(0)=0, x'(θ)=r(θ), and y(θ)=-r(θ). This formulation allows x(θ) to be obtained by solving a differential equation, often numerically; see Example 7 below. Moreover, x(θ) is differentiable and strictly increasing, which means that its inverse function θ(x) exists, is differentiable, and satisfies θ'(x)=1/r(θ).

Corollary.  (a)  The road on which a polar wheel rolls smoothly has the functional form y=-r(θ(x)), where θ'(x)=-1/r(θ) and θ(0)=0.

(b)  When a wheel smoothly rolls along a road, the center stays directly above the contact point.

(c)  If the wheel is piecewise continuously differentiable, then so is the road and the arc lengths from the initial contact point to any other contact point are equal.

(d)  If the wheel is piecewise differentiable, then so is the road and the slopes of each at any point of contact where the slopes exist are equal.

Proof.  (a)  This is immediate because θ(x) exists and is monotonic and differentiable, x'(θ)=r(θ), and y(θ)=-r(θ).

(b)  The center after rolling is at (τ(θ),0), which, by the proof, equals (x(θ),0), directly above the contact point (x(θ),y(θ)).

(c)  Work on the intervals corresponding to the piecewise property. Because (x'(θ),y(θ))=(r(θ), -r(θ)), the road is piecewise continuously differentiable. Within each such interval we have x'(θ)=r(θ)=-y(θ), which means ((x'(θ))^2)+((y'(θ))^2)=((r(θ))^2)+((r'(θ))^2) and the integrals of the square roots of these continuous functions give the arc lengths.

(d)  Differentiability is as in (c). Working at the points of differentiability and using the theorem, ((dy)/(dx))=((dy/dθ)/(dx/dθ))=-((r'(θ))/(r(θ)). And, using ρ(θ)=θ, the slope of the appropriately rotated wheel is the quotient of the terms in M(θ)·W'(θ)=(-r(θ),r'(θ)). This proves equality of slopes.  □

The literature [, ] derives the road equations by assuming various other conditions (the arc lengths up to the contact point match, the slopes at a contact point match, the center stays directly above the contact point). The corollary shows that these conditions all follow from the no-slipping condition. However, because r need not be differentiable, the arc length of the road might not exist (as in Example 7 below). We have this open question: If we assume only that the wheel is rectifiable, is it true that the road is rectifiable and the arc lengths to the contact point match? Note that the no-slipping condition is equivalent to the assertion that the instantaneous rolling motion is always a clockwise rotation around the point of contact.

The theorem also solves the inverse problem. Given a road y=f(x) whose graph is below the x-axis, find the wheel (with center at the origin) that will roll smoothly along it. By part (a) of the corollary, we seek a positive function r such that if we define x(θ)=(∫_0^θ)r(t)dt and let θ(x) be its inverse function (which exists because x is increasing), then -r(θ(x))=f(x) for all x. Replacing x by x(θ), we get f(x(θ))=-r(θ)=-x'(θ). The differential equation x'(θ)=-f(x(θ)) together with the initial condition x(0)=0 can be solved numerically or symbolically. Once we have x(θ), we get the wheel in polar form from r(θ)=-f(x(θ)). The corresponding road is then -r(θ(x))=f(x(θ(x)))=f(x) as required. See Examples 3 and 4.

.  EXAMPLES.

Here we present several examples of the method that yields a road for a wheel, or vice versa. Many more can be found in [, ].

1.  Road for a straight line and a square.

Consider the wheel that is the straight line y=-1, with center at (0,0); because sec θ (sin θ,-cos θ)=(tan θ,-1), the polar form of the line is r(θ)=sec θ, with -π/2<θ<π/2. Then, using u=sin θ, the theorem gives

x=∫ sec θ dθ=∫((cos θ)/(1-(sin^2)θ))dθ=∫(1/(1-(u^2)))du=(tanh^(-1))u; and

y=-sec θ=-sec((sin^(-1)) u)=-(1/(Sqrt[1-(u^2)]))=-(1/(Sqrt[1-(tanh^2)x]))=-cosh x.

Thus the road is an inverted catenary; see Figure . Remarkably, the connection between the line and catenary was first discovered by James Clerk Maxwell, who included it in his 1849 paper [], published when he was 18 years old.

Module[{road,B,EE, xFunc, endx1, endx2, xmin,blue, α, wheelPolar,symForxRound,symForxStraight,imageCatenary, θSol,auto, x,cen,tangentPt, corner,θ1,b,θ, xFuncPart,t,ρ, tangentPtOrig},
blue=RGBColor[0.3, 0.5, 1];
α=ArcSinh[1];
B[b_] := ArcCot[1-b];
wheelPolar[b_][θ_?NumericQ]:=With[{θ1=Mod[θ,π/2,-(π/2)],c=(Sqrt[2])(1-b)},
Which[-(π/2)<=θ1≤-B[b],-Csc[θ1],-B[b]<θ1<B[b]-(π/2),corner[b,θ1],B[b]-(π/2)<=θ1<0,Sec[θ1]]];
corner[b_,θ_]:=(Sqrt[2])(1-b)Cos[(π/4)+θ]+(Sqrt[(b^2)-2(((1-b))^2)((Sin[(π/4)+θ])^2)]);
auto={Automatic,Automatic,{},{}};
EE[θ_,b_]:=If[b==0,0,b EllipticE[θ,((2 (((1-b))^2))/(b^2))]];
symForxStraight[θ_]:=Log[-Cot[(θ/2)]];
symForxRound[b_][θ_]:=EE[(π/4)+θ,b]-EE[(π/4)-B[b],b]+((1-b)/(Sqrt[2-2b+(b^2)]))(b+(Sqrt[2-2b+(b^2)])(Cos[θ]+Sin[θ]))+ArcSinh[1-b];
endx1[b_]:=symForxStraight[-B[b]];endx2[b_]:=symForxRound[b][B[b]-(π/2)];xFuncPart[b_][θ_]:=Which[-(π/2)≤θ≤-B[b],symForxStraight[θ],-B[b]<θ≤B[b]-(π/2),symForxRound[b][θ],B[b]-(π/2)<θ≤0,endx1[b]+endx2[b]+symForxStraight[θ-(π/2)]];

xFunc[b_][θ_?NumericQ]:=Quotient[θ+(π/2),(π/2)]xFuncPart[b][0]+xFuncPart[b][Mod[θ,(π/2),-(π/2)]];
(* extension of x[θ] to the whole real line, using the fact that the increment is the same on each interval of length π/2 *)

xmin[b_]:=xFunc[b][-(π/4)];
xLine=Assuming[-(π/2)≤θ<0,(∫_(-(π/2))^θ)-Csc[t]\[DifferentialD]t/. ρ->θ];
θSol[f_, {tmin_, tmax_}]:=θSol[f]=θ[t]/.First[NDSolve[{θ[0]==-(π/2),θ'[t]==-(1/(f[[2]]))},θ[t],{t,tmin,tmax}]];
road[yfunc_] :=road[yfunc]=Plot[yfunc,{t,-10,30},PlotStyle->{blue=RGBColor[0.3,0.5,1],AbsoluteThickness[2]}];
imageCatenary[xval1_]:= Module[{f, tmin, tmax, xval,transform,pp},(f=-Cosh[t];{tmin, tmax}= {-4,4};
 xval = Max[Min[xval1, 3],-3];θS=θSol[{t,f}, {tmin, tmax}];
transform[pt_, tval_]:= TranslationTransform[{tval,0}][RotationTransform[-(π/2)-θS/.t->tval][pt]];
Show[pp=ParametricPlot[Evaluate[transform[-f {Cos[θS],Sin[θS]}/. t->tt,xval]],{tt,tmin,tmax},PlotStyle->{Black, AbsoluteThickness[2]}, PlotPoints->50],

Graphics[{{pp={FaceForm[Lighter@Orange], EdgeForm[], Polygon[{{-10, -1}, {10, -1}, {10,10}, {-10,10}}]};
pp/. {x_, y_?NumericQ}:> transform[{x,y},xval],
FaceForm@blue,EdgeForm[AbsoluteThickness[1]],Cases[Normal[road[f]], Line[z_]:> Polygon[z],∞]},{AbsoluteThickness[.75], blue=RGBColor[0.3,0.5,1], 
AbsoluteDashing[{4,2}],
Black, Line[{{-5,0}, {7,0}}]},AbsolutePointSize[5], Point[cen={xval,0}],
tangentPt=-f {Cos[θS],Sin[θS]}/. t-> xval; 
tangentPtOrig={0,f }/. t-> 0; 
Point[transform[tangentPt,xval]],
Point[{xval,0}+RotationTransform[-(π/2)-θS/.t->xval][tangentPtOrig]],
Line[{cen,transform[ tangentPtOrig,xval]}]}],
PlotRange->{{-5, 7}, {-7, 1.35}},Axes->False,PlotRangePadding->None,AspectRatio->Automatic,
FrameTicks->{Range[0,10,5], {-5,-1,0}, {},{}},
ImageSize->250,Frame->True, BaseStyle->{10,FontFamily->Times},Axes->False])];
Show[GraphicsRow[{imageCatenary[0], imageCatenary[ArcSinh[1]],imageCatenary[2ArcSinh[1]]}], ImageSize-> 420]]

Now we can truncate the line to (Abs[x])≤1 and rotate it to form a square centered at the origin. If we then truncate the catenary to  (Abs[x])≤(sinh^(-1)) 1 (each slope angle is then 45° from vertical at the ends) and form an infinite track by translating the arches, we will have a road on which a square can roll smoothly (Figure ).

blue=RGBColor[0.3, 0.5, 1];
α=ArcSinh[1];
xFull[θ_]:=If[-3 π≤4θ<-π,Log[-Cot[(θ/2)]],2 α+xFull[θ-(π/2)]];
Show[pp1=Plot[-Cosh[x]-.002,{x,-α,α}];pp2=ParametricPlot[{x,-Cosh[x]-.002}-0.06  Normalize[{Sinh[x],1}],{x,α,-α}];
gg=Graphics[{LL1=Join@@Cases[Normal[pp1],Line[z_]:>z,∞];LL2=Join@@Cases[Normal[pp2],Line[z_]:>z,∞];polygonCatenary={FaceForm[blue], Polygon[LL2],FaceForm[Black],EdgeForm[{AbsoluteThickness[1]}],ppp=Polygon[Join[LL1,Reverse[LL2]]]};Table[polygonCatenary/. {x_,y_?NumericQ}:>{x+2 i α,y},{i,0,2}]}],
Graphics[{{{square=
{{EdgeForm[{Black,AbsoluteThickness[2]}],FaceForm[{Opacity[0.33],RGBColor[1,0.8,0.4]}],Rectangle[{-1,-1},{1,1}]}}},tt=Table[GeometricTransformation[GeometricTransformation[square,RotationTransform[θθ=((π i)/(3 4));-θθ]],TranslationTransform[{xFull[θθ-(π/2)],0}]],{i,0,12}]};
{points={AbsolutePointSize[5], Point[{0,0}]},tt1=Table[GeometricTransformation[GeometricTransformation[points,RotationTransform[θθ=((π i)/(3 4));-θθ]],TranslationTransform[{xFull[θθ-(π/2)],0}]],{i,0,12}]};
Most[tt],Last[tt]/. Opacity[_]:>Opacity[1]/. FaceForm[_]:>FaceForm[Orange],
{AbsoluteDashing[{4,2}];White, AbsoluteThickness[3],Line[{{0,0},{4 α+.5,0}}]},tt1,
{FaceForm[blue],EdgeForm[], Rectangle[{-ArcSinh[1], -1.68}, {5 ArcSinh[1], mm=Min[Last/@ LL2]}]},
{AbsolutePointSize[6], FaceForm@blue, EdgeForm[], qq=Polygon[{LL1[[-1]], LL2[[-1]], {2 ArcSinh[1]-LL2[[-1,1]],LL2[[-1,2]]}}],
 qq/. {x_, y_?NumericQ}:> {x+ 2 ArcSinh[1],y},
FaceForm@Black, Polygon[{{LL1[[1]],{LL1[[1,1]],mm},LL2[[1]]},
{{4α-LL1[[1,1]],LL1[[1,2]]},{4α-LL1[[1,1]],mm},{4α-LL2[[1,1]],mm}}

}]}}],Frame->True,ImageSize->380,AspectRatio->Automatic,Axes->False,PlotRange->{{-1.2,5 α+0.3},{-1.68,1.6}},PlotRangePadding->0,BaseStyle->{10,FontFamily->Times},FrameTicks->{{0,{α,"(sinh^(-1)) 1"},{3 α,"3 (sinh^(-1)) 1"},{5 α,"5 (sinh^(-1)) 1"}},{-(Sqrt[2]),-1,0,1},Range[0,4],{}}]

As one pedals a square-wheel vehicle at constant angular speed the forward motion is not constant. More precisely, the connection is given by the nonlinear function x=(cosh^(-1))(sec θ). Figure  shows how x varies with θ.

Plot[{ArcCosh[Sec[θ]],θ},{θ,0,π/4},Frame->True,PlotStyle->{{Blue},{Orange,AbsoluteThickness[1],AbsoluteDashing[{4,4}]}},FrameTicks->{{{0,{ArcSinh[1], "(sinh^(-1))1"}},{π/4}},{{π/4,0,1/2},{}}}, BaseStyle->{FontFamily->Times, 10}, Epilog -> Text["x(θ)",{.65,.8}], ImageSize-> 270]

The preceding idea extends to any wheel that is a regular polygon, but there is one important distinction that arises. A triangular wheel will crash into the road before it reaches the cusp (Figure ). From a purely geometrical viewpoint there is nothing wrong and a similar situation where collisions are simply ignored arises in Example 7: a continuous but nowhere differentiable wheel.

V={(Sqrt[3]),-1};
tri={V{-1,1},V, {0, (-1+(Sqrt[3])/2 2(Sqrt[3]))}};
Solve[-Sinh[x]== -(Sqrt[3]), x]//N;
β=0.65488; th=.9;
M[ϕ_]:= RotationMatrix[-ϕ];
τ[ϕ_]:=ArcCosh[Sec[ϕ]];
locusL[ϕ_]:= M[ϕ].V+{τ[ϕ],0};
locusCurve=ParametricPlot[locusL[ϕ], {ϕ,0,π/3},PlotRange->All,PlotStyle->{AbsoluteThickness[1], Dashed, Black}];
 Show[locusCurve,road={Plot[-Cosh[x], {x, - ArcSinh[(Sqrt[3])], ArcSinh[(Sqrt[3])]}, PlotStyle->{AbsoluteThickness[th], Blue}],p2=ParametricPlot[{x+2 ArcSinh[(Sqrt[3])], -Cosh[x]}, {x, - ArcSinh[(Sqrt[3])], ArcSinh[(Sqrt[3])]},PlotStyle->{AbsoluteThickness[th], Blue}]}; 
 Graphics[{{Orange,FaceForm[], EdgeForm[Orange], Polygon[tri]},
EdgeForm[AbsoluteThickness[.8]], FaceForm[Orange],Opacity[.5], Polygon[tri];
Polygon[tri1=tri/. {x_, y_}:>M[β].{x,y}+{ArcCosh[Sec[β]],0}],{AbsolutePointSize[5],Point[{0,-1}]; 
Point[{{0,-1}, tri1[[2]]}],Point[locusL/@ {0, π/3}],Point[{ArcCosh[Sec[β]],-Sec[β]}]}}], road,PlotRange->{{-.07, 1.8}, {-2.03, -.9}},  AspectRatio->Automatic, Frame->True, PlotRangePadding->None, Axes->False, BaseStyle->{FontFamily->Times,10}, ImageSize-> 370,PlotRangeClipping->True, FrameTicks->{{{-1, -1.5,-2},{}},{{-1, 0,1, 1.5},{}}}, PlotLabel-> (Area[RegionIntersection[Triangle@tri1, Polygon[Cases[Normal[p2], Line[z_]:> z, ∞]]]]; None)]

The many and varied models provide physical proof that the square can roll freely, but a mathematical proof should be provided as well, giving certainty to the fact that a collision as in the triangular case does not happen for a square.

Proposition XX.  A square rolls on linked catenaries with no collision.       [A.S. Note that here we are talking about both local and global collisions, but no need to say. Should we mention pentagons, etc? Relevant to later. Mention later as exercise? But if we give as exercise we need the proof written down for ourselves. Obvious? Maybe it follows from the square case somehow?]

M[x_]:=RotationMatrix[-x];pz=AbsolutePointSize[4];
τ[θ_]:=ArcCosh[Sec[θ]];
pz=3.8;
xVal=ArcSinh[1];
arcLength[x_]:=Sinh[x];
α=arcLength[xVal];
V={α,-1};
ϕVal = π/4;
locus= M[ϕ].V+{τ[ϕ],0};
xx=ArcSinh[1];
im=Show[Graphics[{AbsolutePointSize[pz],{Cyan,Line[{P={xVal, -Cosh[xVal]}, {xVal, -Cosh[xVal]}+1}]},
GeometricTransformation[GeometricTransformation[{FaceForm[],Point[{0,0}], EdgeForm[{AbsoluteThickness[1.5],Orange}], Rectangle[{-1, -1}, {1, 1}], Point[{0,-1}]}, RotationTransform[-ϕVal]], TranslationTransform[{τ[ϕVal],0}]]}],

ParametricPlot[M[ϕ].{1, -1}+{τ[ϕ],0}, {ϕ, 0, π/4}, PlotStyle-> {AbsoluteThickness[1.5],Red}],Graphics[{Text["P", P+{-.095, -.045}],Text["Λ", {.92,-1.2}],AbsolutePointSize[pz], Point[{{0,-1}, {xVal, -Cosh[xVal]},{1,-1}}],
AbsoluteThickness[2], Darker@Green,Line[{{xVal, -Cosh[xVal]}, {xVal, -Cosh[xVal]}+1}]}],
Plot[-Cosh[x], {x, -ArcSinh[1], ArcSinh[1]}, PlotStyle->{AbsoluteThickness[1.5],Blue}], 
ParametricPlot[{x, -Cosh[x-2 ArcSinh[1]]}, {x,  ArcSinh[1], 3 ArcSinh[1]}, PlotStyle->{AbsoluteThickness[1.5],Blue}],Frame->True, PlotRange-> {{-.8,1.7}, {-1.55, .1}},ImageSize->240, AspectRatio->Automatic, PlotRangeClipping->True, GridLines-> {{xVal,xx};{}, {-1,0}}, BaseStyle->{FontFamily->Times, 9}, FrameTicks->{{{-Sqrt[2],0,-1},{}},{{-1,0,2,1},{}}}]

Proof.  Let (Subscript[M, ϕ]) and τ be as above. Let V be the vertex of the square that is initially at (-1,1) and restrict consideration to the bottom edge of the square and to 0≤ϕ<π/4; let P be the cusp at ((sinh^(-1))1,-(Sqrt[2])). The locus of V during the rolling is Λ=(Subscript[M, ϕ])·V+(τ(ϕ),0)=(cos ϕ-sin ϕ+(cosh^(-1))(sec ϕ),-sin ϕ-cos ϕ). The second arch of the road stays under the tangent line to this arch P (see Figure ). But the locus of V is above this line because the dot product (Λ-P)·(1,1)=((Sqrt[2])-2 sin ϕ)+((cosh^(-1))(sec ϕ)-(sinh^(-1))1) is positive;  the first two summands add to a positive number, as do the last two.

One must also show that no point on the square other than vertex V can crash into the road. Let Q be a point on the bottom edge of the square. Then Q cannot collide with the first arch because it lies on a tangent line to the arch (by Corollary (d)). And Q cannot collide with the second arch because V does not collide and V would have to crash through first. (Let L be the line through V perpendicular to VQ. Move L parallel to itself to L', tangent to the arch; the arch is entirely below L' while LP is above it.) It follows from symmetry that the other edges never collide with the road.  □

We next prove that the right angle is the critical angle: any acute angle leads to a collision,

Proposition XX.  The vertex of an acute angle rolling on linked catenaries passes below the road for an interval around the cusp.

M[x_]:=RotationMatrix[-x];pz=AbsolutePointSize[4];
xVal=ArcSinh[λλ=1+4/10];
arcLength[x_]:=Sinh[x];
α=arcLength[xVal];
V={α,-1};
locus= M[ϕ].V+{τ[ϕ],0};
locus1=locus/. {x_, y_}:> {2 xVal-x, y};
τ[θ_]:=ArcCosh[Sec[θ]];
ρ=ArcTan[λλ];
ang=2 ArcTan[- D[-Cosh[x],x]/. x-> xVal];
ang/2. /Degree;
(π- 2 ArcTan[- D[-Cosh[x],x]/. x-> xVal])/Degree//N;
P=locus/. ϕ ->ang/2;
wheel={{{pz,Point[{0,0}]; Point[{0,-1}]},Orange,AbsoluteThickness[1],  Line[{VV={0,-1}, β={α, -1}, ββ=β+α  {-Cos[π-ang],Sin[π-ang]}}]},Point[ββ]};
{"Ang", PlanarAngle[{{-α,-1}, β, ββ}]/Degree//N, 2 ArcCot[1.+3/10]/Degree};
(*
intVal=ϕ/.Chop[FindRoot[{locus[[1]]==τ[ϕ1],locus[[2]]==-Cosh[τ[ϕ1]-ArcSinh[λλ]]},{ϕ,0.1,3},{ϕ1,0.1,3}]]//Re//Quiet
FindAllRoots2D[{locus[[1]]-τ[ϕ1],locus[[2]]+Cosh[τ[ϕ1]]},{ϕ,0,3},{ϕ1,0,3}, PlotPoints->100] 
intPoint= locus/. ϕ-> intVal;*)
intVal=FindAllRoots2D[{locus[[1]]-(x+2 ArcSinh[λλ]),locus[[2]]-(-Cosh[x])},{ϕ,0,1.5},{x,-1.5,0}, PlotPoints->200] [[1,1]];
intPoint= locus/. ϕ-> intVal;

wCCCheel/. {x_, y_?NumericQ}:> M[ϕ].{x,y}+{τ[ϕ],0};
im=Show[Plot[-Cosh[x],{x, -xVal, xVal}, PlotStyle->{Blue}], ParametricPlot[{x, -Cosh[x- 2 xVal]},{x,  xVal,3 xVal}, PlotStyle->{Blue}],
ParametricPlot[locus, {ϕ, 0, ang/2}, PlotStyle->Red],
Graphics[{ {Text["λ", {1/2, -1.27}],Text["V", {λλ+.1, .08-1}],Text["P", P+{-.1, -.095}], Text[Style["ρ",12], P+{0,.24}]},
DeleteCases[wheel,ddd|(Point[{0,0}]), ∞], dw=wheel/. {x_, y_?NumericQ}:> M[ang/2].{x,y}+{τ[ang/2] ,0},{Red; pz,Point[intPt=locus1/. ϕ ->intVal];Point[{P,V, {0,-1}}]}}],  PlotRange->{{-.2,2.6}, {-2, .45}}, Frame->True, PlotRangePadding->None, AspectRatio->Automatic, GridLines->{{xVal; 0},{-Cosh[xVal]};{}}, Axes->False, FrameTicks-> {{{-2,-1, {-Cosh[xVal],"-(Sqrt[1 + 13 (λ^2)])"};0}, {}},{{-2,-1,0,2,{P[[1]], "(sinh^(-1)) λ"}},{}}},
BaseStyle->{12,FontFamily->Times}];
im1=Show[Plot[-Cosh[x],{x, -xVal, xVal}, PlotStyle->{CapForm->None,AbsoluteThickness[8],Blue}], ParametricPlot[{x, -Cosh[x- 2 xVal]},{x,  xVal,3 xVal}, PlotStyle->{CapForm->None,AbsoluteThickness[8],Lighter@Lighter@Blue}],
ParametricPlot[locus, {ϕ, 0, ang/2}, PlotStyle->Red],
Graphics[{ {Text["P", P+{-.1, -.095}], Text[Style["ρ",12], P+{-.02,.24}]}, wheddel/.Orange->Green/. {x_, y_?NumericQ}:> M[intVal].{x,y}+{τ[intVal] ,0},{ pz,Point[intPt=locus1/. ϕ ->intVal];Point[{P,V, {0,-1}}]}}],  PlotRange->{P[[1]]+2{-.008,.05}/3,  P[[2]]+2/3{-.004,.05}}, Frame->True, PlotRangePadding->None, AspectRatio->Automatic, GridLines->{{xVal, 0},{0,-Cosh[xVal]}}, Axes->False, FrameTicks-> {{Range[-2,2], {{-Cosh[xVal],"-(Sqrt[1 + (λ^2)])"}}},{Join[Range[-2,2], {{λλ, "λ"}}],{{P[[1]], "(sinh^(-1)) λ"}}}},
BaseStyle->{12,FontFamily->Times}];
im2=Show[Graphics[wheel/. {x_, y_?NumericQ}:> M[intVal].{x,y}+{τ[intVal] ,0}],DeleteCases[im,Text[___]|dw, ∞],Graphics[{AbsolutePointSize[5], Point[intPoint]}], PlotRange->{intPoint[[1]]+2{-.1, .1},intPoint[[2]]+2{-.1, .1}}, FrameTicks->Automatic, Frame->True, PlotRangeClipping->True];
Show[GraphicsRow[{im, (*Show[im1, Graphics[{Text["slope λ", P+{.0025,.0082}, {0,0}, {1,1.32}],Text["slope 1/λ", P+{.0093, .0014}]}],FrameTicks-> {{Range[-2,2], {{-Cosh[xVal],"-(Sqrt[1 + (λ^2)])"}}},{Join[Range[-2,2], {{λλ, "λ"},{P[[1]], "(sinh^(-1)) λ"}}],{}}}, ImageSize-> 250, GridLines->None]; *)
Show[im2, BaseStyle->{12,FontFamily->Times},ImageSize-> 200,GridLines->None, FrameTicks-> {{{-1.7, -1.4}, {}},{{1.1, 1.3}, {}}}]}, Alignment->Bottom], Frame->!True, ImageSize-> 500,FrameTicks->True, PlotRange->{{5,600}, {-330, -5}}, PlotRangePadding->None]

Figure .   A rolling acute angle crashes through the road.

Proof.  Consider a wheel that is an acute angle ρ with vertex V. Suppose it rolls into a cusp of angle ρ at P=(x,-cosh x) between two congruent catenaries (Figure ). If λ is the arc length of the catenary from (0,-1) to P, then the slope of the catenary at P is -λ and 2(cot^(-1))λ=ρ<π/2 which means λ>1. The locus of V as the angle rolls into the cusp is the involute of the first catenary from anchor point (0,-1). Therefore the locus makes a right angle with the catenary at P. reference?The slope of the catenary at P is -λ and so the slope of the locus at P is 1/λ, which is less than λ, the slope of the second catenary. Therefore an interval of the locus of V near P lies below the second catenary, implying the desired collision. To avoid the involute result, just compute the slope of the locus directly from (Subscript[M, ϕ])·V+(τ(ϕ),0); it is cot ϕ, which gives 1/λ when ϕ is the rotation angle (π-ρ)/2.  □

The method that avoids the involute result is perfectly correct. Putting both in the preceding ¶ seems reasonable.

Do obtuse case also to make this IFF.  We did the right angle. Maybe that handles obtuse as well and both can be combined into one result? Note that this proof talks only about the slope of the catenary and of the locus; no mention of the slope of the straight line that is the wheel. I did not say the center is at the origin. That holds throughout our paper.

A self-contained derivation

It is easy to specialize the theorem to the central case of a line rolling on a catenary, which might be valuable to a teacher wanting to explain only how a square wheel works. Here is a self-contained derivation. Suppose a straight line wheel W(θ) has polar form r=sec θ; assume 0≤θ<π/2 as symmetry handles the negative case. Let ρ and τ be as in the definition of rolling: ρ(θ) gives the clockwise rotation angle for W(θ) to contact the road and τ(ϕ) is the amount of horizontal translation when the wheel rotates through ϕ while rolling. Assume that any point on the line comes to an instantaneous stop when it contacts the road. This means that

M'(ρ(θ))·W(θ)+(τ'(ρ(θ)),0)=(τ'(ρ(θ))-cos(ρ(θ))-sin(ρ(θ))tan θ,sin(ρ(θ)-θ)sec θ)=(0,0).

The vanishing of the y-coordinate implies ρ(θ)-θ=n π, and then θ=ρ(θ) because ρ is continuous and ρ(0)=0. This means the contact point is M(θ)·W(θ)+(τ(θ),0)=M(θ)·M(-θ)·(0,-sec θ)+(τ(θ),0)=(τ(θ),-sec θ). The x-coordinate of the condition must be 0 so, using ρ(θ)=θ, one gets τ'(θ)=sec θ, which implies x=∫sec θdθ. Integration then yields the road y=-cosh x as follows:

x=∫ sec θ dθ=∫((cos θ)/(1-(sin^2)θ))dθ==∫(1/(1-(u^2)))du=(1/2)∫(1/(1+u))-(1/(u-1))du
   =(tanh^(-1))(sin θ)=(cosh^(-1))(sec θ)=(cosh^(-1))(-y).

2.  An infinite loop related to the rolling line.

A very simple self-contained approach to the rolling line is to start with the line and catenary and verify that they work. Assume 0≤θ<π/2; symmetry yields the negative case. Take y=-cosh x=-r(θ) and r(θ)=sec θ; then x=(cosh^(-1))(sec θ). It is then easy to verify that there is no slipping when ρ and τ are properly specified: ρ(θ)=θ and τ(ϕ)=(cosh^(-1))(sec ϕ). This works because:

M(θ)·W(θ)+(τ(θ),0)=(τ(θ),-cosh(τ(θ)),

which shows that there is contact when ρ(θ)=θ, and

M'(θ)·W(θ)+(τ'(θ),0)=(0,0)

which shows that there is no slipping on contact.

Examining the preceding argument, the crux is that, at the contact point, rotational velocity exactly cancels translational velocity in the x-component (it is easy to see that both are 0 in the y-component). The rotational speed is -sec θ and the translational speed is (d/(dθ))(cosh^(-1))(sec θ), so the key property is that f(θ)=sec θ and g(θ)=(cosh^(-1))ϕ satisfy (d/(dθ))g(f(θ))=f(θ). Among the trig functions there is one other case of this phenomenon: (d/(dθ))(cos^(-1))(sech θ)=sech θ. This means that the wheel r=sech θ (-∞<θ<∞), a Poinsot spiral, will roll smoothly on the graph of cos x, restricted to (-π/2,π/2) (Figure ). Here x(θ)=(tan^(-1))(sinh θ). The x-speed approaches 0 as θ->∞, so the wheel’s center never travels beyond x=π/2.

Show[Table[Show[ParametricPlot[RotationMatrix[-ϕ].(Sech[θ] {Sin[θ],-Cos[θ]})+{ArcTan[Sinh[ϕ]],0},{θ,-2 π,5 π},PlotPoints->500,PlotStyle->{AbsoluteThickness[1], Orange}],Plot[-Cos[x],{x,-(π/2) ,(π/2) },PlotStyle->{AbsoluteThickness[2], Blue}],
Graphics[{AbsolutePointSize[2], Point[{{0,0}, {0,-1}}]/. {x_?NumericQ, y_} :> RotationMatrix[-ϕ].{x,y}+{ArcTan[Sinh[ϕ]],0}, Text["r  =  sech θ", {-.3,.2}], Text["y  =  cos x", {.99,-0.65}, {-1, 1}]}],
Plot[-Cos[x], {x, -π, 3π/2}, PlotStyle->{Dashed, Blue, AbsoluteThickness[.6]}], BaseStyle->{FontFamily->Times,10},PlotRange->{{-.6,2.2},{-1,1}},Frame->True, ImageSize->250,PlotLabel->None, Axes->None, GridLines->{{},{0}},FrameTicks->{Range[-5,5]π/2, {-1,0,1}, {},{}}], {ϕ, {0,1.8,3.4}}]]

3.  The inverse square wheel.

Suppose we are given a road defined by the catenary y=-cosh x. Using rotation angle θ, consider this as (x(θ),-cosh(x(θ))). As noted in section 2, the polar wheel is given by r(θ)=-y(x(θ)) where x'(θ)=cosh x(θ). Separation of variables gives θ=2(tan^(-1))(tanh (x/2)) or x(θ)=2(tanh^(-1))(tan(θ/2)). Then r(θ)=-(-cosh(2(tanh^(-1))(tan(θ/2))))=sec θ, the polar form of the line y=-1.

4.  Rolling down a hill.

Suppose the road is the tilted line y=-k x-1. Then x'(θ)=k x(θ)+1, giving x(θ)=((e^(k θ))-1)/k and the wheel is given by r(θ)=-(-k x(θ)-1)=(e^(k θ)). So a logarithmic spiral rolls smoothly down a straight slope (Figure ). This is example 2 in the table in [].

Clear[x,θ,k, wheel];
k=1/2;r[θ_]:=(E^(k θ));
wheel[θ_]:={r[θ]Sin[θ],-r[θ]Cos[θ]};
Simplify[(Sqrt[((((∂_θ)wheel[θ])[[1]])^2)+((((∂_θ)wheel[θ])[[2]])^2)])];
(∫_(-∞)^0)(Sqrt[((5 (E^θ))/4)])\[DifferentialD]θ;
Integrate[(Sqrt[((D[wheel[θ],θ][[1]])^2)+((D[wheel[θ],θ][[2]])^2)]), {θ, -∞, 0}];
DSolveValue[x'[θ]==1+k x[θ]&&x[0]==0, x[θ], θ];

x[θ_]:=Evaluate[∫r[θ]\[DifferentialD]θ-(1/k)];

θ[x_]:=(1/k)Log[1+k x];
{x[0],θ[0], -r[0]};
move[ϕ_,P_]:= RotationMatrix[-ϕ].( P)+{x[ϕ],0}
Show[
rd=ParametricPlot[{x[θ],-r[θ]},{θ,-128,8},PlotStyle->Blue];

Table[ParametricPlot[move[ϕ,(r[θ] {Sin[θ],-Cos[θ]})],{θ,-12,10},PlotStyle->{AbsoluteThickness[1], Lighter@Orange}],{ϕ, 0, 2.4,.4}],
ParametricPlot[r[θ] {Sin[θ],-Cos[θ]},{θ,-12,10},PlotStyle->Orange],
Graphics[{AbsoluteThickness[.8], Table[Line[{move[ϕ,{0,0}], move[ϕ,{0,-1}]}],{ϕ, 0, 2.4,.4}]}],
rd, Graphics[{{Dashed,AbsoluteThickness[.7],Line[{{-2,0},{ 10,0}}]},AbsolutePointSize[ 4.4],Table[Point[move[ϕ,{0,-1}]],{ϕ, 0, 2.4,.4}], 
Table[Point[{x[ϕ],0}],{ϕ, 0, 2.4,.4}]}],
Frame->True,PlotRange->{{-2.3,4.75},{-3,1.5}}, PlotRangeClipping->True,PlotRangePadding->None, BaseStyle->{FontFamily-> Times, 12}, FrameTicks->{{Range[-3,3],{}},{Range[-2,4,2],{}}}, AspectRatio->Automatic, Axes->False, ImageSize-> 300]

We can truncate the road and wheel to make a wheel that smoothly rolls along a sawtooth (Figure ). For four lobes we use the fact that W((π/4)) lies on the 45 ° line to the southwest of the origin. The arc length of the spiral to that point is (Sqrt[2]) ((e^(π/4))-1), and that guides the formation of the teeth forming the road.

Module[{wheel, r, θθ, aL,seg}, 
r[θ_]:=(E^θ);
aL=Integrate[(Sqrt[((r[θ])^2)+((r'[θ])^2)]),{θ,0,θθ},Assumptions->θθ>0];
seg=aL/. θθ-> π/4;
Solve[aL ==(Sqrt[2]), θθ];
wheel[θ_]:={r[θ]Sin[θ],-r[θ]Cos[θ]};
road={Blue,AbsoluteThickness[2],Line[{{-seg/(Sqrt[2]),-1-seg/(Sqrt[2])},{0,-1}, {seg/(Sqrt[2]),-1-seg/(Sqrt[2])}, {2 seg/(Sqrt[2]),-1}, {3seg/(Sqrt[2]),-1-seg/(Sqrt[2])}, {4 seg/(Sqrt[2]),-1}, {5seg/(Sqrt[2]),-1-seg/(Sqrt[2])}}]};
ppBase=Table[{r[θ]Sin[θ],-r[θ]Cos[θ]}1., {θ,0,π/4,π/1000}];
ppBottom=Join[Reverse[ppBase/. {x_, y_}:> {-x,y}], ppBase];
pTop=Reverse@ppBottom/. {x_, y_}:> {x,-y};

Show[
Graphics[{road,wh={Red, Point[ppBottom], Green, Point[ppBottom]/. {x_,y_}:> RotationMatrix[π/2].{x,y},Point[pTop],Point[ppBottom/. {x_Real,y_}:> RotationMatrix[-π/2].{x,y}], Point[{0,0}]};
EdgeForm[{Black, AbsoluteThickness[1.5]}], FaceForm[Orange],wh=Polygon[Cases[wh, {x_Real, y_}, ∞]],


AbsolutePointSize[5],Point[{0,0}],
{wh, Point[{0,0}]}/.  {x_?NumericQ,y_}:> RotationMatrix[ϕϕ=.9;-ϕϕ].{x,y}+{2 seg/(Sqrt[2])+E^ϕϕ-1,0},
{Dashed, AbsoluteThickness[1], 
Line[{{0,0}, {15,0}}]}, Text[Style["r = (e^θ)",12],{5.43,1.3}]}], 
ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, π/4, π/2+1}, PlotStyle-> {Dashed,AbsoluteThickness[1], Black}],
Frame->True,Axes->False, GridLinesStyle->Red,PlotRange->{{-2, 6.2}, {-2.4, 2.3}},PlotRangePadding->None,PlotRangeClipping->True, BaseStyle->{FontFamily->Times, 10}, FrameTicks->{{Range[-2,6], {}},{Range[-2,6], {(E^(π/4))-1, {-(E^(π/4))/(Sqrt[2]),"-(E^(π/4))/(Sqrt[2])"}}}}, GridLines->{{seg/(Sqrt[2]),-(E^(π/4))/(Sqrt[2])}, {}}, ImageSize->380]]

5.  Road for a nonstandard round wheel.

One can consider a wheel that is a circle of radius 1 whose center is taken to be a point on its circumference. Such is given by r(θ)=2 cos θ, with -π/2<θ<π/2. The open interval is used here because the theorem applies only when r(θ)>0. Then x=∫ r(θ)dθ=2 sin θ, so θ=(sin^(-1))(x/2) and y=-2cos θ=-(Sqrt[4-(x^2)]); therefore the road satisfies (x^2)+(y^2)=4 and is a semicircle of radius 2 (Figure ). We can extend the rolling by symmetry to the full circular road, and this corresponds to the classic geometrical fact—known as Tusi’s mechanism and dating from 1247 CE—that when a wheel rolls without slipping inside a wheel twice as large, any point on the circumference of the rolling wheel traces out a diameter of the larger wheel.

Module[{wheel, θθ, xx, yy,r},GT=GeometricTransformation;r[θ_]:=2Cos[θ];
wheel=ParametricPlot[(r[θ]){Sin[θ],-Cos[θ]},{θ,-π/2, π/2},PlotRange->{{-2,2},{-2,2}}, PlotStyle->Orange, Frame->True];
wheel={AbsoluteThickness[3], Orange,Circle[{0,-1}],AbsolutePointSize[4], Black, Point[{0,0}]};
Integrate[r[θ],θ];
θθ[x_]:=ArcSin[x/2];
xx[θ_]:=2Sin[θ];
yy[θ_]:=-r[θ];
yy[θ]/. θ-> ArcSin[x/2]//Together;
Plot[yy[θ], {θ, 0, π/4}];
Show[Graphics[{AbsoluteThickness[2], Orange,wheel, Disk[{-0,-1}],Black,AbsoluteThickness[1],Circle[{0,-1}],Point[{0,0}],{Dashed;AbsoluteThickness[1], Line[{{-2,0}, {2,0}}];{}}}], 
Graphics[{Table[ GT[GT[wheel/. Orange->Red/. AbsoluteThickness[_]:> AbsoluteThickness[.75], RotationTransform[-ϕ]], TranslationTransform[{2 Sin[ϕ],0}]], {ϕ, c=20;DeleteCases[Range[-π/2, π/2, π/c], 0]}],
Table[ GT[GT[wheel/. Orange->Red/. AbsoluteThickness[_]:> AbsoluteThickness[.75], RotationTransform[-ϕ]], TranslationTransform[{2 Sin@ϕ,0}]], {ϕ, c=20;π/c, π/2,π/c}];{Blue, AbsoluteThickness[.9],Circle[{0,0},2, {0, π}],AbsolutePointSize[5], Black, Point[{0,0}]}}],
ParametricPlot[{xx[θ],yy[θ]},{θ,-π/2,π/2}, PlotStyle->{AbsoluteThickness[4], Blue}],PlotRange->{{-2.1,2.1},{-2.1,2.1}}, BaseStyle->{FontFamily->Times, 12}, ImageSize->240]]

6.  A wheel congruent to its road.

Suppose the wheel is the parabola y=(x^2)-(1/4); in polar form this is r=(1/(2(1 + cos θ))). The theorem then gives the road as ((1/2)tan (θ/2),-(1/(2(1 + cos θ)))), which is the same as y=-(x^2)-(1/4) (Figure ). So we have the remarkable situation of a wheel for which the appropriate road is its reflection; this was discovered by Robison [].

Show[road={Plot[-(x^2)-(1/4),{x,-2,2},PlotStyle->{AbsoluteThickness[2.4],Blue}, Filling->Bottom, FillingStyle->{EdgeForm[Black],FaceForm[RGBColor[.5,.5,1]]}],
Plot[-(x^2)-(1/4),{x,-2,2},PlotStyle->{AbsoluteThickness[2.4],Blue}]};Graphics@{AbsolutePointSize[5],Point[{0,0}],AbsoluteDashing[{4,4}],AbsoluteThickness[.7], Line[{{0,0},{3,0}}]},
ϕ=π/2;ϕ=1.4;ver={0,-1/4};Table[{ParametricPlot[RotationMatrix[-ϕ].(({Sin[θ],-Cos[θ]})/(2 (1+Cos[θ])))+{(1/2)Tan[ϕ/2],0}, {θ, -π, π}, PlotStyle->{AbsoluteThickness[1.4],Red}], Graphics[{AbsolutePointSize[3],Line[{{0,0}, ver}],Point[newcen={(1/2) Tan[(ϕ/2)],0}],Black, Line[{newcen, newV=RotationMatrix[-ϕ].ver+newcen}], Point[newV]}]}, {ϕ,DeleteCases[Range[0, 2.6,.2],0]}],
{ParametricPlot[(({Sin[θ],-Cos[θ]})/(2 (1+Cos[θ]))), {θ, -π, π}, PlotStyle->{AbsoluteThickness[3],Orange}], Graphics[{AbsolutePointSize[5],Point[{0,0}]}]},
road,Graphics[{AbsolutePointSize[5], Point[{0,-1/2}]}],

 Axes->False,Frame->True, BaseStyle->{FontFamily->Times, 10}, FrameTicks->{{-1,0,1}, {-1,0,1},{},{}}, PlotRange->{{-1.1,2}, {-1/4-.75,-1/4+.75}}, AspectRatio->Automatic, ImageSize-> 340, PlotRangeClipping->True]

Robison proved that under certain conditions a wheel that is congruent to its own road must be a parabola. His exact result is as follows.

Proposition.  If a wheel and a road are congruent and corresponding points under this congruence are in contact when rolling, then the road is a parabola (or part of a parabola) whose directrix is the horizontal axis.

Proof.  Let C be the congruence that maps the wheel in its initial position onto the road. Let O=(0,0) and F=C(O). Take an arbitrary point P' on the road, and let P=(C^(-1))(P') be the corresponding point on the wheel (Figure ). By assumption, when the wheel rolls to the contact point P', the point P moves to P'. At this moment, the wheel’s center is at a point O' on the x-axis. Rolling as well as the congruence C preserve lengths, so (Abs[O'P'])=(Abs[OP])=(Abs[(C^(-1))(FP')])=(Abs[FP']). By part (b) of the corollary, the segment O'P' is vertical, so its length equals the distance of P' from the x-axis. Hence, P' lies on the parabola with focus F and horizontal axis as directrix.   □

Clear[xx,α,θ]; C2=1;
ϕ=-7/10;r[θ_]:=C2 ((Sec[((θ+ϕ)/2)])^2);
W[θ_]:=r[θ]{Sin[θ],-Cos[θ]};
roadDer={r[θ],-r'[θ]};
road=Integrate[roadDer, θ];
road/. θ-> 0;
road = road +{-road[[1]]/. θ->0,0};
road/. θ-> 0;
CC[p_]:= RotationMatrix[ϕ].(-p)/.  {x_, y_} :>{-x,y}+{xx[-ϕ], -2};
CCInv[p_]:= -RotationMatrix[-ϕ].({-1,1}(p-{xx[-ϕ],-2}));
xx[θ_?NumericQ]:=Evaluate[NDSolveValue[{xx'[θ]==r[θ],xx[0]==0},xx[θ],{θ,0, π}]];
xx[θ];
ρ=0.5 0;OO={0,0};
PPrime=road/.θ->2.5;OPrime=PPrime {1,0};
P=CCInv[PPrime];F=CC[{0,0}];
perp2[A_,B_]:=({AbsoluteThickness[.9], Black, Line [mm1=Mean[{A, B}]+.04 Normalize[A-B];mm2=Mean[{A, B}]-.04 Normalize[A-B];{{mm1-(δ=1/10Normalize@Reverse[{1,-1}(A-B)]), mm1+δ },{mm2-(δ=1/10Normalize@Reverse[{1,-1}(A-B)]), mm2+δ }}]});
im=Show[rr=road/. θ-> 1;
ParametricPlot[RotationMatrix[-ρ].W[θ]+{xx[ρ],0}, {θ, -5, 5}, PlotStyle->{AbsoluteThickness[2],Orange}],
ParametricPlot[(CC[W[θ]]), {θ, -5, 5}, PlotStyle->{AbsoluteThickness[13],Green}];
ParametricPlot[road, {θ, -5, 5}, PlotStyle->{Blue,AbsoluteThickness[2]}], 
Frame->True, GridLines->{{0},{0}},Axes->False, GridLinesStyle->{{AbsoluteDashing[{4,2}],GrayLevel[.4]},{AbsoluteDashing[{4,2}],GrayLevel[.4]}}, PlotRange->{{-3,4.5}, {-3,2.5}}, PlotRangePadding->None,Epilog->{{AbsoluteDashing[{4,2}], AbsoluteThickness[1],Line[{{OO+{0,1}, OO-{0,1}}}]};Text["O", {-.16,.22}],Text["F", F-{.25,.15}],Text["P'", PPrime+{.29,.2}],Text["O'", OPrime+{.25,.22}],Text["P", P+{.24,-.1}],AbsolutePointSize[5],AbsoluteThickness[1], {Point[{PPrime,P}],Point[{FF=CC[OO], OO,OPrime ,W[0.]} ]},{ AbsoluteThickness[1],Line[{OO, P}],Line[{F, PPrime, OPrime}]}, 
Blue, Line[{P,PPrime}];  perp2[OO,P], perp2[OPrime,PPrime], perp2[F, PPrime]}, FrameTicks->{Range[-3,4],Range[-3,4], {}, {}}, BaseStyle->{FontFamily->"Times", 10}, ImageSize-> 280]

Here are some additional observations:

•  If a wheel is congruent to the road as above, it is a parabola. In the initial position its directrix need not be horizontal, but we can always achieve this by rolling the wheel so that its center lies directly above F.

•  By the previous comment, we can choose the initial position so that F=C(O) lies on the y-axis, say at F=(0,-d). Then the vertices of both parabolas touch at (0,-d/2), the equation of the wheel is y=(x^2)/(2d)-d/2 (or r=d/(1+cos θ) in polar form), and the road is y=-(x^2)/(2d)-d/2. Up to the choice of the wheel’s initial position, these are the only wheel–road pairs that are congruent and such that the corresponding points of this congruence are in contact during rolling.

Robison’s condition—that corresponding points are contact points—can be formulated in a different way. We can instead assume the following:

1.  The wheel is piecewise continuously differentiable.

2.  There exists a point P on the wheel and a point P' on the road such that P'=C(P), and P contacts P' at some stage of rolling.

3.  The congruence C is such that increasing the parameter θ on the wheel increases the x-coordinate of the corresponding point on the road.

Under these assumptions, it follows that all points corresponding to each other under C are in contact during rolling. Indeed, since C preserves curve lengths, the image of an arbitrary point Q on the wheel can be determined by measuring its signed distance along the wheel from P and locating a point Q' on the road at the same signed distance from P'. Because there is no slipping, Q and its image Q'=C(Q) are contact points.

Note that condition (3) cannot be dropped. For example, if the wheel and road are as in Figure ), there are two possibilities for C, reflection and rotation by 180°. In the latter case, increasing θ decreases x, and the only corresponding points that are also contact points are the vertices of both parabolas. Question: Is it possible to remove condition (2); that is, does the mere fact that the wheel and road are congruent, together with (1), imply the existence of at least one pair of contact points P, P' such that C(P)=P'? If this could be proved, it would follow that if a road is congruent to its wheel, is piecewise continuously differentiable, and condition (3) holds, then the road is a parabola or part of a parabola.

7.  A monster wheel.

The theorem requires only that the wheel be continuous; it need not be rectifiable or differentiable. So it is natural to try to roll a wheel that is a Weierstrass monster: a continuous but nowhere differentiable function. The general Weierstrass function is f(x)=(∑_(n=0)^∞)(a^(-n))cos((b^n) x), where b>a>1. The graph of f(x) is self-similar and is essentially the historically first fractal curve; see Figure . The Hausdorff dimension of the graph of f(x) was conjectured to be 2-(ln a)/(ln b), a result that was proved relatively recently []. For a polar wheel we must have positive radius, so we will define a monstrous polar wheel by r(θ)=((∑_(n=0)^∞)(2^(-n))cos((3^n) θ))-3 (Figure ).

2-Log[2]/Log[3.];
Clear[w,r];
w[depth_][x_]:=(∑_(n=0)^depth)((Cos[(3^n)x])/(2^n));
(*r[δ_][θ_]:=w[δ][θ]+3;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};*)
depth=50;
pp=Plot[w[depth][x],{x,0,π}, Frame->True, PlotPoints->100,PlotStyle->{Blue,AbsoluteThickness[.5]}];
im1=Show[pp, Graphics[{{Blue,AbsoluteThickness[.5], cc=Cases[Normal[pp], _Line, ∞]/. {x_?NumericQ,y_}:> {2π-x,y}},
EdgeForm[Black], FaceForm[], Rectangle[{π-.1, -2.06}, {π+.1, -1.4}]}], BaseStyle->{FontFamily->Times,10},FrameTicks->{{{0,1,-1,2,-2}, {}}, {{0,π, 2π}, {}}}, PlotRange->{{-.1,2π+.1}, {-2.2, 2.2}}, PlotRangePadding->None, AspectRatio-> Automatic, Axes->False,ImageSize-> 500];
pp=Plot[w[depth][x],{x,π-1/10,π}, Frame->True, PlotPoints->100,PlotStyle->{Blue,AbsoluteThickness[.5]}];
im2=Show[pp, Graphics[{{Blue,AbsoluteThickness[.5], cc=Cases[Normal[pp], _Line, ∞]/. {x_?NumericQ,y_}:> {2π-x,y}}}], BaseStyle->{FontFamily->Times,10},FrameTicks->{{{-2, -1.5}, {}}, {{π,3.09,3.19}, {}}}, PlotRange->{{π-.1,π+.1}, {-2.06, -1.4}}, PlotRangePadding->None, AspectRatio-> 1, ImageSize-> 500, AspectRatio-> Automatic];
Show[GraphicsRow[{Show[im1,ImageSize-> 360],Show[im2,ImageSize-> 145]}, Alignment->Bottom], PlotRange->{{-5, 560},{-275,-3}},Frame->!True]

Module[{w,r, whee},w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)))-3;
r[δ_][θ_]:=-w[δ][θ]+3 0;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
depth=50;
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};
Graphics[{wheelG,AbsolutePointSize[5], Point[{0,0}]}, Frame->True,PlotRange->{{-3.55, 3.55}, {-5.3; -2.5, 2.3+3}}, BaseStyle->{FontFamily->Times, 10}, FrameTicks->{Range[-3,3,3], Join[{0}, Range[-5,5,1]], {},{}}, GridLines->({{3.4},{-2,5}};{} ), ImageSize-> 240]]

It is somewhat surprising that the integral of a Weierstrass function is nicely smooth, and that means that the construction of the road as (x(θ),y(θ)) is straightforward using a numerical approach to the differential equation. Figure  shows x(θ), obtained from a numerical solution to the differential equation x'(θ)=r(θ) (using 50 terms in the sum). The graph of x(θ) looks nice, but its derivative is r(θ), essentially the same as the Weierstrass function shown in Figure . And its second derivative does not exist at any point whatsoever so, for example, it makes no sense to talk about the curvature of x(θ).

Clear[x,w,r, rN,θ];periods=3;
w[max_][x_]:=(∑_(n=0)^max)((Cos[(3^n)x])/(2^n))-3;
wN[max_][x_Real]:=(∑_(n=0)^max)((Cos[(3^n)N@x])/(2^n));
r[δ_][θ_]:=-w[δ][θ]+3 0;
rN[δ_][θ_Real]:=wN[δ][θ]+3;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
depth=50;
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 periods-1) π}]];
Plot[x[θ], {θ, 0, 2π}, PlotPoints->500,PlotStyle->{AbsoluteThickness[1], Blue},Frame->True, BaseStyle->{FontFamily->"Times", 10}, ImageSize->240,FrameTicks->{{{0, 2π, 4π, 6π},{}},{{0, π,2π},{}}}]

We can now construct the road on which the monster wheel will roll. As with a rolling triangle, the wheel will often crash into the road. Indeed, it appears that some part of the wheel is below the road in every rolled position. Nevertheless, the road exists and is not hard to compute; Figure  shows the rolling wheel and road. The road is not rectifiable, but piecewise linear approximations have lengths that are unbounded, so one can say that both the road and the wheel have infinite length over any nondegenerate interval.

Module[{θ,x,w,r},periods=3;depth=50; 
w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)))-3;
r[δ_][θ_]:=-w[δ][θ];
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};

x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,θmax=(2 periods-1) π}]];
road=ParametricPlot[{x[θ],-r[depth][θ]},{θ,-π,5π}, PlotStyle->{AbsoluteThickness[1], Blue}, Frame->True, PlotPoints->200];
im=Show[road,ϕ=0;Graphics[{GeometricTransformation[wheelG,{RotationMatrix[-ϕ],{x[ϕ],0}}],Black,PointSize[Large],Point[{{x[ϕ],0}}],{Line[{{-1, 0}, {40,0}}]}}],
ϕ=π;Graphics[{GeometricTransformation[wheelG,{RotationMatrix[-ϕ],{x[ϕ],0}}],Black,PointSize[Large],Point[{{x[ϕ],0}}],{Line[{{-1, 0}, {40,0}}]}}],
ϕ=5.65;Graphics[{GeometricTransformation[wheelG,{RotationMatrix[-ϕ],{x[ϕ],0}}],Black,PointSize[Large],Point[{{x[ϕ],0}}],{Line[{{-1, 0}, {40,0}}]}}],Axes->False, BaseStyle->{FontFamily->"Times", 10},
ImageSize-> 400, PlotRange->{{-3.6,19}, {-6; -5, 5.3}}, PlotRangePadding->None, FrameTicks->{{Range[-6,6,2],{}},{Range[-6,24, 2],{}}}]]

The path followed by any point on the wheel is somewhat well behaved; two such paths are shown in Figure . The path arising from the initial contact point (θ=0) never intersects the road, except at its contact point. It appears that all other paths pass below the road at some time during rolling. The smoothness of these paths belies their true nature. Each is differentiable, but the derivatives look like the Weierstrass function. So the loop in the figure is a differentiable curve, with continuous derivative. But there is no second derivative, so the curvature of the curve is not defined anywhere.

Clear[w,r,x,θ,ϕ];
w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)) )-3;
r[δ_][θ_]:=-w[δ][θ];depth=50;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 3-1) π}]];
road=ParametricPlot[{x[θ],-r[depth][θ]},{θ,0,3π}, PlotStyle->{AbsoluteThickness[1], Blue},PlotPoints->200, Frame->True];
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};

im=Module[{θ=π},Show[Graphics@wheelG,ParametricPlot[RotationMatrix[-ϕ].(wheelPolar[60][θ])+{x[ϕ],0}, {ϕ, 0,5π},PlotPoints->200,PlotStyle->{AbsoluteThickness[.9],Black}],
θ=0;ParametricPlot[RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ],0}, {ϕ, 0,5π},PlotPoints->200,PlotStyle->{AbsoluteThickness[.9],Black}],road,Graphics[{AbsolutePointSize[4],Point[{{0,0}, {6π, -1}}],Point[{x[π],-r[depth][π]}], Point[wheelPolar[depth]/@ {0,π}]}],
 PlotRange-> (pp={{-3.8, 6.3π}, {-5.95,5.7}}), Frame->True, AspectRatio->Automatic,BaseStyle->{FontFamily->"Times", 10}, PlotRangeClipping->True, FrameTicks->{{Range[-5,5,2],{}},{ {0 ,π, 2π, 3π, 4π, 5π, 6π},{}}}, PlotRangePadding->None,ImageSize->300]]

.  INADEQUACY OF EQUAL ARC LENGTHS.

Corollary (c) states that for piecewise (C^1) curves, the no-slipping condition implies equality of arc lengths. Given the prominence of the arc-length condition in earlier work, it is natural to ask about the converse; after all, it seems as if arc-length equality would imply no slipping. But it does not. Consider the straight line wheel y=-1, with polar form r=sec θ. If ρ(θ)=θ, we get the classic catenary road, so try ρ(θ)=2θ (coefficients other than 2 work, but the situation is messier). The road is then (τ(2 θ)-tan θ,-1), which is identical to the wheel, parametrized differently (Figure ). To satisfy the arc-length condition, suppose the contact point for W(θ) after some rolling is C(θ); we seek equality between the length along the wheel to W(θ), which is tan θ, the x-coordinate of W(θ), and the length of the road to C(θ), which is the x-coordinate of (Subscript[M, 2θ])·W(θ)+(τ(2θ),0), or τ(2θ)-tan θ. Therefore τ(2θ)=2tan θ, or more generally, τ(ϕ)=2tan(ϕ/2). And then C(θ) equals the original point W(θ). The equality of slopes is clearly false for all θ>0 and so by Corollary (d) there must be slipping. But the arc-length condition holds. Combining the arc-length condition with another condition does work to define rolling; but our theorem shows that a single no-slipping condition suffices (and rectifiability is not required).

Clear[xx,yy,θ,ρ,τ];
cen={0,0};
r[θ_]:= Sec[θ];
ρ[θ_]:= 2θ;
τ[ϕ_]:=2 Tan[(ϕ/2)];
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:= First[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
yy[θ_]:= Last[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
Simplify[(Sqrt[{((((∂_θ)xx[θ]))^2)+((((∂_θ)yy[θ]))^2),((r[θ])^2)+((((∂_θ)r[θ]))^2)}]), 0<θ<π/2];
M'[ρ[θ]].W[θ]+{τ'[ρ[θ]],0}//Simplify
wheel=Cases[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, 0, θθ}, PlotStyle->Orange], Line[z_]:> z, ∞][[1]];
road=ParametricPlot[{{xx[θ], yy[θ]}}, {θ, 0,π/2}, PlotStyle->{AbsoluteThickness[1.], Blue}];
ps= 4.2;
im1=Show[
Graphics[{AbsolutePointSize[ps],CapForm[None],{AbsoluteThickness[.9],GrayLevel[0.2], Dashed,Line[{{0,0},{10,0}}]},
new={Text["θ", {.0498, -.23}], AbsoluteThickness[.9], {Dashed,Line[{{0,0}, W[θθ]}]}},
{Orange, {Dashed,Line[{{0,0}, {0,-1}}]},AbsoluteThickness[6], Line[wheel]},
θθ=π/7;{Orange,{{Dashed,Line[{{0,0},{0,-1}}]},Line[wheel],{AbsoluteThickness[4],Line[{W[θθ],{0,-1}}],{Black,Point[{{0,-1},W[θθ]}]}}}/. {x_?NumericQ,y_}:>M[ρ[θθ]].{x,y}},
{ Point[{{0,-1},{0,0}}]}}],road,Graphics[{{Dashed, Line[{{0,-1}, {-W[θθ][[1]]-.3,-1}}]},AbsolutePointSize[ps],Point[{xx[θθ],yy[θθ]}],{Point[{{0,0}}]}/. {x_?NumericQ,y_}:>M[ρ[θθ]].{x,y}, Text["W(θ)", {.62,-.92}], Text["2 θ", {-.09,-.23}]}],
Frame->True,Axes->False,ImageSize->280,PlotRange->{{-.9,1.2},{-1.2,.23}},PlotRangePadding->0, BaseStyle->{FontFamily->Times, 9}, PlotRangeClipping->True, FrameTicks->{Range[-1, 1.5, 1], Range[-2, 0, 1],{},{}}];

GraphicsRow[{im1, Show[DeleteCases[im1,Point[_]|new, ∞],
 Graphics[{AbsolutePointSize[ps],Orange, {{Dashed,Line[{{0,0}, {0,-1}}]},AbsoluteThickness[ps],Line@wheel, {AbsoluteThickness[1], Line[{W[θθ],{0,-1}}]},
{Black, Point[{0,-1}]}}/. {x_?NumericQ, y_}:> M[ρ[θθ]].{x,y}+{τ[ρ[θθ]],0},
AbsolutePointSize[ps],Black, Cases[im1, Point[_], ∞],Text["C(θ)", {.62,-1.10}]}]]}, ImageSize->400]/. Dashed ->AbsoluteDashing[{4,4}]

.  CONCLUSION.

The idea that a square wheel can roll smoothly continues to delight people, from children and adults visiting the National Museum of Mathematics in New York City [], to the bridge designers in England who constructed the whimsical but efficient Cody Dock Bridge that rolls along giant catenaries []. The development given here derives the key equations from only the minimal assumption that the wheel does not slip while rolling along the road, thus making the underlying mathematical derivation easier to grasp.

REFERENCES

END

More:  The motion can be viewed differently. Pick ϕ and try to understand the motion for rotating through ϕ. Use  the special point W(ϕ/2).
Then our usual rotation around the origin followed by translation is identical to rotation around the special point with 0 translation.
So the movement of the line is just rotation around a point that slides along the x-axis.  Not sure if any of this is worth mentioning. I think not. We really want to focus on rolling as being rotation around the center followed by translation. This image below shows the rotation (with changing fixed point) as above, but I don’t think we need it. Each transformed line segment is a rotation of the original around a point that is moving along the road.

Clear[ϕ];θ=ϕ/2;pt=W[θ];Clear[{x,y}]
q2=RotationMatrix[-ϕ].{x,y}+{2 pt[[1]],0}//FullSimplify
q1=RotationMatrix[-ϕ].({x,y}-pt)+pt//FullSimplify
q1-q2//FullSimplify

Solve[0==q1-q2, aa]//FullSimplify

Code to check.

Clear[r,ρ,τ];
r[θ_]:=Sec[θ];ρ[θ_]:= 2θ;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
road=Simplify[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]
slip=M'[ρ[θ]].W[θ]+{τ'[θ],0};Simplify[slip/. τ'[θ]->(∂_θ)(2 Tan[(θ/2)])]

Clear[xx,yy,θ,ρ,τ];
cen={0,0};
r[θ_]:= Sec[θ];
ρ[θ_]:= 2θ;
τ[ϕ_]:=2 Tan[(ϕ/2)];
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:= First[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
yy[θ_]:= Last[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
Simplify[(Sqrt[{((((∂_θ)xx[θ]))^2)+((((∂_θ)yy[θ]))^2),((r[θ])^2)+((((∂_θ)r[θ]))^2)}]), 0<θ<π/2];
M'[ρ[θ]].W[θ]+{τ'[ρ[θ]],0}//Simplify;
wheel=Cases[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, 0, π/14}, PlotStyle->Orange], Line[z_]:> z, ∞][[1]];
road=ParametricPlot[{{xx[θ], yy[θ]}}, {θ, 0,π/2}, PlotStyle->{AbsoluteThickness[1.], Blue}];
ps= 4.2;
im1=Show[
Graphics[{AbsolutePointSize[ps],CapForm[None],{AbsoluteThickness[.9],GrayLevel[0.2], AbsoluteDashing[{4,4}],Line[{{0,0},{10,0}}]},
{Orange,AbsoluteThickness[5], wheel=Line[{{0,-1}, W[.8]}], {Dashed,AbsoluteThickness[2],Line[{{0,0}, {0,-1}}]},AbsoluteThickness[6], Line[wheel]{}},
Table[{{Orange,CapForm[None], AbsoluteThickness[5], Line[{{0,-1}, W[π/4]}]},{Lighter[Orange],{{Dashed,Line[{{0,0},{0,-1}}]};wheel,{AbsoluteThickness[4],Line[{W[θθ],{0,-1}}];{Black,Point[{{0,-1},W[θθ]}]}}}/. {x_?NumericQ,y_}:>M[ρ[θθ]].{x,y}+{τ[ρ[θθ]],0}},
{ Point[{{0,-1},{0,0}}]}}, {θθ, π/50,.8, π/50}],{}}],road,Graphics[{AbsolutePointSize[ps],Point[{xx[θθ],yy[θθ]}],{Point[{{0,0}}]}/. {x_?NumericQ,y_}:>M[ρ[θθ]].{x,y}, Text["W(θ)", {.6,-.9}], Text["2 θ", {-.08,-.21}]}];
Frame->True,Axes->False,ImageSize->320,PlotRange->{{-.1,1.76},{-1.46,.13}},PlotRangePadding->0, BaseStyle->{FontFamily->Times, 10}, PlotRangeClipping->True, FrameTicks->{Range[-1, 1.5, 1], Range[-2, 0, 1],{},{}}]

W[π/4]

Sentence 1

Clear[r,ρ,τ,xx,yy];
r[θ_]:=Sec[θ];ρ[θ_]:= θ;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:=Simplify[First[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
yy[θ_]:=Simplify[Last[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
slip=M'[ρ[θ]].W[θ]+{τ'[θ],0};
speed2=Simplify[((xx'[θ])^2)+((yy'[θ])^2)];
speed1=((r[θ])^2)+((r'[θ])^2);
speed1-speed2
slip/. τ'[θ]-> Sec[θ]//Simplify

Sentence 2

Clear[r,ρ,τ,xx,yy];
r[θ_]:=Sec[θ];ρ[θ_]:= 2θ;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:=Simplify[First[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
yy[θ_]:=Simplify[Last[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
{xx[θ], yy[θ]}
slip=M'[ρ[θ]].W[θ]+{τ'[θ],0};
speed2=Simplify[((xx'[θ])^2)+((yy'[θ])^2)];
speed1=((r[θ])^2)+((r'[θ])^2);
speed1-speed2//Simplify
slip/. τ'[θ]-> Sec[θ]//Simplify

We try ρ(θ)=2θ and seek τ to give matching arc lengths. Equality of the arc-length integrands leads to τ'(2 ϕ)=(sec^2)ϕ, so we set τ(ϕ)=∫ (sec^2)(ϕ/2)dϕ=2tan(ϕ/2), which guarantees arc length equality. The rolling motion is given by (Subscript[M, ϕ])·W(θ)+(2 tan ϕ,0) and the road has the parametric form (tan θ,-1). Thus the wheel “rolls” on itself (Figure ), but the rolling is unlike true rolling, as no slope or equilibrium condition is enforced and the wheel crashes through the road at contact. And there is slipping: the derivative in the no-slipping condition is ((tan^2)θ,tan θ). But the arc length condition does hold. Combining the arc length condition with another condition does work to define rolling; but our theorem shows that a single no-slipping condition suffices (and rectifiability is not required).

Corollary (c) tells us that for piecewise (C^1) curves the no-slipping condition implies equality of arc lengths. Given the prominence of the arc-length condition in earlier work, it is natural to ask about the converse; after all, it seems as if arc length equality would imply no slipping. But it does not. Consider the straight line wheel y=-1, with polar form r=sec θ. We try ρ(θ)=2θ and seek τ to give matching arc lengths. Equality of the arc-length integrands leads to τ'(2 ϕ)=(sec^2)ϕ, so we set τ(ϕ)=∫ (sec^2)(ϕ/2)dϕ=2tan(ϕ/2), which guarantees arc length equality. The rolling motion is given by (Subscript[M, ϕ])·W(θ)+(2 tan ϕ,0) and the road has the parametric form (tan θ,-1). Thus the wheel “rolls” on itself (Figure ), but the rolling is unlike true rolling, as no slope or equilibrium condition is enforced and the wheel crashes through the road at contact. And there is slipping: the derivative in the no-slipping condition is ((tan^2)θ,tan θ). But the arc length condition does hold. Combining the arc length condition with another condition does work to define rolling; but our theorem shows that a single no-slipping condition suffices (and rectifiability is not required).

Derivation of τ:

If τ(ϕ)=0, then ρ must be either 0 or 2θ.

Clear[r,ρ,τ,xx,yy];
r[θ_]:=Sec[θ];
τ[θ_]:= 0;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:=Simplify[First[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
yy[θ_]:=Simplify[Last[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
speed2=Simplify[((xx'[θ])^2)+((yy'[θ])^2)];
speed1=((r[θ])^2)+((r'[θ])^2);
speed1-speed2
DE=Solve[Simplify[speed1-speed2]==0, ρ'[θ]]

So try τ(θ)=0, ρ(θ)=θ

Clear[r, ρ, τ]; a = 2; 
r[θ_] := Sec[θ]; 
ρ[θ_] := a*θ; 
M[ϕ_] := RotationMatrix[-ϕ]; 
W[θ_] := r[θ]*{Sin[θ], -Cos[θ]}; 
xx[θ_] := Simplify[First[M[ρ[θ]] . W[θ] + {τ[ρ[θ]], 0}]]; 
yy[θ_] := Simplify[Last[M[ρ[θ]] . W[θ] + {τ[ρ[θ]], 0}]]; 
speed2=Simplify[((xx'[θ])^2)+((yy'[θ])^2)];
speed1=((r[θ])^2)+((r'[θ])^2);
raw = Simplify[speed1 - speed2]
DE = FullSimplify[Solve[0 == Simplify[raw, a > 0], Derivative[1][τ][a*θ]], 
     Pi/2 > θ > 0 && a > 0][[2,1]] /. θ -> θ/a

DSolve[DE==0, τ@θ,θ]

Simplify[speed1-speed2]/.τ'[2 θ]-> 0 
DSolve[τ'[θ]==((Sec[(θ/2)])^2),τ[θ],θ]
∫((Sec[(ϕ/2)])^2)\[DifferentialD]ϕ

cen={0,0};
r[θ_]:= Sec[θ];
ρ[θ_]:= 2θ;
τ[ϕ_]:=2 Tan[(ϕ/2)];
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:= First[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
yy[θ_]:= Last[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
Simplify[(Sqrt[{((((∂_θ)xx[θ]))^2)+((((∂_θ)yy[θ]))^2),((r[θ])^2)+((((∂_θ)r[θ]))^2)}]), 0<θ<π/2]
M'[ρ[θ]].W[θ]+{τ'[ρ[θ]],0}//Simplify
wheel=Cases[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, 0, π/2}, PlotStyle->Orange], Line[z_]:> z, ∞][[1]];
road=ParametricPlot[{{xx[θ], yy[θ]}}, {θ, 0,π/2}, PlotStyle->{AbsoluteThickness[1.5], Blue}];
Show[
Graphics[{AbsolutePointSize[4.5],CapForm[None],{AbsoluteThickness[.9],GrayLevel[0.2], AbsoluteDashing[{4,4}],Line[{{0,0},{10,0}}]},
{Orange, Line[{{0,0}, {0,-1}}],AbsoluteThickness[6], Line[wheel]},
Table[{Lighter@Orange, {Line[{{0,0}, {0,-1}}],Line@wheel}/. {x_?NumericQ, y_}:> M[ρ[θ]].{x,y}+{τ[ρ[θ]],0}}, {θ, δ=π/14, π/2-δ,δ}],
{ Point[{{0,-1},{0,0}}]}}],road,
Graphics[{AbsolutePointSize[4.5],Table[{Point[{xx[θ], yy[θ]}],{Point[{{0,0}, {0,-1}}]}/. {x_?NumericQ, y_}:> M[ρ[θ]].{x,y}+{τ[ρ[θ]],0}}, {θ, δ=π/14, π/2-δ,δ}]}],

Frame->True,Axes->False,ImageSize->320,PlotRange->{{-.1,1.76},{-1.12,.3}},PlotRangePadding->0, BaseStyle->{FontFamily->Times, 10}, PlotRangeClipping->True, FrameTicks->{Range[0, 1.5, 1], Range[-2, 0, 1],{},{}}]

τ[π/7.]

Code for Motion of a point.

cen={0,0};
r[θ_]:= Sec[θ];
ρ[θ_]:= 2θ;
τ[ϕ_]:=2 Tan[(ϕ/2)];
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:= First[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
yy[θ_]:= Last[ M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]//Simplify;
Simplify[(Sqrt[{((((∂_θ)xx[θ]))^2)+((((∂_θ)yy[θ]))^2),((r[θ])^2)+((((∂_θ)r[θ]))^2)}]), 0<θ<π/2]
M'[ρ[θ]].W[θ]+{τ'[ρ[θ]],0}//Simplify
M'[0].W[θ]+{τ'[0],0}/. θ-> 0//Simplify
wheel=Cases[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, 0, π/2}, PlotStyle->Orange], Line[z_]:> z, ∞][[1]];
road=ParametricPlot[{{xx[θ], yy[θ]}}, {θ, 0,π/2}, PlotStyle->{AbsoluteThickness[1.5], Blue}];
θ0=.9;start=W[θ0];
motion=ParametricPlot[M[ϕ].W[θ0]+{τ[ϕ],0}, {ϕ, 0, 3}, PlotStyle->{Cyan, AbsoluteThickness[2]}];
Show[
Graphics[{AbsolutePointSize[4.5],CapForm[None],{AbsoluteThickness[.9],GrayLevel[0.2], AbsoluteDashing[{4,4}],Line[{{0,0},{10,0}}]},
{Orange, Line[{{0,0}, {0,-1}}],AbsoluteThickness[6], Line[wheel]},
Table[{Lighter@Orange, {Line[{{0,0}, {0,-1}}],Line@wheel}/. {x_?NumericQ, y_}:> M[ρ[θ]].{x,y}+{τ[ρ[θ]],0}}, {θ, δ=π/14, π/2-δ,δ}],
{ Point[{{0,-1},{0,0}}]}}],road,
Graphics[{AbsolutePointSize[4.5],{Cyan, Point[start]},Table[{Point[{xx[θ], yy[θ]}],{Point[{{0,0}, {0,-1}}]}/. {x_?NumericQ, y_}:> M[ρ[θ]].{x,y}+{τ[ρ[θ]],0}}, {θ, δ=π/14, π/2-δ,δ}]}],motion,

Frame->True,Axes->False,ImageSize->320,PlotRange->{{-.1,1.76 2},{-2 ,.6}},PlotRangePadding->0, BaseStyle->{FontFamily->Times, 10}, PlotRangeClipping->True, FrameTicks->{Range[0, 4.5, .5], Range[-2, 0, 1],{},{}}]

Clear[r,ρ,τ];
r[θ_]:=Sec[θ];
cen={0,0};
ρ[θ_]:=2 θ;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
xx[θ_]:=Simplify[First[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
yy[θ_]:=Simplify[Last[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}]];
τ[ϕ_]:= 2 Tan[ϕ/2] ;

wheel=Cases[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, 0, π/2}, PlotStyle->Orange], Line[z_]:> z, ∞][[1]];
road=ParametricPlot[{{xx[θ], yy[θ]}}, {θ, 0,π/2}, PlotStyle->{AbsoluteThickness[1.5], Blue}];

Manipulate[Show[road, ParametricPlot[M[ϕ].W[θ0]+{τ[ϕ],0}, {ϕ, 0, 3}, PlotStyle->{Cyan, AbsoluteThickness[2]}],Graphics[{AbsolutePointSize[5],Point[{0,-1}],{Orange,Line[wheel],Line[{cen,{0,-1}}],Black,Point[{{0, -1},{0,0}, W[θ0]}]}/. {x_?NumericQ, y_?NumericQ}:> M[ϕ].{x,y}+{τ[ϕ],0},Point[{xx[θ0],yy[θ0]}]}],Frame->True,Axes->False,ImageSize->300,PlotRange->{{-.1,1.56 3},{-1.7,1}}],{{ϕ,0, "rotation ϕ"},0, π},{{θ0,.9,"point to follow (Subscript[θ, 0])"}, 0, 1}]

The locus of (0,-1) is  {((((1+y))^2)/(Sqrt[1-(y^2)])),y}

rr=M[ϕ].W[0]+{τ[ϕ],0}//TrigToExp//FullSimplify

Eliminate[Thread[{xxx,yyy}==rr], ϕ]

FullSimplify[SolveValues[4 ((Sin[(ϕ/2)])^4)==xxx (1-(yyy^2)) Csc[ϕ]/. ϕ->ArcSin[(Sqrt[1-(yyy^2)])],xxx][[1]], yyy>0]

Solve[x==-((((-1+yyy))^2)/(Sqrt[1-(yyy^2)])), yyy]

Show[ParametricPlot[{((((1+yyy))^2)/(Sqrt[1-(yyy^2)])),yyy},{yyy,0,1}]]

Solve[(-1+(yyy^2)) ((Csc[ϕ])^2)==-1, ϕ]

θ0
M[ϕ].W[θ0]+{τ[ϕ],0}/. ϕ-> 1.57
Limit[M[ϕ].W[θ0]+{τ[ϕ],0}, ϕ-> π]

Code

One can verify these with 0 computation...  translation cancels rotation, and similar.

M[ϕ_]:=RotationMatrix[-ϕ];
r[θ_]:=Sec[θ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
τ[θ_]:=ArcCosh[Sec[θ]];
Simplify[{M[θ].W[θ]+{τ[θ],0}=={τ[θ],-Cosh[τ[θ]]},M'[θ].W[θ]+{τ'[θ],0}},0<θ<π/2]

Simplify[{M[θ].W[θ],{τ[θ],0}}]
FullSimplify[{M'[θ].W[θ],{τ'[θ],0}},0≤θ<π/2]

THis shows the problem with negatives, where equality of (cosh^(-1))(sec ϕ) and (tanh^(-1))(sin ϕ) fails.

Plot[{ArcTanh[Sin[θ]]- ArcCosh[Sec[θ]]}, {θ, -π/2, π/2}]

A.S.: Just FYI

Clear[w,r,x,θ,ϕ];
w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)) )-3;
r[δ_][θ_]:=-w[δ][θ];depth=50;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 3-1) π}]];
road=ParametricPlot[{x[θ],-r[depth][θ]},{θ,0,3π}, PlotStyle->{AbsoluteThickness[1], Blue},PlotPoints->500, Frame->True];
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};

im=Module[{θ=π},Show[Graphics@wheelG,ParametricPlot[RotationMatrix[-ϕ].(wheelPolar[60][θ])+{x[ϕ],0}, {ϕ, 0,5π},PlotPoints->500,PlotStyle->{AbsoluteThickness[.9],Black}],
θ=0;ParametricPlot[RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ],0}, {ϕ, 0,5π},PlotPoints->500,PlotStyle->{AbsoluteThickness[.9],Black}],road,Graphics[{AbsolutePointSize[4],Point[{{0,0}, {6π, -1}}],Point[{x[π],-r[depth][π]}], Point[wheelPolar[depth]/@ {0,π}]}],
 PlotRange-> (pp={{-3.8, 6.3π}, {-5.95,5.7}}), Frame->True, AspectRatio->Automatic,BaseStyle->{FontFamily->"Times", 12}, PlotRangeClipping->True, FrameTicks->{{Range[-5,5,2],{}},{ {0 ,π, 2π, 3π, 4π, 5π, 6π},{}}}, PlotRangePadding->None,ImageSize->500]]
Show[im,PlotRange-> {{2.9π, 3.1π}, {-5.3, -4.5}}]

MISC JUNK

r[θ]
{x[θ], x[0]}
θ[x]

r[θ]

Clear[θ,r,x];
k=1/2;
rr[θ_]:=(E^(θ k));
wheel=ParametricPlot[rr[θ]{Sin[θ], -Cos[θ]}, {θ, -30, 5 π}];
xsol=DSolveValue[x'[θ]==rr[θ]&&x[0]==0, x[θ],θ]
{xsol/. θ->0, D[xsol, θ]==rr[θ]}

θsol=DSolveValue[θ'[x]==1/rr[θ[x]]&&θ[0]==0, θ[x],x]

ysol=-r[xsol]
{θsol, xsol, ysol}/. θ-> 0/. x-> 0
road={xsol, -r[θsol]}
Show[wheel,ParametricPlot[{xsol, ysol}, {θ, 0, 5π}, PlotStyle->Red],PlotRange->{{-2,4},{-3,2}}, PlotRangePadding->None,  AspectRatio->Automatic, Frame->True]

xx=.;

Solve[Eliminate[{xx==xsol,yy==-r[xsol]}, θ], yy]

Show[wheel,ParametricPlot[{xsol, -r[xsol]}, {θ, 0, 18π}, PlotStyle->Red],PlotRange->{{-5,18}, {-5,5}}, AspectRatio->Automatic, Frame->True]

Clear[xx,yy];
xx[θ_]:=2 ArcTanh[Tan[(θ/2)]];
yy[xx_]:= - Cosh[xx]
xx[0]
-FullSimplify[TrigToExp@yy[xx[θ]],0<θ<(π/2)]

/. x-> 0
D[2 ArcTan[Tanh[(x/2)]],x]//FullSimplify
-FullSimplify[TrigToExp[-Cosh[2 ArcTanh[Tan[(θ/2)]]]], 0<θ<π/2]

FullSimplify[-Cosh[2 ArcTanh[Tan[(θ/2)]]]-Sec[θ], 0<θ<π/2]/. θ-> .123

FullSimplify[TrigToExp[-ArcTan[Csch[x]]+(π/2)], x>0]

Show[Plot[-ArcTan[Csch[x]]+π/2, {x, 0, 1}],Plot[2 ArcTan[Tanh[x/2]], {x, 0, 1},PlotStyle->Red], PlotRange->All]

π

-ArcTan[Csch[x]]+π/2/. x-> 0.000

FullSimplify[-Cosh[ArcCsch[Tan[-θ]]], π/2>θ>0]

Solving 
  Set r(θ)=cosh x. The integral of (1/(cosh x)) is n, solving ((dx)/(dθ))=cosh x, gives x(θ)=(sinh^(-1))(tan θ). So r(θ)=cosh(x(θ))=sec(θ), which is the polar form of the line y=-1.

D[-ArcTan[Csch[x]], x]//Simplify

∫(1/(Cosh[x]))\[DifferentialD]x/. x-> .123
-ArcTan[Csch[x]]/. x-> .123
-ArcCot[Sinh[x]]/. x-> .123
Solve[θ==∫(1/(Cosh[x]))\[DifferentialD]x,x]

r[θ_]=1

Interesting plots:  The motion of a point.

Intere

Clear[x];
x[θ_]:=Evaluate@NDSolveValue[{x'[θ]==r[60][θ],x[0]==0},x[θ],{θ,-π,θmax=(2periods-1)π}];
x[θ]

road=ParametricPlot[{x[θ],-r[60][θ]},{θ,-π,5π}, PlotStyle->{AbsoluteThickness[.5], Blue}, Frame->True]

Clear[x];

xx[θ_]:=Evaluate@NDSolveValue[{x'[θ]==r[60][θ],x[0]==0},x[θ],{θ,0, 2π}];
Show[Plot[xx[θ], {θ, 0, 2π}, Frame->True], Plot[3x, {x,0, 2π}, PlotStyle->Red]]

x[0]

Clear[x];
x[θ_]:=Evaluate@NDSolveValue[{x'[θ]==r[60][θ],x[0]==0},x[θ],{θ,0, 6π}];

ϕ=0;Show[road,Graphics[{Red,GeometricTransformation[wheelG,{RotationMatrix[-ϕ],{x[ϕ],0}}],Black,PointSize[Large],Point[{{x[ϕ],0}}],{Line[{{-1, 0}, {40,0}}]}}],PlotRange->{{-2,20},{-5,4}},ImageSize->1000,Axes->False]

Manipulate[Show[road,Graphics[{Red,GeometricTransformation[wheelG,{RotationMatrix[-ϕ],{x[ϕ],0}}],Black,PointSize[Large],Point[{{x[ϕ],0}}],{Line[{{-1, 0}, {40,0}}]}}],PlotRange->{{-10,35},{-5,4}},ImageSize->1000,Axes->False],{{ϕ,0},-π,(2periods-1)π},SaveDefinitions->!True]

General: The road just “unwraps” the wheel. So having y=-r is actually very intuitive. We should not treat it as some sort of mystery. Is there similar intuition for x’=r?

road

ArcTanh[Sin[θ]]==ArcCosh[Sec[θ]]
Sin[θ]==Tanh[ArcCosh[Sec[θ]]]

Simplify[Tanh[ArcCosh[x]], x>0]
FullSimplify[((Sqrt[((Sec[θ])^2)-1])/(Sec[θ])), 0<θ<π/2]

ArcSin[Tanh[x]]==ArcSec[Cosh[x]]
Simplify[Tanh[x]-Sin[ArcSec[Cosh[x]]], x>0]

Sin[ArcSec[x]]

FullSimplify[ArcSin[Tanh[x]]-ArcSec[Cosh[x]], x==2]

tri={{-(Sqrt[3.]),-1},{(Sqrt[3.]),-1}, {0, (-1+(Sqrt[3])/2 2(Sqrt[3]))}};
Solve[-Sinh[x]== -(Sqrt[3]), x]
 Show[Plot[-Cosh[x], {x, - ArcSinh[(Sqrt[3])], ArcSinh[(Sqrt[3])]}, PlotStyle->{AbsoluteThickness[1.6], Blue}],ParametricPlot[{x+2 ArcSinh[(Sqrt[3])], -Cosh[x]}, {x, - ArcSinh[(Sqrt[3])], ArcSinh[(Sqrt[3])]},PlotStyle->{AbsoluteThickness[1.6], Blue}],  Graphics[{EdgeForm[AbsoluteThickness[.8]], FaceForm[Lighter@Orange],Opacity[.4], Polygon[tri];
Polygon[tri/. {x_, y_}:>RotationMatrix[β=-π/3+.47].{x,y}+{ArcCosh[Sec[β]],0}]}], PlotRange->{{-1, 2}, {-2.05, -.9}}, AspectRatio->Automatic, Frame->True, PlotRangePadding->None, Axes->False, BaseStyle->{FontFamily->Times,12}, ImageSize-> 300, FrameTicks->{{{-1, -1.5,-2},{}},{{-1, 0,1, 1.5},{}}}]

ParametricPlot3D[Evaluate[Prepend[D[RotationMatrix[ϕ].(wheelPolar[depth][0])+{x[ϕ],0}, ϕ],ϕ]], {ϕ, 0, 4π}]

path=RotationMatrix[ϕ].(wheelPolar[depth][0])+{x[ϕ],0};
der = D[path,ϕ];

sol=Solve[yy==path[[2]], ϕ][[2,1,2,1]]/. C[1]->0

ParametricPlot[{yy,path[[1]]/. ϕ->sol}, {yy,0,1}, PlotRange->All]

Plot[Evaluate[D[path[[1]]/. ϕ->sol, yy]], {yy,2.91,2.93}, PlotRange->All]

path[[2]]

Eliminate[{xx==path[[1]], yy==path[[2]]}, θ]

Show[ParametricPlot[der, {ϕ, 0,5}, PlotStyle->{Black,AbsoluteThickness[.8]}], 

Graphics[Table[Line[{path, path + der} /. ϕ->λ], {λ, 1,1.01, .01}]], Frame->True]

Alternate: Uses slightly simpler facts. Not much different.  Note that in both cases I specialized to (b,0) since that is all we need.

Proof.  We use four simple facts: M'(ϕ)=M(ϕ)·M((π/2)); M((π/2))·(0,b)=(b,0); M(α)·M(β)=M(α+β); and W(θ)=M(-θ)(0,-r(θ)). By the no-slipping condition we have:

(0,0)=(Subscript[σ, W(θ)]^′)(ρ(θ))=M'(ρ(θ))·W(θ)+(τ'(ρ(θ)),0)
                                      =M(ρ(θ))M((π/2))·M(-θ)·(0,-r(θ))+(τ'(ρ(θ)),0)
                                      =M(ρ(θ)-θ)·(M((π/2))·(0,-r(θ)))+(τ'(ρ(θ)),0)
                                      =M(ρ(θ)-θ)·(-r(θ),0)+(τ'(ρ(θ)),0).

Proof:  -2≤w(x)≤2 so 1≤r(θ)≤5    
This means that y(θ)=-r(θ)≤-1.
So the maximum of the road is -1, and minimum -5.
r(π)=1 so, because of the rotation, its y-coordinate is between -1 and 1. So it never touches the road except at the contact point.

Clear[w,r,x,θ];
w[max_][x_]:=(∑_(n=0)^max)((Cos[(3^n)x])/(2^n));
r[δ_][θ_]:=w[δ][θ]+3;depth=60;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 3-1) π}]];
(*θFunc[x_]:=Evaluate[NDSolveValue[{θ'[x]==1/r[depth][x],θ[0]==0},θ[x],{x,0,5 π}]];*)
road=ParametricPlot[{x[θ],-r[depth][θ]},{θ,-π,2π}, PlotStyle->{AbsoluteThickness[1], Blue},PlotPoints->200, Frame->True];
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};

Manipulate[Module[{θ=π},Show[Graphics@wheelG,
θ=0;ParametricPlot[RotationMatrix[ϕ].(wheelPolar[depth][start])+{x[ϕ],0}, {ϕ, 0,5π},PlotPoints->200,PlotStyle->{AbsoluteThickness[.9],Black}],road,
 PlotRange-> (pp={{0, π}, {-5,-1.16}}), ImageSize-> 500,Frame->True, AspectRatio->Automatic,BaseStyle->{FontFamily->"Times", 12}, PlotRangeClipping->True, FrameTicks->{{Range[-6,6,2],{}},{ {0 ,π, 2π, 3π, 4π, 5π, 6π},{}}}, PlotRangePadding->None]], {{start, .2}, 0, .5}]

Junk

Can there be a wheel that is identical to its own road; that is, a wheel such that the appropriate road is congruent to the wheel. There is indeed an essentially unique example of this, found by Robison []. Here we will show how to discover such a shape. We will assume that the curves are twice differentiable. If two curves are congruent, they must have the same curvature (in absolute value) at corresponding points. 

Note that you are not allowing for nonobvious congruences. You assume that the congruence takes W(θ) to the contact point of the road. Is that sufficiently general for a proof of uniqueness?

(Subscript[κ, 1])=±(Subscript[κ, 2]) What if the sign is not constant? Get contradiction of + is used even once.

Consider the wheel W(θ)=r(θ)(sin θ,-cos θ); let λ=(((((r(θ))^2)+((r'(θ))^2)))^(3/2)). Then its curvature, (Subscript[κ, 1]), is easily computed to satisfy be λ·(Subscript[κ, 1])=((r(θ))^2)+2 ((r'(θ))^2)-r(θ) r''(θ). By the theorem, the derivative of the road is (r(θ),-r'(θ)), and (Subscript[κ, 2]), the curvature for this parameterized curve, satisfies λ·(Subscript[κ, 2])=((r'(θ))^2)-r(θ) r''(θ). Assuming.....  (Subscript[κ, 1])=±(Subscript[κ, 2])...


The equation λ·(Subscript[κ, 1])=λ·(Subscript[κ, 2]) is (((((r'(θ))^2)+((r(θ))^2)))^(-1/2))==0, which is not solvable. But λ·(Subscript[κ, 1])=-λ·(Subscript[κ, 2]) leads to ((r(θ))^2)+3 r'(((θ))^2)-2 r(θ) r''(θ)=0, with solution r=(CTraditional[2]) (sec^2)((θ/2)+(CTraditional[1])). The value of (Subscript[c, 2]) just scales the wheel and (Subscript[c, 1]) rotates the wheel. When we take (Subscript[c, 1])=0 and (Subscript[c, 2])=1, then the wheel becomes the graph of y=(1/4)(x^2)-1 and road becomes (2 tan((θ/2)),-(sec^2)((θ/2))), which is the graph of y=-(1/4)(x^2)-1. The focus

Your work, after I eliminate θ from x,y, shows that if the wheel is y=((x^2)/(4 (Subscript[c, 2]^2)))-(Subscript[c, 2]), then wheel = road. The initial point is (0,-(Subscript[c, 2])). And this is  the focus of the parabola. In other words, given any parabola y=k (x^2), translate it to y=k (x^2)-(1/(2 (Sqrt[k]))), placing the focus at the origin. This gives wheel=road. So any parabola works.

Or: The road for a parabolic wheel is a parabola. If the wheel is placed  so that its center is its focus, then the road is congruent to the wheel.

Manipulate[Show[Plot[k (x^2)-(1/(2 (Sqrt[k]))),{x,-12,12},PlotStyle->Orange],Plot[-k (x^2)-(1/(2 (Sqrt[k]))),{x,-12,12},PlotStyle->Blue],Frame->True,Axes->False,GridLinesStyle->Red,GridLines->{{0},{0,-(1/(2 (Sqrt[k])))}},PlotRange->{{-3,3},{-5,3}}],{k,.01,1.5}]

C2=.;
r[θ_]:=C2 ((Sec[(θ/2)])^2);
W[θ_]:=r[θ]{Sin[θ],-Cos[θ]};
roadDer={r[θ],-r'[θ]};
road=Integrate[roadDer, θ]
θθ=Solve[road[[1]]==xx, θ][[1,1,2,1]]/. C[1]->0
road[[2]]/. θ-> θθ//Expand

Fix art because of 1 here? Or change all to be monic?  Maybe that is best.

r[θ_]:=((Sec[(θ/2)])^2);
W[θ_]:=r[θ]{Sin[θ],-Cos[θ]};
roadDer={r[θ],-r'[θ]};
road=Integrate[roadDer, θ]
road/. θ-> 0
Solve[xx==r[θ]Sin[θ],  θ]
2(ArcTan[(2/(Sqrt[4+(xx^2)])),(xx/(Sqrt[4+(xx^2)]))]+2 π (C[1]))/. C[1]->0/. ArcTan[a_,b_]:> ArcTan[b/a]
θθ=2 ArcTan[(xx/2)]
W[θθ]//FullSimplify

If a curve is its own road, then the road (and hence the wheel) must be a parabola because the reflection of the center in the initial contact point and the horizontal line through the center  serve as the focus and directrix of a parabola. Any parabola works....

The parabola y=x^2-1/4 has polar equation r[theta]=1/(2+2Cos[theta])), so
it corresponds to C[1]=0, C[2]=1/4.

Changing C[1] is just rotation of the wheel; the parabola will not start
in the upright position, but rotated. So nothing essentially new arises
from C[1].

Changing C[2] means scaling both the wheel and the road.

the wheel is the parabola y=(x^2)-(1/4); in our polar form this is r=(1/(2(1 + cos θ))). The theorem then gives the road as ((1/2)tan (θ/2),-(1/(2(1 + cos θ)))), which is the same as y=-(x^2)-(1/4) (Figure ). So we have the remarkable situation of a wheel for which the appropriate road is its reflection; this was discovered by Robison []. If one curve is congruent to another, then the curvatures must agree...this yields

Suppose the wheel is the parabola y=(x^2)-(1/4); in our polar form this is r=(1/(2(1 + cos θ))). The theorem then gives the road as ((1/2)tan (θ/2),-(1/(2(1 + cos θ)))), which is the same as y=-(x^2)-(1/4) (Figure ). So we have the remarkable situation of a wheel for which the appropriate road is its reflection; this was discovered by Robison []. If one curve is congruent to another, then the curvatures must agree...this yields

AS: Do we need more detail on the algebra here?

Curvature of a parametric curve: κ(t)=det(c'(t),c''(t))/||c'(t)((||)^3).

Clear[r];
W[θ_]:=r[θ]{Sin[θ],-Cos[θ]};

k1[θ_]:=Evaluate[Simplify[((Det[{W'[θ],W''[θ]}])/(((W'[θ].W'[θ]))^(3/2)))]];
k1[θ]

Curvature of the road:

rd[θ_]:={r[θ],-r'[θ]}; (* derivative of the road *)

rd[θ]

k2[θ_]:=Evaluate[Simplify[((Det[{rd[θ],rd'[θ]}])/(((rd[θ].rd[θ]))^(3/2)))]];
k2[θ]

Compare both curvatures:

k1[θ]==-k2[θ]

eqn=Simplify[k1[θ]==-k2[θ]]

bad=Simplify[k1[θ]==k2[θ]]

Find r(θ) for self-road curves:

special=DSolveValue[eqn ,r[θ],θ]

special/.

rSpecial[θ_]:=special;

Reduce[-1==special/. θ-> 0]

Code

r=(1/(2+2 Cos[θ]));∫r\[DifferentialD]θ
Simplify[SolveValues[Quiet[Eliminate[{x,y}=={(1/2) Tan[(θ/2)],-r},θ]][[2]],y][[1]],0≤x≤(π/2)]

Clear[x,θ,road];
c=.;cVal=1/4;
road[x_]:= -x^2 - c;
sol=DSolveValue[x'[θ]==-road[x[θ]]&&x[0]==0, x[θ], θ]
r[θ_]:=-road[sol]/. c-> cVal
Show[ParametricPlot[r[θ]{Sin[θ], -Cos[θ]}, {θ, -2, 2}],
Plot[road[x]/. c-> cVal, {x, -1, 1}], PlotRange->All, Frame->True]

Clear[w, r]; 
w[max_][x_] := Sum[Cos[3^n*x]/2^n, {n, 0, max}]; 
Manipulate[pp = Plot[Evaluate[Log10[Abs[D[w[depth][x], x]]]], {x, 0, 0.001}, Frame -> True, PlotPoints -> 100, 
     PlotStyle -> {Blue, AbsoluteThickness[0.5]}]; Show[pp, BaseStyle -> {FontFamily -> Times, 12}, FrameTicks -> Automatic, 
    PlotRange -> {0, 20}, PlotRangePadding -> None, AspectRatio -> 1, ImageSize -> 500], {depth, 1, 100, 1}]

Loop analysis

Clear[w,r,x,θ,ϕ];
w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)) )-3;
r[δ_][θ_]:=-w[δ][θ];depth=50;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 3-1) π}]];

{xx,yy}=RotationMatrix[ϕ].(wheelPolar[depth][0])+{x[ϕ],0}
{xx,yy}=RotationMatrix[ϕ].({0,0})+{x[ϕ],0}
ParametricPlot[{xx,yy}, {ϕ, 0, 2π}]

ϕFunc1=Solve[yy==y,ϕ][[1,1,2]]/. C[1]->1
ϕFunc2=Solve[yy==y,ϕ][[2,1,2]]/. C[1]->0

Table[{xx[ϕFunc1],y}, {y, 0,π, .1}];

Show[im, ParametricPlot[{{xx/. ϕ-> ϕFunc1,y}}, {y, -4,4.5}, PlotStyle->{AbsoluteThickness[3],Red}], PlotRange->{{0, 4π}, {-4,6}}]

Show[ParametricPlot[{1,-1}{y,xx/. ϕ-> ϕFunc1}, {y, 2,4.5}, PlotStyle->{AbsoluteThickness[3],Red}, Frame->True, Axes->False]

der=(∂_({y,1}))Reverse[{xx/. ϕ->ϕFunc1,y}];

Plot[Evaluate[D[Reverse@{xx/. ϕ-> ϕFunc1,y}, {y,1}][[2]]], {y, -1,1}, PlotStyle->Red, Frame->True]

Loop analysis at π

{xx,yy}=RotationMatrix[ϕ].(wheelPolar[depth][π])+{x[ϕ],0}
ParametricPlot[{xx,yy}, {ϕ, 0, 2π}]

ϕFunc1=Solve[yy==y,ϕ][[1,1,2]]/. C[1]->1
ϕFunc2=Solve[yy==y,ϕ][[2,1,2]]/. C[1]->0

Table[{xx[ϕFunc1],y}, {y, 0,π, .1}];

Plot[Evaluate[D[xx/. ϕ-> ϕFunc2, {y,1}]],{y,-1,1}, PlotStyle->{Red,AbsoluteThickness[.5]},Frame->True, PlotRange->{-10,0}]
Plot[Evaluate[D[xx/. ϕ-> ϕFunc2, {y,2}]],{y,-1,1}, PlotStyle->AbsoluteThickness[.5],Frame->True, PlotRange->{-500,500}]

ParametricPlot[Reverse@{xx/. ϕ-> ϕFunc2,y}, {y, -1,1}, PlotStyle->{AbsoluteThickness[.5],Red}, PlotRange->All, Frame->True, AspectRatio-> 2]

Show[ParametricPlot[{{xx/. ϕ-> ϕFunc1,y}}, {y, -1,1}, PlotStyle->{AbsoluteThickness[3],Red}];
ParametricPlot[{{xx/. ϕ-> ϕFunc2,y}}, {y, -1,1}, PlotStyle->{AbsoluteThickness[.5],Red}], PlotRange->{{0, 10}, {-1,1}}, Frame->True, AspectRatio-> 2]

Show[ParametricPlot[{1,-1}{y,xx/. ϕ-> ϕFunc1}, {y, 2,4.5}, PlotStyle->{AbsoluteThickness[3],Red}, Frame->True, Axes->False]

der=(∂_({y,1}))Reverse[{xx/. ϕ->ϕFunc1,y}];

Plot[Evaluate[D[Reverse@{xx/. ϕ-> ϕFunc1,y}, {y,1}][[2]]], {y, -1,1}, PlotStyle->Red, Frame->True]

The literature [, ] derives the road equations by assuming various other conditions (the arc lengths up to the contact point match, the slopes at a contact point match, the center stays directly above the contact point). The corollary shows that such conditions all follow from the no-slipping condition. For example, as shown above, the contact point is (τ(θ),-r(θ)) and (τ(θ),0) is the corresponding location of the center, proving Robison’s equilibrium condition: the center stays directly above the contact point. However, because r need not be differentiable, the concept of the arc length of the road might not make sense (as in Example 6 below). Note that the no-slipping condition is equivalent to the assertion that the instantaneous rolling motion is always a clockwise rotation around the point of contact.

The theorem also solves the inverse problem: Given a road lying below the x-axis, find the wheel (with center at the origin) that will roll smoothly along it. Suppose a road is given by y=f(x), where f is continuous and f(0)<0. The theorem shows that for the road to work for some wheel, we must have x'(θ)=-y(θ)=-f(x). Separate variables to get ∫-(1/(f(x)))dx=∫dθ. If the integral can be evaluated to get θ=G(x), we try to invert it to x=H(θ). If either of these two steps fails, then a numerical solution to the differential equation x'(θ)=-f(x) can be used. Now, we have the road in the form (H(θ),f(H(θ))), from which we conclude, again using the theorem, that r(θ)=-f(H(θ)). See Example 2 below for how this works.

General rule: Given y=f(x) for the road, the wheel is r(θ)=-f(x(θ)) where x satisfies x'(θ)=-f(x).

A.S.:  This is just here to show you how Mathematica works very smoothly to find the wheel for the catenary. The other direction works just as well when we use DSolve (as opposed to Integrate)

f[x_]:=-Cosh[x];
xSol=Simplify[DSolveValue[x[0]==0&&x'[θ]==-f[x[θ]],x[θ],θ]]
Simplify[-f[xSol],-(π/2)<θ<(π/2)]

r[θ_]:=Sec[θ];
θSol=Simplify[DSolveValue[θ[0]==0&&θ'[x]==(1/(r[θ[x]])),θ[x],x]]
Simplify[-r[θSol],0<x]

(c)  Tricky:  First: The defn. of rectifiable is that the polygonal approximations are bounded (and their least upper bound is the length). And rectifiable => differentiable almost everywhere (I think).
So just ignore the measure zero set of nondifferentiability. Off this set, (but now I am hand-waving, since we need intervals for the square root integrals. I guess maybe the Lebesgue integral is being used here?)

 we have  x'(θ)=r(θ)=-y(θ) which means ((x'(θ))^2)+((y'(θ))^2)=((r(θ))^2)+((r'(θ))^2) and the integrals of the square roots of these give the arc lengths.
 
 Can you see how make (c) precise?

For the π-point above: This is the second derivative using our approximation. In reality of course, the limit of these values at any point does not exist.

The first derivative: It is negative. So the function really is decreasing. But the rate of decrease is ... not nice.

Clear[w,r,x,θ,ϕ];
w[max_][x_]:=((∑_(n=0)^max)((Cos[(3^n)x])/(2^n)) )-3;
r[δ_][θ_]:=w[δ][θ] (-1);depth=10;
wheelPolar[δ_][θ_]:=r[δ][θ]{Sin[θ],-Cos[θ]};
x[θ_]:=Evaluate[NDSolveValue[{x'[θ]==r[depth][θ],x[0]==0},x[θ],{θ,-π,(2 3-1) π}]];
(*θFunc[x_]:=Evaluate[NDSolveValue[{θ'[x]==1/r[depth][x],θ[0]==0},θ[x],{x,0,5 π}]];*)
road=ParametricPlot[{x[θ],-r[depth][θ]},{θ,-π 0,2π}, PlotStyle->{AbsoluteThickness[1], Blue},PlotPoints->200, Frame->True];
wheel=ParametricPlot[r[depth][θ]{Sin[θ],-Cos[θ]},{θ,-π,π}, PlotPoints->200, Frame->True, Axes->False, PlotStyle->{Blue, AbsoluteThickness[.5]}];
wheelG = {EdgeForm[{AbsoluteThickness[.5],Blue}], FaceForm[Orange],Polygon@@Cases[wheel, _Line, ∞][[1]]};

im=Module[{θ=π},Show[Graphics@wheelG,road,
 PlotRange-> (pp={{-.2, 6π}, {-6,0}}), Frame->True, AspectRatio->Automatic,BaseStyle->{FontFamily->"Times", 12}, PlotRangeClipping->True, FrameTicks->{{Range[-6,6,2],{}},{ {0 ,π, 2π, 3π, 4π, 5π, 6π},{}}}, PlotRangePadding->None,ImageSize->500]];
Show[im, Plot[w[60][(x/(3))], {x, 0, 6π}, PlotStyle->Red], PlotRange->{{-2, 6π+.2},{-5,2}}, ImageSize->700]

Show[im, ParametricPlot[{x[θ], w[60][(θ)]}, {θ, 0, 6π}, PlotStyle->Red], PlotRange->{{-2, 6π+.2},{-5,2}}, ImageSize->700]
Show[im, ParametricPlot[{x[θ],w[depth] [θ]}, {θ, 0, 6π}, PlotStyle->Red], PlotRange->{{-2, 6π+.2},{-5,2}}, ImageSize->700]

-r[depth]

subtract 3 from the road to get the wheel; that is, we take our monster wheel to be r(θ)=-(w(θ)-3) .  ; we will use this with a=2 and b=3, calling it w(x) (Figure ).   ; for w(x) this dimension is 2-((ln 2)/(ln 3)), or about 1.37.

The theorem requires only that the wheel be continuous; it need not be rectifiable or differentiable. So it is natural to see what can be done with a wheel that is a Weierstrass monster: a continuous but nowhere differentiable function. The general Weierstrass function is f(x)=(∑_(n=0)^∞)(a^(-n))cos((b^n) x), where b>a>1; we will use this with a=2 and b=3, calling it w(x) (Figure ). The graph of f(x) is self-similar and is essentially the first fractal curve. The Hausdorff dimension of the graph of f(x) was conjectured to be 2-(ln a)/(ln b), a result that was proved relatively recently []; for w(x) this dimension is 2-((ln 2)/(ln 3)), or about 1.37. For a polar wheel we must have positive radius, so we subtract 3 from the road to get the wheel; that is, we take our monster wheel to be r(θ)=-(w(θ)-3) (Figure ).

The theorem requires only that the wheel be continuous; it need not be rectifiable or differentiable. So it is natural to see what can be done with a wheel that is a Weierstrass monster: a continuous but nowhere differentiable function. The general Weierstrass function is f(x)=(∑_(n=0)^∞)(a^(-n))cos((b^n) x), where b>a>1; we will use this with a=2 and b=3, calling it w(x) (Figure ). The graph of f(x) is self-similar and is essentially the first fractal curve. The Hausdorff dimension of the graph of f(x) was conjectured to be 2-(ln a)/(ln b), a result that was proved relative recently []; for w(x) this dimension is 2-((ln 2)/(ln 3)), or about 1.37. For a polar wheel we must have positive radius, so we add 3 to the value: that is, we take our monster wheel to be r(θ)=w(θ)+3 (Figure ).

Extra, deriv of loop.

der=D[RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ],0}, {ϕ,1}];
der2=D[RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ],0}, {ϕ,2}];

θ=0;Show[
ParametricPlot[der, {ϕ, 0,π/2},PlotPoints->200,PlotStyle->{AbsoluteThickness[.9],Red}, Frame->True, AspectRatio->.5],
ParametricPlot[der, {ϕ, π/2,π},PlotPoints->200,PlotStyle->{AbsoluteThickness[.9],Blue}, Frame->True, AspectRatio->.5], PlotRange->All]

{xx,yy}=RotationMatrix[ϕ].(wheelPolar[depth][0])+{x[ϕ],0}
ParametricPlot[{xx,yy}, {ϕ, 0, 2π}]

ϕFunc1=Solve[yy==y,ϕ][[1,1,2]]/. C[1]->1
ϕFunc2=Solve[yy==y,ϕ][[2,1,2]]/. C[1]->0

der2=D[xx/. ϕ-> ϕFunc2, {y,2}]; 
ParametricPlot[{xx/. ϕ-> ϕFunc2,y},{y,-1,1}, PlotStyle->{Red,AbsoluteThickness[.5]},Frame->True, PlotRange->All]
Show[Plot[{xx/. ϕ-> ϕFunc2},{y,-1,1}, PlotStyle->{Red,AbsoluteThickness[.5]},Frame->True, PlotRange->All], Graphics[{AbsolutePointSize[8], Table[{If[der2>0, Red, Blue],Point[{y,xx/. ϕ-> ϕFunc2}]}, {y,-.9999,.9999,.02}]}]]

Show[ListLinePlot[Table[{y, Sign[der2]}, {y,-.9999,.9999,.02}]]]

Plot[Evaluate[D[xx/. ϕ-> ϕFunc2, {y,2}]],{y,-1,1}, PlotStyle->AbsoluteThickness[.5],Frame->True, PlotRange->{-500,500}]

D[RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ],0}, ϕ]/. ϕ-> π

ϕ=.;
Show[im, Graphics[Table[{Arrow[{pt=RotationMatrix[-ϕ1].(wheelPolar[depth][θ])+{x[ϕ1],0}, pt+der/. ϕ->ϕ1}]}, {ϕ1, 0, 2π, .3}]]]
Show[im, Graphics[{AbsolutePointSize[6],Table[{If[der2/. ϕ-> ϕ1, Red, Blue],Point[{pt=RotationMatrix[-ϕ1].(wheelPolar[depth][θ])+{x[ϕ1],0}}]}, {ϕ1, 0, 2π, .3}]}], PlotRange->{{-.3, 3π+.5},{-3, 1.2}}]

θ=π;
ϕ=0.1;
RotationMatrix[-ϕ].(wheelPolar[depth][θ])+{x[ϕ] 0 ,0}
wheelPolar[depth][0]//N

Code for the algebra

RotationMatrix[-θ].RotationMatrix[θ].{0,-Sec[θ]}+{τ[ϕ],0}//Simplify

r[θ_]:=Sec[θ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
σ[θ_,ϕ_]:=RotationMatrix[-ϕ].W[θ]+{τ[ϕ],0};
condition=TrigReduce[(∂_ϕ)σ[θ,ϕ]/. ϕ->ρ[θ]];
{TrigExpand@condition[[1]], condition[[2]]}
TrigReduce[σ[θ,θ]]
Simplify[TrigReduce[condition[[1]]/. ρ[θ]->θ]]
D[ArcTanh[Sin[θ]],θ]//Simplify

Manipulate[Show[rr=road/. θ-> 1;
ParametricPlot[RotationMatrix[-ρ].W[θ]+{xx[ρ],0}, {θ, -5, 5}, PlotStyle->{AbsoluteThickness[1],Orange}],
ParametricPlot[{1,-1}(CC[W[θ]+{xx[ρ],0}]), {θ, -5, 5}, PlotStyle->{AbsoluteThickness[13],Green}],
ParametricPlot[road, {θ, -5, 5}, PlotStyle->Blue], Frame->True, GridLines->{{},{0}},Axes->False, GridLinesStyle->Red, PlotRange->{{-3,3}, {-4,2}}2, Epilog->{Text["O", {.2,.21}],AbsolutePointSize[5],AbsoluteThickness[1], {Red, Point[r1={rr[[1]], - 2-rr[[2]]}]},Point[{{0,0}, {0,-1}, {0,-2}, rr,rr{1,0}}], Line[{{0,-2},rr}], 
Blue, Line[{rr, rr{1,0}}], Dashed, Line[{{0,0}, r1}]}, FrameTicks->{Automatic, Automatic, {}, {}}, BaseStyle->{FontFamily->"Times", 12}], {ρ, 0,3}]

Old

•  Robison’s condition—that corresponding points are contact points—can be formulated as follows: there exists a point P on the wheel and a point P' on the road such that P'=C(P), and P, P' are in contact at some stage of rolling, and the congruence C is such that increasing the parameter θ on the wheel increases the x-coordinate of the corresponding point on the road.   Are you assuming here that the curves are rectifiable/differentiable?

Under these assumptions, it follows that all points corresponding to each other under C are in contact during rolling. Indeed, since C preserves curve lengths (rectifiable?), the image of an arbitrary point Q on the wheel can be determined by measuring its signed distance along the wheel from P and locating a point Q' on the road at the same signed distance from P'. Because there is no slipping, Q and its image Q'=C(Q) are contact points.

A New Approach to the Square Wheel

A Rigorous Approach to the Square Wheel   Not good because Robison was rigorous.

A Rigorous Approach to Rolling Wheels  Not good because Robison was rigorous.

The trivial way to prove the square wheel works:

An alternate approach is to start with y=-cosh x=-r(θ) and r(θ)=sec θ and check that it all works. We have x=(cosh^(-1))(sec θ). Then the derivative in the no-slipping condition is (0,0).

Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(Sec[θ]{Sin[θ], - Cos[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ, 0<θ<π/2]

x=∫ sec θ dθ=∫((cos θ)/(1-(sin^2)θ))dθ=∫(1/(1-(u^2)))du=(tanh^(-1))u=(tanh^(-1))(sin θ)=±(cosh^(-1))(sec θ)=±(cosh^(-1))(-y).

New Idea: Nice name:  An Infinite Loop  !
Example

A very simple approach to the rolling line is to start with the line and catenary and verify that it works. Assume 0≤θ<π/2; symmetry yields the negative case. Take y=-cosh x=-r(θ) and r(θ)=sec θ; then x=(cosh^(-1))(sec θ). It is then easy to verify that there is no slipping when ρ and τ are properly specified: ρ(θ)=θ and τ(ϕ)=(cosh^(-1))(sec ϕ). This works because:

M(θ)·W(θ)+(τ(θ),0)=(τ(θ),-cosh(τ(θ)),

which shows that there is contact when ρ(θ)=θ, and

M'(θ)·W(θ)+(τ'(θ),0)=(0,0)

which shows that there is no slipping on contact.

One can verify these with 0 computation...  translation cancels rotation, and similar.

M[ϕ_]:=RotationMatrix[-ϕ];
r[θ_]:=Sec[θ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
τ[θ_]:=ArcCosh[Sec[θ]];
Simplify[{M[θ].W[θ]+{τ[θ],0}=={τ[θ],-Cosh[τ[θ]]},M'[θ].W[θ]+{τ'[θ],0}},0<θ<π/2]

Simplify[{M[θ].W[θ],{τ[θ],0}}]
FullSimplify[{M'[θ].W[θ],{τ'[θ],0}},0≤θ<π/2]

THis shows the problem with negatives, where equality of (cosh^(-1))(sec ϕ) and (tanh^(-1))(sin ϕ) fails.

Plot[{ArcTanh[Sin[θ]]- ArcCosh[Sec[θ]]}, {θ, -π/2, π/2}]

Examining the preceding argument, the crux is that, at the contact point, rotational velocity exactly cancels translational velocity in the x-component (it is easy to see that both are 0 in the y-component). The rotational speed is -sec θ [[this is because two rotations cancel, as in our main proof, leaving exactly -r]]and the translational speed is (d/(dθ))(cosh^(-1))(sec θ), so the key property is that f=sec θ and g=(cosh^(-1))ϕ satisfy (d/(dθ))g(f(θ))=f(θ). Among the trig functions there is one other case of this phenomenon: (d/(dθ))(cos^(-1))(sech θ)=sech θ. This means that the wheel r=sech θ (-∞<θ<∞), a Poinsot spiral, will roll smoothly on the graph of cos x, restricted to (-π/2,π/2) (Figure ). Here x(θ)=(tan^(-1))(sinh θ).

Show[Table[Show[ParametricPlot[RotationMatrix[-ϕ].(Sech[θ] {Sin[θ],-Cos[θ]})+{ArcTan[Sinh[ϕ]],0},{θ,-2 π,5 π},PlotPoints->500,PlotStyle->{AbsoluteThickness[1], Orange}],Plot[-Cos[x],{x,-(π/2) ,(π/2) },PlotStyle->{AbsoluteThickness[2], Blue}],
Graphics[{AbsolutePointSize[2], Point[{{0,0}, {0,-1}}]/. {x_?NumericQ, y_} :> RotationMatrix[-ϕ].{x,y}+{ArcTan[Sinh[ϕ]],0}}],
Plot[-Cos[x], {x, -π, 3π/2}, PlotStyle->{Dashed, Blue, AbsoluteThickness[.6]}], BaseStyle->{FontFamily->Times,12},PlotRange->{{-.6,2.2},{-1,1}},Frame->True, ImageSize->400,PlotLabel->None, Axes->None, GridLines->{{},{0}},FrameTicks->{Range[-5,5]π/2, {-1,0,1}, {},{}}], {ϕ, {0,1.8,3.4}}]]

This idea applies to any wheel.  Suppose wheel is r(θ) as usual. To get the road, F, we need F to satisfy

   (d/(dθ))F(r(θ))=r(θ)

Try parabola:

   (d/(dθ))F(r(θ))=r(θ)

   F'(r(θ))=r(θ)/r'(θ)
   
   F'(θ)=θ/r'((r^(-1))(θ))
   F(θ)=∫(θ/(r'((r^(-1))(θ))))dθ

r[θ_]:= Sec[θ];
rInv[y_]:= ArcSec[y];
integrand=FullSimplify[(y/(r'[rInv[y]])), y<0]
ans=FullSimplify[((π I)/2)+∫integrand\[DifferentialD]y, y<0]
Simplify[Solve[x==ans, y], y<0&&x>0]

So in order to solve the classic case we must integrate:  ∫(1/(Sqrt[(y^2)-1]))dy. But the classic approach instead calls for integrating as follows: After the subsitution, it is the same thing. Curious.
     x=∫ sec θ dθ=∫((cos θ)/(1-(sin^2)θ))dθ=∫(1/((1-u)(1+u)))du=(tanh^(-1))(sin θ)=(cosh^(-1))(sec θ)=(cosh^(-1))(-y).
     
     Trying the parabola. Now I am failing to get -(x^2)+C.

Try the log spiral. Assume r=(e^(θ/2)). Standard way to get the road is x=(∫_0^θ)(e^(t/2))dθ and then invert to get θ, and apply r to get y. This requires integrating (e^(θ/2)).

r[θ_]:=(E^(θ/2));
θVal=SolveValues[x==Integrate[r[θ],θ], θ][[1]]/. C[1]->0
y==r[θVal]

The new way:  I think I have this right using y in the initial inversion. This requires integrating the constant 2.

inv=(SolveValues[r[θ]==y,θ]/. C[1]->0)[[1]]
rInv[y_]:=inv
integrand=FullSimplify[(y/(r'[rInv[y]])), y<0]
ans=Integrate[integrand,y]
SolveValues[x==ans,y][[1]]

rInv[y_]:=inv
integrand=FullSimplify[(y/(r'[rInv[y]])), y<0]

ans=FullSimplify[∫integrand\[DifferentialD]y, y<0]

r[θ_]:=(1/(2 (1+Cos[θ])));
inv=(SolveValues[r[θ]==y,θ]/. C[1]->0)
rInv[y_]:=inv
integrand=FullSimplify[(y/(r'[rInv[y]])), y<0]
ans=FullSimplify[∫integrand\[DifferentialD]y, y<0]

Solve[x==(1/2) (Sqrt[-1-4 y]),y]//Expand

Simplify[Solve[x==ans,y]]

FullSimplify[∫integrand\[DifferentialD]θ-ArcCosh[θ], 0<θ<π/4]
integrand=FullSimplify[(x/(r'[rInv[x]])), 0<x]
y==FullSimplify[∫integrand\[DifferentialD]x, 0<x<π/4]

Full

We want D[f[phi[x]],x]==phi[x], where phi[x]=Sec[x].

So we need f’[phi[x]]=phi[x]/phi’[x] for all x.

Now substite phi^(-1)[x] in place of x:

f’[x]=x/phi’[phi^(-1)[x]].

For phi[x]=Sec[x], we get

f’[x]=1/Sqrt[-1 + x^2]

Integration gives

f[x]=Log[x + Sqrt[-1 + x^2]], which is ArcCosh[x].

But I think the calculation is correct only for x>=0.

(\[DifferentialD]/(\[DifferentialD]θ))F(r(θ))=r(θ)

is  THis A very simple approach to the rolling line is to start with the line and catenary and verify that it works. That is, take y=-cosh x=-r(θ) and r(θ)=sec θ and verify that there is no slipping when ρ and τ are properly chosen. Let ρ(θ)=θ. Let τ(ϕ)=(tanh^(-1))(sin θ). This works because:   [[One can verify these with 0 computation...  translation cancels rotation, and similar]]

We have x=(cosh^(-1))(-r(θ))=(cosh^(-1))(sec θ). Then it is easily checked that the derivative in the no-slipping condition is (0,0). This follows from the observation that, at the contact point for W(θ), which we assume to be after a clockwise rotation by θ  (!!!  we also assume τ(ϕ)=x(...)), the rotational speed exactly cancels the translational speed. In the x-component the first is sec θ [[this is because two rotations cancel, as in our main proof, leaving exactly r]]and the second is (d/(dθ))(cosh^(-1))(sec θ)  [[this is because x=(cosh^(-1))(-y)=(cosh^(-1))r]], and these are indeed equal.

Hmm.. suppose we take this approach at the start, assuming r=sec θ. We want translation to cancel rotation. So we need:  (d/(dθ))f(sec θ)=sec θ. I wonder if there is another way to find the answer to this without our method of integration. Probably not

A very simple approach to the rolling line is to start with the line and catenary and verify that it works. That is, take y=-cosh x=-r(θ) and r(θ)=sec θ and verify that there is no slipping. We have x=(cosh^(-1))(-r(θ))=(cosh^(-1))(sec θ). Then it is easily checked that the derivative in the no-slipping condition is (0,0). This follows from the observation that, at the contact point for W(θ), which we assume to be after a clockwise rotation by θ  (!!!  we also assume τ(ϕ)=x(...)), the rotational speed exactly cancels the translational speed. In the x-component the first is sec θ [[this is because two rotations cancel, as in our main proof, leaving exactly r]]and the second is (d/(dθ))(cosh^(-1))(sec θ)  [[this is because x=(cosh^(-1))(-y)=(cosh^(-1))r]], and these are indeed equal.

Hmm.. suppose we take this approach at the start, assuming r=sec θ. We want translation to cancel rotation. So we need:  (d/(dθ))f(sec θ)=sec θ. I wonder if there is another way to find the answer to this without our method of integration. Probably not

Simplify[(∂_θ)ArcCosh[Sec[θ]],(π/2)>θ>0]

Problem: Find  a function f(x) such that (d/(dθ))f(sec θ)=sec θ.

Clear[f];

(∂_θ)f[Sec[θ]]

We use these simple facts: M'(ϕ)=M(ϕ+(π/2)); M(ϕ+(π/2))·(0,b)=M(ϕ)·(b,0); M(α)·M(β)=M(α+β); and W(θ)=M(-θ)(0,-r(θ)). By the no-slipping condition,

Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(Sec[θ] {Sin[θ],-Cos[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(RotationMatrix[θ].{0,-Sec[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(RotationMatrix[θ].{0,-Sec[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ]).(RotationMatrix[θ].{0,-Sec[θ]})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[(RotationMatrix[-ϕ-π/2]).(RotationMatrix[θ].{0,-Sec[θ]})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[RotationMatrix[-ϕ].(RotationMatrix[θ].{-Sec[θ],0})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[{-Sec[θ],0}+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[{-Sec[θ],0}+D[{ArcCosh[Sec[θ]],0}, θ],π/2> θ>0]
Simplify[-Sec[θ]+D[ArcCosh[Sec[θ]], θ],π/2> θ>0]
Simplify[(∂_θ)ArcCosh[Sec[θ]],(π/2)>θ>0]

The key idea that links the catenary to the line is the fact that (d/(dθ))(cosh^(-1))(sec θ)=sec θ.   [[this is evident when one starts with the catenary and line and proves that it works out for rolling.]]There is one other instance of this phenomenon among trig functions: (d/(dθ))(cos^(-1))(sech θ)=sech θ. This means that the wheel r=sech θ (-∞<θ<∞), a Poinsot spiral, will roll smoothly on the graph of the cos x, restricted to (-π/2,π/2). Here x(θ)=(tan^(-1))(sinh θ).

im1=ParametricPlot[{θ,Sech[θ]}, {θ, -7,7}, Frame->True, AspectRatio-> .6,BaseStyle->{FontFamily->Times, 12}, FrameTicks->{{Automatic,{}},{Automatic,{}}}, PlotStyle->Black, Axes->False];
im2=ParametricPlot[{θ,Sech[θ]//Log}, {θ, -7, 7}, Frame->True,  AspectRatio-> .6,BaseStyle->{FontFamily->Times, 12}, FrameTicks->{{Automatic,{}},{Automatic,{}}}, PlotStyle->Black, Axes->False];
GraphicsRow[{im1, im2}]

Plot[{-Log[Sech[θ]] , θ - .3 }, {θ, 0, 10}]

im1=ParametricPlot[Sech[θ] {Sin[θ],-Cos[θ]},{θ,0,10 π},PlotPoints->500,PlotRange->All,PlotStyle->{AbsoluteThickness[.8], Orange}, Frame->True];
im2=ParametricPlot[Sech[θ] {Sin[θ],-Cos[θ]},{θ,0,10 π},PlotPoints->500,PlotRange->(1/10 {{-.05,.03}, {-.04, .02}}),PlotStyle->{AbsoluteThickness[.8], Orange}, Frame->True];
GraphicsRow[{im1, im2}]

im1=ParametricPlot[Log[Sech[θ]] {Sin[θ],-Cos[θ]},{θ,0,10 π},PlotPoints->500,PlotRange->({{-.1,.1}, {-.1, .1}}; All),PlotStyle->{AbsoluteThickness[5], Yellow}, Frame->True];
im2=ParametricPlot[(θ+Log[4 π]) {Sin[θ],-Cos[θ]},{θ,-π,10 π},PlotPoints->500,PlotRange->({{-.1,.1}, {-.1, .1}}; All),PlotStyle->{{AbsoluteThickness[.5], Blue}}, Frame->True];
GraphicsRow[{im1, im2}]
Show[im1, im2]

Log[3π] 1.

Show[Table[Show[ParametricPlot[RotationMatrix[-ϕ].(Sech[θ] {Sin[θ],-Cos[θ]})+{ArcTan[Sinh[ϕ]],0},{θ,-2 π,5 π},PlotPoints->500,PlotStyle->{AbsoluteThickness[1], Orange}],Plot[-Cos[x],{x,-(π/2) ,(π/2) },PlotStyle->{AbsoluteThickness[2], Blue}],
Graphics[{AbsolutePointSize[2], Point[{{0,0}, {0,-1}}]/. {x_?NumericQ, y_} :> RotationMatrix[-ϕ].{x,y}+{ArcTan[Sinh[ϕ]],0}}],
Plot[-Cos[x], {x, -π, 3π/2}, PlotStyle->{Dashed, Blue, AbsoluteThickness[.6]}], BaseStyle->{FontFamily->Times,12},PlotRange->{{-.6,2.2},{-1,1}},Frame->True, ImageSize->400,PlotLabel->None, Axes->None, GridLines->{{},{0}},FrameTicks->{Range[-5,5]π/2, {-1,0,1}, {},{}}], {ϕ, {0,1.8,3.4}}]]

Manipulate[Show[ParametricPlot[RotationMatrix[-ϕ].(Sech[θ] {Sin[θ],-Cos[θ]})+{ArcTan[Sinh[ϕ]],0},{θ,-2 π,5 π},PlotPoints->500,PlotStyle->{AbsoluteThickness[.95], Orange}],Plot[-Cos[x],{x,-(π/2) ,(π/2) },PlotStyle->{AbsoluteThickness[1], Blue}],
Graphics[{AbsolutePointSize[4], Point[{{0,0}, {0,-1}}]/. {x_?NumericQ, y_} :> RotationMatrix[-ϕ].{x,y}+{ArcTan[Sinh[ϕ]],0}}],
Plot[-Cos[x], {x, -π, 3π/2}, PlotStyle->{Dashed, Blue, AbsoluteThickness[.6]}], BaseStyle->{FontFamily->Times,12},PlotRange->{{-1.6,2.4},{-1,1}},Frame->True, ImageSize->800,PlotLabel->None, Axes->None, GridLines->{{},{0}},FrameTicks->{Range[-5,5]π/2, {-1,0,1}, {},{}}], {ϕ, -0, 30π}]

The trivial way to prove the square wheel works is to  assume  the two unknown functions are cosh and sec.

An alternate approach is to start with y=-cosh x=-r(θ) and r(θ)=sec θ and check that it all works. We have x=(cosh^(-1))(sec θ). Then the derivative in the no-slipping condition is (0,0).

We use these simple facts: M'(ϕ)=M(ϕ+(π/2)); M(ϕ+(π/2))·(0,b)=M(ϕ)·(b,0); M(α)·M(β)=M(α+β); and W(θ)=M(-θ)(0,-r(θ)). By the no-slipping condition,

Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(Sec[θ] {Sin[θ],-Cos[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(RotationMatrix[θ].{0,-Sec[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ].(RotationMatrix[θ].{0,-Sec[θ]})+{ArcCosh[Sec[ϕ]],0})/. ϕ->θ,π/2> θ>0]
Simplify[(∂_ϕ)(RotationMatrix[-ϕ]).(RotationMatrix[θ].{0,-Sec[θ]})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[(RotationMatrix[-ϕ-π/2]).(RotationMatrix[θ].{0,-Sec[θ]})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[RotationMatrix[-ϕ].(RotationMatrix[θ].{-Sec[θ],0})+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[{-Sec[θ],0}+D[{ArcCosh[Sec[ϕ]],0}, ϕ]/. ϕ->θ,π/2> θ>0]
Simplify[{-Sec[θ],0}+D[{ArcCosh[Sec[θ]],0}, θ],π/2> θ>0]
Simplify[-Sec[θ]+D[ArcCosh[Sec[θ]], θ],π/2> θ>0]
Simplify[(∂_θ)ArcCosh[Sec[θ]],(π/2)>θ>0]

arcFam={ArcCos, ArcTan, ArcSin, ArcSec, ArcCsc, ArcCot, ArcCosh, ArcTanh, ArcSinh, ArcSech, ArcCsch, ArcCoth};
fam={Cos, Tan, Sin, Sec, Csc, Cot, Cosh, Tanh, Sinh, Sech, Csch, Coth};
both= Join[arcFam, fam];
poss=Tuples[{both, both}];
SortBy[Table[{p,D[p[[1]][p[[2]][x]],x]-p[[2]][x] /. x-> .123}, {p, poss}], Abs[Last[#]]&][[1;;5]]

x

Integrate[Sech[θ], θ]+π/2/. θ->0
Integrate[Sech[θ], θ]+π/2
{-ArcCot@Sech[ϕ]+π/2,0}/. ϕ->0

fix[ϕ_]:=If[EvenQ[Quotient[ϕ, 2π]], -ArcCot[Sinh[Mod[ϕ, 2π]]], ArcCot[Sinh[2π-Mod[ϕ, 2π]]]];
Plot[fix[ϕ], {ϕ, 0, 4π}]
Plot[Sech[θ], {θ, 0, 4π}]

Manipulate[Show[ParametricPlot[RotationMatrix[-ϕ].(Sech[θ] {Sin[θ],-Cos[θ]})+{fix[ϕ]+(π/2)+( π(Quotient[ϕ, 4π])),0},{θ,-2 π,5 π},PlotStyle->Orange],Table[Plot[-Cos[x-i π],{x,-(π/2) +π i,(π/2)+π i },PlotStyle->Blue], {i, 0, 3}],
Plot[-Cos[x], {x, -π, 3π/2}, PlotStyle->{Dashed, Blue, AbsoluteThickness[.6]}],PlotRange->{{-2,7},{-1,1}},Frame->True, ImageSize->800, PlotLabel->None, Axes->None, GridLines->{{},{0}},FrameTicks->{Range[5]π/2, {-1,0,1}, {},{}}],{{ϕ,0},-2π,10 π, Appearance->"Open"}]

ParametricPlot[(Sech[θ] {Sin[θ],-Cos[θ]}),{θ,-2π,2π},PlotStyle->Orange, Frame->True, PlotRange->{{-1,1}, {-2,1}}]

Code

r=(1/(2+2 Cos[θ]));∫r\[DifferentialD]θ
Simplify[SolveValues[Quiet[Eliminate[{x,y}=={(1/2) Tan[(θ/2)],-r},θ]][[2]],y][[1]],0≤x≤(π/2)]

Clear[r,ρ,τ];
r[θ_]:=Sec[θ];ρ[θ_]:= 3θ;
M[ϕ_]:=RotationMatrix[-ϕ];
W[θ_]:=r[θ] {Sin[θ],-Cos[θ]};
road=Simplify[M[ρ[θ]].W[θ]+{τ[ρ[θ]],0}];
speed2=Simplify[D[road,θ].D[road,θ]];
speed1=((r[θ])^2)+((r'[θ])^2);
DE=Solve[Simplify[speed1==speed2]/. θ->(θ/3),τ'[θ]]
DE=FullSimplify[τ'[θ]==(τ'[θ]/.Solve[Simplify[speed1==speed2]/. θ->(θ/3),τ'[θ]][[2,1]])]
τ[ϕ_]:=Evaluate[NDSolveValue[DE&&τ[0]==0, τ[θ], {θ, 0, 1}]];
ParametricPlot[road, {θ,0, .8}]

Theorem.  When a wheel W rolls smoothly along a road in this sense:
ρ(θ)=θ, what can we deduce. 

(Subscript[slipSpeed, y])=0
y=-r(θ) is immediate.
contact point is (τ(θ),-r(θ))
So we have the radius condition!
But to get arc-length, or no slipping, we need:  τ'=r.

So we can say this: 

If ρ(θ)=θ and τ'(ϕ)=r(ϕ) then we have no slipping.

Clear[r,W,M,τ,ρ];
W[θ_]:= r[θ]{Sin[θ], -Cos[θ]};
M[ϕ_] := RotationMatrix[-ϕ];
slip=M'[ρ[θ]].W[θ]+{τ'[θ],0};
contact=M[ρ[θ]].W[θ]+{τ[ρ[θ]],0};
slip//Simplify
slip/. ρ[θ]->θ//Simplify
Simplify[contact[[2]]/. ρ[θ]->θ]
Simplify[contact[[1]]/. ρ[θ]->θ]
slip/. ρ[θ]->θ/. τ'[θ]->r[θ]//Simplify
(xDer^2)+(yDer^2)/. yDer-> r'[θ]/. xDer->τ'[θ]
((r[θ])^2)+((r'[θ])^2)

INSERT HERE THE TWO NEW PROOF

New idea for square:

Proof. 
The involute curve only rises in both coordinates (trivial). So it is a function viewed as x=F(y). Suppose a red point is on the catenary. Then a red point would have to be on the green tangent line by continuity. That means a chord on the red curve has slope 1. But the slope of the red curve is cot ϕ (from our work with acute angles, or just by direct computation) and this is  > 1.

FullSimplify[D[involute, ϕ][[2]]/D[involute, ϕ][[1]], 0<ϕ<π/4]

involuteReverse=Reverse[M[ϕ].{1, -1}+{τ[ϕ],0}];catenaryReverse= { -Cosh[x-2 ArcSinh[1]], x};
P={ -Cosh[xVal],xVal};
FullSimplify[D[involuteReverse, ϕ][[2]]/D[involuteReverse, ϕ][[1]], 0<ϕ<π/4]
Show[ParametricPlot[catenaryReverse, {x,  ArcSinh[1], 2 ArcSinh[1]}, PlotStyle-> Blue],
ParametricPlot[involuteReverse, {ϕ, 0, π/4}, PlotStyle-> Red],
 Graphics[{{Green, Line[{P, P+.5}]},Dashed,Line[{P,catenaryReverse/. x-> xVal+.7}]}],Frame->True, ImageSize-> 100, PlotRange->All]

And the curvature is such that it never curves back towards the separating line.

M[x_]:=RotationMatrix[-x];
τ[θ_]:=ArcCosh[Sec[θ]];
involute=M[ϕ].{1, -1}+{τ[ϕ],0}
Plot[involute[[2]], {ϕ, 0, π/4}]
involuteFlipped={xxx,yyy}=Reverse@involute; 
Show[im,ParametricPlot[involuteFlipped, {ϕ,0,π/4}, PlotStyle->Red],ParametricPlot[involute, {ϕ,0,π/4}, PlotStyle->AbsoluteThickness[5]], PlotRange-> {{-1.6,2}, {-1.5, 1.3}}, Frame->True,AspectRatio->Automatic]

second=Simplify[D[xxx,ϕ]D[yyy,{ϕ,2}]-D[yyy,ϕ]D[xxx,{ϕ,2}], 0<ϕ<π/4]
Plot[second, {ϕ,0,π/4}]
FullSimplify[D[second,ϕ],  0<ϕ<π/4]   (* obviously only negative *)

New proof.

U = P+δ;
xx=.44;
xTan=ArcSinh[xx];
yTan=-Cosh[ArcSinh[xx]];
Sinh[xTan]+(Sqrt[(U-{xTan, yTan}).(U-{xTan, yTan})])/. δ-> 0.001

Sinh[]

U = {xVal, -Cosh[xVal]}+δ;
U = {{dist

The many and varied models provide physical proof that that the square can roll freely, but a mathematical proof should be provided as well, so that we are certain that a collision as occurs with the triangle does not happen for a square. Moreover, one can show that the right angle is the critical angle in the sense that any acute angle will yield collisions along an interval around.....

Proposition XX.  A square rolls with no collision.    [Here we are talking about both local and global collisions. Should we mention pentagons, etc? Relevant to later.]

M[x_]:=RotationMatrix[-x];pz=AbsolutePointSize[4];
τ[θ_]:=ArcCosh[Sec[θ]];
pz=3.8;
xVal=ArcSinh[1];
arcLength[x_]:=Sinh[x];
α=arcLength[xVal];
V={α,-1};
ϕVal = π/4;
locus= M[ϕ].V+{τ[ϕ],0};
xx=ArcSinh[1];
im=Show[Graphics[{AbsolutePointSize[pz],{Cyan,Line[{P={xVal, -Cosh[xVal]}, {xVal, -Cosh[xVal]}+1}]},
GeometricTransformation[GeometricTransformation[{FaceForm[],Point[{0,0}], EdgeForm[{AbsoluteThickness[1.5],Orange}], Rectangle[{-1, -1}, {1, 1}], Point[{0,-1}]}, RotationTransform[-ϕVal]], TranslationTransform[{τ[ϕVal],0}]]}],

ParametricPlot[M[ϕ].{1, -1}+{τ[ϕ],0}, {ϕ, 0, π/4}, PlotStyle-> {AbsoluteThickness[1.5],Red}],Graphics[{Text["P", P+{-.095, -.045}],AbsolutePointSize[pz], Point[{{0,-1}, {xVal, -Cosh[xVal]},{1,-1}}],
AbsoluteThickness[2], Darker@Green,Line[{{xVal, -Cosh[xVal]}, {xVal, -Cosh[xVal]}+1}]}],
Plot[-Cosh[x], {x, -ArcSinh[1], ArcSinh[1]}, PlotStyle->{AbsoluteThickness[1.5],Blue}], 
ParametricPlot[{x, -Cosh[x-2 ArcSinh[1]]}, {x,  ArcSinh[1], 3 ArcSinh[1]}, PlotStyle->{AbsoluteThickness[1.5],Blue}],Frame->True, PlotRange-> {{-.8,1.7}, {-1.55, .1}},ImageSize->240, AspectRatio->Automatic, PlotRangeClipping->True, GridLines-> {{xVal,xx};{}, {-1,0}}, BaseStyle->{FontFamily->Times, 9}, FrameTicks->{{{-Sqrt[2],0,-1},{}},{{-1,0,2,1},{}}}]

Proof.  Let (Subscript[M, ϕ]) and τ be as above: τ(ϕ)=(cosh^(-1))(sec ϕ). Let V=(-1,1) and restrict consideration to the bottom edge of the square and to 0≤ϕ<π/4; let P be the cusp ((sinh^(-1))1,-(Sqrt[2])). The locus of V during the rolling is Λ=(Subscript[M, ϕ])·V+(τ(ϕ),0)=(cos ϕ-sin ϕ+(cosh^(-1))(sec ϕ),-sin ϕ-cos ϕ). The second arch of the road stays under the tangent line at P. But the locus is above this tangent because the following dot product is positive: (Λ-P)·(1,1)=((Sqrt[2])-2 sin ϕ)+((cosh^(-1))(sec ϕ)-(sinh^(-1))1); see Figure . The first two summands add to a positive number, as do the last two. One must also show that no point on the square other than vertex V can crash into the road. Let Q be a point on the bottom edge of the square. Then Q cannot collide with the first arch because it lies on a tangent line to the catenary (by Corollary (d)). And Q cannot collide with the second arch because V does not collide and V would have to crash through first. (Let L be the line through V perpendicular to VQ. Move L parallel to itself to L', tangent to the arch; the arch is entirely below L' while LP is above it.) Other cases follow by symmetry???.   □

M[x_]:=RotationMatrix[-x];
GT=GeometricTransformation;RT=RotationTransform; TT=TranslationTransform;
τ[θ_]:=ArcCosh[Sec[θ]];
locus=M[ϕ].{1,-1}+{τ[ϕ],0};
square={Rectangle[{-1,-1}, {1,1}]; Line[{{-5,-1}, {5,-1}}]};
P={ArcSinh[1],-Cosh[ArcSinh[1]]}//Simplify;
dot=FullSimplify[(involute-P). {1,1},0<ϕ<(π/4)]
FindInstance[dot<0&&0≤ϕ<π/4, ϕ]  (* fails !! *)

Proof.  Let (Subscript[M, ϕ]) and τ be as above: τ(ϕ)=(cosh^(-1))(sec ϕ). Let V=(1,-1). The locus of V is (Subscript[M, ϕ])·V+(τ(ϕ),0)=(X,Y)=(cos ϕ-sin ϕ+(cosh^(-1))(sec ϕ),-sin ϕ-cos ϕ) with 0≤ϕ≤π/4. The second arch of the road is (x+2 (sinh^(-1))1,-cosh x). 
• The locus curves away from the tangent in an upward direction near its lowest point. Slope is cot ϕ and that only decreases as ϕ moves down from π/4. 
• If a point on the locus for 0≤ϕ<π/4 were to lie on the road, there would be another point that lies on the tangent line.
• By the mean value theorem, there would be a point on the locus for which the slope was 1, and that contradicts cot ϕ.

 and the x-coordinate of the point on the road with y-coordinate Y is (Subscript[X, 1])=2 (sinh^(-1))1-(cosh^(-1))(-Y). [This required making a choice among ∞ many solutions.] So a proof of no collision follows from X≤(Subscript[X, 1]).
The involute curve only rises in both coordinates (trivial). So it is a function viewed as x=F(y). Suppose a red point is on the catenary. Then a red point would have to be on the green tangent line by continuity. That means a chord on the red curve has slope 1. But the slope of the red curve is cot ϕ (from our work with acute angles, or just by direct computation) and this is  > 1.

Proof.  Let (Subscript[M, ϕ]) and τ be as above: τ(ϕ)=(cosh^(-1))(sec ϕ). Let V=(1,-1). The locus of V is (Subscript[M, ϕ])·V+(τ(ϕ),0)=(X,Y)=(cos ϕ-sin ϕ+(cosh^(-1))(sec ϕ),-sin ϕ-cos ϕ) with 0≤ϕ≤π/4. The second arch of the road is (x+2 (sinh^(-1))1,-cosh x) and the x-coordinate of the point on the road with y-coordinate Y is (Subscript[X, 1])=2 (sinh^(-1))1-(cosh^(-1))(-Y). [This required making a choice among ∞ many solutions.] So a proof of no collision follows from X≤(Subscript[X, 1]).

We want Q=(Subscript[X, 1])-X=2(sinh^(-1))1-(cosh^(-1))(sin ϕ+cos ϕ)-cos ϕ+sin ϕ-(cosh^(-1))(sec ϕ)≥0. We have Q(0)=2 (sinh^(-1))(1)-1≥0.76 and Q(π/4)=0, so it suffices to show that Q'(ϕ)≤0 over [0,π/4]. We have

Q'(ϕ)=sin ϕ+cos ϕ-sec ϕ -((cos ϕ - sin ϕ)/(Sqrt[sin(2 ϕ)]))=(tan ϕ)(cos ϕ -sin ϕ)-((cos ϕ - sin ϕ)/(Sqrt[sin(2 ϕ)]))

and we can divide by the nonnegative cos ϕ-sin ϕ, so we want (Sqrt[sin(2ϕ)])tan ϕ≤1. But each factor is at most 1 for 0≤ϕ≤π/4.

One must also show that no point on the square other than vertex V can crash into the road. Let P be a point on the bottom edge of the square. Then P cannot collide with the first arch because it lies on a tangent line to the catenary (by Corollary (d)). And P cannot collide with the second arch because V does not collide and V would have to crash through first. (Let L be the line through V perpendicular to VP. Move L parallel to itself to L', tangent to the arch; the arch is entirely below L' while LP is above it.) Other cases follow by symmetry???. This can also be done by algebra, showing that the “distance from a collision” only increases as P moves away from V.  □

Proof.  Consider an acute angle rolling into the cusp, P=(x,-cosh x), between two congruent catenaries. Let λ be the arc length of the catenary from (0,-1) to P; then λ=(sinh^(-1))x and the angle at the cusp is ρ=2(cot^(-1))λ (Figure XXX), which is acute precisely when λ>1. Start with the acute angle maybe as the theorem is about acute angles. Consider a wheel that is an angle of magnitude ρ as in Figure XXX with center at (0,0). Let V=(λ,-1), the vertex of the angle. The slope of the side leaving P is cot(ρ/2)=λ. Consider the locus L(ϕ) of V as the angle rolls into the cusp. That curve is an involute of the catenary (unwrapping a string of length λ) and it therefore (why) makes a right angle with the catenary at the cusp. The slope of the catenary at P is -λ. Therefore the slope of the locus is 1/λ. Because λ>1, this means that the locus must intersect the catenary at a point other than P, V will crash into the catenary, and physical rolling is impossible.  □

Email List and Cover Letter

Date:  April 2026;   By AS and SW. Blind refereeing for AMM.
Text, Figs Refs now all 12 point.



This needs style sheet “BookSW”. 
Probably there is too much detail here for AMM. But it seems reasonable for a preprint on ArXiv. And it should be ok for AMM review purposes.

Send preprint to:

JJ Cote
Tilley
Beveridge
Halverson
Elgersma
MY PUBLIC
Tabachikov
Levi
....one more from Serge.
....Gil Bor?
ullman
velleman
Cindy Lawrence:  George Hart
Annalisa Crannell.
peter webb
Leon Hall
Buhler
Carter
Taylor
Greg T.
Coll
McIlveny
robert.jantzen@villanova.edu   (https://homepage.villanova.edu/robert.jantzen/maple/misc/squarewheel0.pdf)

send to 
Texas A&M
St Norbert

Cover letter:

Editor:    In 1960, when presenting the original square wheel discovery, Robison stated some assumptions for a rolling wheel which include an equilibrium condition and an arc length condition. His assumptions were repeated by later authors without question (including me!). But the equilibrium condition is not intuitive, and it turns out to be completely unnecessary. Here we present a single axiom for rolling: the friction is adequate for the wheel to roll without slipping. This single axiom implies both the arc-length condition and Robison’s equilibrium condition. Given the popularity of the square wheel idea (National Museum of Mathematics in NYC; Cody Dock Bridge near London, England; several colleges and universities have models), it seems appropriate to give a rigorous presentation of what “smooth rolling” means. A benefit of our approach is that there is no need to assume differentiability of the curves. Thus we can apply it to Weierstrass’s monster function. Finally, we present an example that shows that the arc-length condition by itself is insufficient to guarantee no slipping.

If accepted we can redo all the art in black/white; but the color versions should be used in an on-line publication.