Wańka-wstańka w postaci pólkuli na doskonale szorstkiej 
powierzchni poziomej. Rozwiązanie na podstawie zadania 5 z rozdziału VI książki
 L. Landau i E. Lifszic, Mechanika

OP={R*phi[t],0}   (* polozenie punktu stycznosci walca z powierzchnia *)

{R phi[t],0}

PO1={0,R}

e= (3/8)*R ; (* dla polkuli *)

O1S=e*{-Sin[phi[t]],-Cos[phi[t]]};

OS=OP+PO1+O1S  ;  (* polozenie srodka masy *)

xs=OS[[1]];

ys=OS[[2]];

xsp=D[xs,t];

ysp=D[ys,t];

vsp2=FullSimplify[xsp*xsp+ysp*ysp];

PS=PO1+O1S;

PS2=(PS.PS);
(* kwadrat odleglosci srodka masy od punktu stycznosci *)

omega2=Simplify[vsp2/(PS.PS)];

(* moment bezwladnosci wzgledem srodka  O1 *)
alfa= (2/5) ; (* dla polkuli *)

Io1=alfa*m*R*R  ;

Is=Simplify[Io1-m*(O1S.O1S)]   ;
(* moment bezwladnosci polkuli wzgledem srodka masy *)

Ip=Simplify[Is+m*(PS.PS)]  ;
(* moment bezwladnosci polkuli wzgledem punktu stycznosci P *)

T=FullSimplify[ (1/2)*(Is+m*(PS.PS))*phi'[t]*phi'[t]];

T2=FullSimplify[(1/2)*m*vsp2 + (1/2)*Is*phi'[t]*phi'[t]];

T==T2

U=m*g*ys;

L=FullSimplify[T-U];

d1=D[L,phi'[t]];
d2=D[L,phi[t]];d3=D[d1,t];S1=Simplify[Solve[d3==d2,phi''[t]]];

(* CForm[S1] *)

Etot=FullSimplify[T+U];

(* CForm[Etot]  *)

S1

eq1=S1[[1]]/.Rule->Equal

(* Warunki początkowe  *)

WP={phi[0]==Pi/3,phi'[0]==0}

eq2={eq1,WP}

(* Parametry układu: masa półkuli,promień półkuli oraz wartość przyspieszenia ziemskiego *)

m=1/5; (* kg *)

R=1/10; (* m *)

g=981/100; (* m/s^2 *)

tmax=50; (* s *)

numerycznie=NDSolve[eq2,phi[t],{t,0,tmax},MaxSteps->50000,WorkingPrecision->24]

Flatten[numerycznie]

(* Wyciągam funkcję phi[t] z numerycznego rozwiązania *)

phi[t_]:=Evaluate[phi[t]/.Flatten[numerycznie]]

(* Teraz mogę używać funkcji phi1[t] i phi2[t] tak, jak innych funkcji *)

phi[3]

phi'[11]

Plot[phi[t],{t,0,tmax},PlotRange->All,AxesLabel->{"t [s]","phi(t) [rad]"}]

Plot[phi'[t],{t,0,tmax},PlotRange->All,AxesLabel->{"t [s]","phi'(t) [rad/s]"}]

Plot[Evaluate[T],{t,0,tmax},PlotRange->All,AxesLabel->{"t [s]","Ekin(t) [J]"}]

Plot[Evaluate[U],{t,0,tmax},PlotRange->All,AxesLabel->{"t [s]","Epot(t) [J]"}]

Plot[Evaluate[Etot],{t,0,tmax},PlotRange->All,AxesLabel->{"t [s]","Etot(t) [J]"}]

(* Modelowanie ruchu półkuli na idealnie chropowatej powierzchni  *)

S[t_]={0,0};

P1[t_]={-R*Cos[phi[t]],R*Sin[phi[t]]};

P2[t_]={R*Cos[phi[t]],-R*Sin[phi[t]]};

P3[t_]={-R*Sin[phi[t]],-R*Cos[phi[t]]};

P4[t_]={0,-R};

ee=(3/8)*R;

shft[t_]={R*phi[t],R};

SS[t_]=S[t]+shft[t];

P1S[t_]=P1[t]+shft[t];

P2S[t_]=P2[t]+shft[t];

P3S[t_]=P3[t]+shft[t];

P4S[t_]=P4[t]+shft[t];

cms[t_]=Point[SS[t]-{ee*Sin[phi[t]],ee*Cos[phi[t]]}];

gcms[t_]=Graphics[{PointSize[Large],Black,cms[t]}];

luk2s[t_]=Circle[SS[t],R,{Pi-phi[t],2*Pi-phi[t]}];

gluk2s[t_]=Graphics[{Blue,Thick,luk2s[t]}];

wierzchs[t_]=Line[{P1S[t],P2S[t]}];

gwierzchs[t_]=Graphics[{Blue,Thick,wierzchs[t]}];

l1s[t_]=Line[{P3S[t],SS[t]}];

gl1s[t_]=Graphics[{Thin,l1s[t]}];

l2s[t_]=Line[{P4S[t],SS[t]}];

gl2s[t_]=Graphics[{Thin,l2s[t]}];

podloga=Line[{{-3*R/2,0},{3*R/2,0}}];

gpodloga=Graphics[{Thick,podloga}];

shs=Animate[Show[gluk2s[t],gwierzchs[t],gl1s[t],gl2s[t],gpodloga,gcms[t],Axes->False,PlotRange->{{-2*R,2*R},{-(1/20)*R,2*R}}],{t,0,tmax},AutorunSequencing->{{1,50}}]

SetDirectory[NotebookDirectory[]]

Export["polkula_na_szorstkiej_powierzchni.01.avi",shs,"FrameRate"->1]

Export["polkula_na_szorstkiej_powierzchni.02.avi",shs,"FrameRate"->2]

Export["polkula_na_szorstkiej_powierzchni.03.avi",shs,"FrameRate"->3]

Export["polkula_na_szorstkiej_powierzchni.04.avi",shs,"FrameRate"->4]

Export["polkula_na_szorstkiej_powierzchni.05.avi",shs,"FrameRate"->5]

Export["polkula_na_szorstkiej_powierzchni.06.avi",shs,"FrameRate"->6]

Export["polkula_na_szorstkiej_powierzchni.07.avi",shs,"FrameRate"->7]

Export["polkula_na_szorstkiej_powierzchni.08.avi",shs,"FrameRate"->8]

Export["polkula_na_szorstkiej_powierzchni.09.avi",shs,"FrameRate"->9]

Export["polkula_na_szorstkiej_powierzchni.10.avi",shs,"FrameRate"->10]

Export["polkula_na_szorstkiej_powierzchni.11.avi",shs,"FrameRate"->11]

Export["polkula_na_szorstkiej_powierzchni.12.avi",shs,"FrameRate"->12]

Export["polkula_na_szorstkiej_powierzchni.13.avi",shs,"FrameRate"->13]

Export["polkula_na_szorstkiej_powierzchni.14.avi",shs,"FrameRate"->14]

Export["polkula_na_szorstkiej_powierzchni.15.avi",shs,"FrameRate"->15]

Export["polkula_na_szorstkiej_powierzchni.16.avi",shs,"FrameRate"->16]

Export["polkula_na_szorstkiej_powierzchni.20.avi",shs,"FrameRate"->20]