Initialization for Lagrangian Problems

Needs["VariationalMethods`"]

?EulerEquations

L=m/2  x'[t]^2 -k/2  x[t]^2

EulerEquations[L,x[t],t]//ExpandAll

?FirstIntegrals

FirstIntegrals[L,x[t],t]//ExpandAll

Problem 3: Bead on a Rotating Hoop  
	*check DBC for correct code*

Remarks and outline

Solution

Clear["Global`*"]

Part a

x2rRule={x,y,z}->{(r Sin[θ[#]]Cos[ω #])&,(r Sin[θ[#]]Sin[ω #])&,(r Cos[θ[#]])&}//Thread;

ψRule={θ->(π- ψ[#]& )};

T=(1/2) m (((x'[t])^2)+((y'[t])^2)+((z'[t])^2))//.x2rRule /.ψRule//Simplify

V=m g z[t]//.x2rRule /.ψRule//Simplify

L=(T-V)

eq1=EulerEquations[L, ψ[t],t]

ψSol= (Solve[eq1,ψ''[t]]//Flatten)/.{g->((ωc)^2) r}//ExpandAll

energy=(ψ'[t] D[L,ψ'[t]]-L)/.{g->((ωc)^2) r}//Simplify

D[energy,t]/.ψSol/.{g->ωc^2 r}  //Simplify

FirstIntegrals[L, ψ[t],t]/.{g->((ωc)^2) r}//Simplify

Part b

Veff=energy//.{ψ'[t]->0}//ExpandAll

dVeff= D[Veff,ψ[t]]

(*sol=Solve[dVeff ==0,ψ[t],InverseFunctions->True ] *)
sol=Solve[dVeff ==0,ψ[t],InverseFunctions->True ] /.C[1]-> 0//Simplify

(*{{ψ[t] -> 0}, {ψ[t] -> -ArcCos[(((ωc)^2)/(ω^2))]}, {ψ[t] -> ArcCos[(((ωc)^2)/(ω^2))]}} -should output^^^^^^^*)
testRule=-(Sqrt[(ω^2)])≤ωc≤(Sqrt[(ω^2)])
sol=Simplify[Solve[dVeff ==0,ψ[t],Reals,InverseFunctions->True] /.C[1]->0,Assumptions->testRule]
(*eqRule=Join[{{ψ[t]->π}},sol] *)(*THIS LINE IS OBSOLETE BECAUSE THE FIX GIVES ALL THE EQUILIBRIUM POINTS*)

dVeff==0//.sol

(*{True, True, True, True} -should output^^^^^^^*)

values1={r->1, ωc->1, m->1};

Plot3D[Evaluate[Veff/.values1],{ψ[t],-π,π},{ω,1,3},ColorFunction->Hue,Ticks->{π Range[-1,1,(1/2)],Automatic,Automatic}]

Plot[Evaluate[(Veff//.values1/.ω->#1&)/@{2,0.2`}],{ψ[t],-π,π},Ticks->{{-π,0,π},Automatic},Epilog->{Hue[0.6`],AbsolutePointSize[6],Point/@({ψ[t],Veff}/.sol/.values1/.ω->2)}]
(*REPLACED ALL eqRule->sol*)