Morin 6.45

A mass (call it m) slides inside a frictionless hoop with radius R, mass M and moment of inertia (Subscript[I, 0]).  By default, (Subscript[I, 0])=0, i.e. all of M is at the center.  The hoop rolls on the ground without slipping, and there is gravity g.  Here we write down the full Lagrangian and ask Mathematica to NDSolve for some motion.

Defining θ=0 to be straight down, the geometry tells us that the small mass’s coordinates are:

xm[t_] = x[t]+R Sin[θ[t]]
ym[t_] = - R Cos[θ[t]]

It’s kinetic energy is then

Km = (1/2) m ( xm'[t]^2 + ym'[t]^2)
%//Expand//Simplify (* clean it up, noticing Cos^2+Sin^2 *)

Including the kinetic energy for M and the gravitational potential, the Lagrangian is:

Lagrangian = Km + (1/2) M x'[t]^2 + m g R Cos[θ[t]]

According to Euler and Lagrange, the equations of motion are:

eqnx=(D[D[Lagrangian,x'[t]],t]==D[Lagrangian,x[t]]//Simplify)
eqnθ=(D[D[Lagrangian,θ'[t]],t]==D[Lagrangian,θ[t]]//Simplify)

Once we choose numerical parameters, we can ask for the motion and look for the period.

p = {R->1,g->1,M->3,m->1};
soln=NDSolve[{eqnx/.p,eqnθ/.p,x[0]==0,θ[0]==0,x'[0]==1,θ'[0]==-2.5},{x[t],θ[t]},{t,-10,30}][[1]];
qx[t_] = x[t]/.soln
qθ[t_] = θ[t]/.soln

Plot[qx''[t],{t,0,10}]
Plot[qθ''[t],{t,0,10}]
FindRoot[qx''[t],{t,4}] (*Look for a zero near one period *)
T0 = t/.%  (* and save a copy under the name "T0" *)

Here is a drawing function.   You may want to use some of these elements in your own problem.

ground = {Black,Thickness[.03],Line[{{-6,-1/5},{12,-1/5}}]}  (* just a basic black line for the ground *)
wheel0= {{Gray,Thickness[.01],Table[Line[{{0,0},(R/.p){Sin[ϕ],Cos[ϕ]}}],{ϕ,0,2π,2π/7}]},{Brown,Thickness[.02],Circle[{0,0},(R/.p)]}} (* a circle with some spokes so we can see it roll *)
wheel[x_] :=Translate[Rotate[wheel0,-x/(R/.p)],{x,(R/.p)}] (* roll the wheel without slipping to position x *)
pointMass[x_,θ_] := {Red,Disk[{x+(R/.p) Sin[θ],(R/.p)(1-Cos[θ])},.08]}
drawstate[x_,θ_]:= Graphics[{wheel[x],ground,pointMass[x,θ]},PlotRange->{{-2,5},{-1/5,3}},ImageSize->800]
drawstate[0,1]

Animate[drawstate[qx[t],qθ[t]],{t,0,3T0}] (* animate three cycles *)

Here is an object one might add to the list of the graphics in the drawing function above:

breadcrumbs=ParametricPlot[{qx[t]+(R/.p)Sin[qθ[t]],(R/.p)(1-Cos[qθ[t]])},{t,0,2*11.42},Axes->False][[1]];
Graphics[breadcrumbs]

Or here is a version which draws the path as it goes

ground = {Black,Thickness[.03],Line[{{-6,-1/5},{12,-1/5}}]}  (* just a basic black line for the ground *)
wheel0= {{Gray,Thickness[.01],Table[Line[{{0,0},(R/.p){Sin[ϕ],Cos[ϕ]}}],{ϕ,0,2π,2π/7}]},{Brown,Thickness[.02],Circle[{0,0},(R/.p)]}} (* a circle with some spokes so we can see it roll *)
wheel[x_] :=Translate[Rotate[wheel0,-x/(R/.p)],{x,(R/.p)}] (* roll the wheel without slipping to position x *)
pointMass[x_,θ_] := {Red,Disk[{x+(R/.p) Sin[θ],(R/.p)(1-Cos[θ])},.08]}
state[t_]:={wheel[qx[t]],ground,pointMass[qx[t],qθ[t]],ParametricPlot[{qx[s]+(R/.p)Sin[qθ[s]],(R/.p)(1-Cos[qθ[s]])},{s,-2,t},Axes->False][[1]]}
Animate[Graphics[state[t],PlotRange->{{-1,6},{-1/5,3}},ImageSize->800],{t,-T0/2,3.6 T0}]

Or here is how to make Einstein’s head spin.

einstein=;

ein0=ParametricPlot[{r Cos[θ],r Sin[θ]},{r,0,R/.p},{θ,0,2π},PlotPoints->20,Mesh->False,Axes->False,Frame->False,PlotStyle->{Opacity[1],Texture[einstein]},BoundaryStyle->None,TextureCoordinateFunction->({#1,#2}&)][[1]];
ein[x_,θ_] :=Translate[Rotate[ein0,θ],{x,(R/.p)}]
Animate[Graphics[{ein[x,-x/(R/.p)],ground}],{x,-π,3π}]

And here is how to draw a spring between two points, should a problem require one:

spring[pt1_,pt2_]:=Module[{q=pt2-pt1,e1,e2,s},(e1=q/Norm[q];e2=RotationMatrix[π/2].e1;ParametricPlot[(pt1+s (pt2-pt1)+.1Sin[12 π s] e2),{s,0,1},PlotStyle->{Thick,Green},Axes->False])][[1]]

Animate[Graphics[{ein[x,-x/(R/.p)],ground,spring[{-6,0},{x-R/.p,R/.p}]}],{x,-π,3π}]

Once the animation looks good, we create a list of frames and export them to an animated gif.

frames = Table[drawstate[qx[t],qθ[t]],{t,0,3T0,T0/60}];  
(* Export["Morin645.gif",frames] *)