Wańka-wstańka w postaci pólkuli na doskonale gładkiej
powierzchni poziomej. Rozwiązanie uzyskano na podstawie zadania 9.6 z książki  G. L. Kotkin, W.G. Serbo, Zbiór Zadań z Mechaniki Klasycznej, 
 Wydawnictwa Naukowo-Techniczne, Warszawa 1972

(* Uwaga: skladowa x wektora polozenia srodka masy jest stala *)

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

OP={e*Sin[phi[t]],0}   (* polozenie punktu stycznosci kuli z powierzchnia *)

PO1={0,R}

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=Simplify[xsp*xsp+ysp*ysp]

(* 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 *)

T=Simplify[(1/2)*m*vsp2 + (1/2)*Is*phi'[t]*phi'[t]]

U=m*g*ys

L=FullSimplify[T-U];

d1=D[L,phi'[t]];
d2=D[L,phi[t]];d3=D[d1,t];S1=FullSimplify[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 gładkiej 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_]={ee*Sin[phi[t]],R};

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

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

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

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

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

cmg[t_]=Point[{0,R-ee*Cos[phi[t]]}];

gcmg[t_]=Graphics[{PointSize[Large],Black,cmg[t]}];

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

gluk2g[t_]=Graphics[{Blue,Thick,luk2g[t]}];

wierzchg[t_]=Line[{P1G[t],P2G[t]}];

gwierzchg[t_]=Graphics[{Blue,Thick,wierzchg[t]}];

l1g[t_]=Line[{P3G[t],SG[t]}];

gl1g[t_]=Graphics[{Thin,l1g[t]}];

l2g[t_]=Line[{P4G[t],SG[t]}];

gl2g[t_]=Graphics[{Thin,l2g[t]}];

l3g[t_]=Line[{{0,0},{0,R}}];

gl3g[t_]=Graphics[{Thin,l3g[t]}];

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

gpodloga=Graphics[{Thick,podloga}];

shg=Animate[Show[gluk2g[t],gwierzchg[t],gl1g[t],gl2g[t],gl3g[t],gpodloga,gcmg[t],Axes->False,PlotRange->{{-2*R,2*R},{-(1/20)*R,2*R}}],{t,0,tmax},AutorunSequencing->{{1,50}}]

SetDirectory[NotebookDirectory[]]

Export["polkula_na_gladkiej_powierzchni.01.avi",shg,"FrameRate"->1]

Export["polkula_na_gladkiej_powierzchni.02.avi",shg,"FrameRate"->2]

Export["polkula_na_gladkiej_powierzchni.03.avi",shg,"FrameRate"->3]

Export["polkula_na_gladkiej_powierzchni.04.avi",shg,"FrameRate"->4]

Export["polkula_na_gladkiej_powierzchni.05.avi",shg,"FrameRate"->5]

Export["polkula_na_gladkiej_powierzchni.06.avi",shg,"FrameRate"->6]

Export["polkula_na_gladkiej_powierzchni.07.avi",shg,"FrameRate"->7]

Export["polkula_na_gladkiej_powierzchni.08.avi",shg,"FrameRate"->8]

Export["polkula_na_gladkiej_powierzchni.09.avi",shg,"FrameRate"->9]

Export["polkula_na_gladkiej_powierzchni.10.avi",shg,"FrameRate"->10]

Export["polkula_na_gladkiej_powierzchni.11.avi",shg,"FrameRate"->11]

Export["polkula_na_gladkiej_powierzchni.12.avi",shg,"FrameRate"->12]

Export["polkula_na_gladkiej_powierzchni.13.avi",shg,"FrameRate"->13]

Export["polkula_na_gladkiej_powierzchni.14.avi",shg,"FrameRate"->14]

Export["polkula_na_gladkiej_powierzchni.15.avi",shg,"FrameRate"->15]

Export["polkula_na_gladkiej_powierzchni.16.avi",shg,"FrameRate"->16]

Export["polkula_na_gladkiej_powierzchni.20.avi",shg,"FrameRate"->20]