Dos partículas acopladas

Sin rotación

Quit

Posición

Para despejar la posición de cada partícula escribimos la condición para que el centro de masas esté en el origen y la ecuación que define δx

Ecua={(m1 x1[t]+m2 x2[t])/(m1+m2)==0, δx[t]==x2[t]-x1[t]-a}

De donde podemos resolver para las posiciones de cada una de las partículas

Solve[Ecua,{x1[t],x2[t]}]

x1[t_]=-((m2 (a+δx[t]))/(m1+m2))

x2[t_]=((m1 (a+δx[t]))/(m1+m2))

Solución

La solución para la distancia relativa toma la forma

δx[t_]:=A Cos[ω0 t+δ]

Animación

Para hacer una animación les damos valores a las constantes

ω0=2 ;
A=2;
δ=0;
m1=5;
m2=5;
a=5;

Con lo cual tenemos

Animate[Graphics[{Polygon[{{-10,-5},{10,5}}],{Orange,Disk[{x1[t],0},m1/5]},{Red,Disk[{x2[t],0},m2/5]}}],{t,0,10}]

Con rotación

Quit

Posición

Escribiendo la condición para que el centro de masas esté en el origen y la definición de las coordenadas relativas

Ecua={(m1 x1[t]+m2 x2[t])/(m1+m2)==0,(m1 y1[t]+m2 y2[t])/(m1+m2)==0, x[t]==x2[t]-x1[t], y[t]==y2[t]-y1[t]}

Solve[Ecua, {x1[t],x2[t],y1[t],y2[t]}]

x1[t_]:=-((m2 x[t])/(m1+m2))

x2[t_]:=((m1 x[t])/(m1+m2))

y1[t_]:=-((m2 y[t])/(m1+m2))

y2[t_]:=((m1 y[t])/(m1+m2))

Solución

La solución se escribe

x[t_]:=r[t]Cos[θ[t]]

y[t_]:=r[t]Sin[θ[t]]
r[t_]:= rc+δr[t]

δr[t_]:= A Cos[ω0 t+δ]

Donde tenemos que el ángulo está dado por

Integrate[ lz/(m r[t]^2),t]

Es decir que

θ[t_]:=((lz (((2 rc ArcTanh[(((-A+rc) Tan[(1/2) (δ+t ω0)])/(Sqrt[(A^2)-(rc^2)]))])/((((A^2)-(rc^2)))^(3/2)))+((A Sin[δ+t ω0])/((A-rc) (A+rc) (rc+A Cos[δ+t ω0])))))/(m ω0))

Animación

ω0=1/50;
A=2;
δ=0;
m1=8;
m2=5;
rc=8;
lz=5;

m:= m1 m2/(m1+m2)

Animate[Graphics[{Polygon[{{-10,-5},{10,5}}],{Orange,Disk[{x1[t],y1[t]},m1/5]},{Red,Disk[{x2[t],y2[t]},m2/5]}}],{t,0,100}]

Tres partículas en línea

Clear[x1,x2,ω0,A,m1,m2,δ,m]

Ecua={(mO x1[t]+mC x2[t] + mO x3[t])/(2m0+mC)==0,u[t]==x2[t]-x1[t]-a,v[t]==x3[t]-x2[t]-a}

Solve[Ecua,{x1[t],x2[t],x3[t]}] //Simplify

x1[t_]:=-((a (mC+2 mO)+(mC+mO) u[t]+mO v[t])/(mC+2 mO))

x2[t_]:=((mO (u[t]-v[t]))/(mC+2 mO))

x3[t_]:=((a (mC+2 mO)+mO u[t]+(mC+mO) v[t])/(mC+2 mO))

u[t_]:=A1 Cos[ω1 t+δ1]+A2 Cos[ω2 t+δ2]

v[t_]:=-A1 Cos[ω1 t+δ1]+A2 Cos[ω2 t+δ2]

m=mO mC / (mO+mC)

ω1 = Sqrt[k/m (2mO+mC)/(mC+mO)]

ω2 = Sqrt[k/m mC/(mC+mO)]

mO=16;
mC=12;
a=4;
A1=0;
A2=1;
δ1=0;
δ2=0;
k=1;

Animate[Graphics[{Polygon[{{-10,-5},{10,5}}],{Orange,Disk[{x1[t],0},1]},{Red,Disk[{x2[t],0},1]},{Orange,Disk[{x3[t],0},1]}}],{t,0,50}]

Quit

tab:=Table[x[a,t],{a,0,9}]

tab

Do[
x[a_,t_]:= b a + δx[a,t]
,{a,0,9}
]

tab

ω[κ_]:= 2 ω0 Sin[κ b/2] ;

δx[a_,t_]:=A Cos[κ b a +ω[κ]t+δ];

tab

tabp=Join[{Orange},Table[Disk[{x[a,t],0},1],{a,0,9}]]

ω0=2;
A=1/2;
δ=0;
κ= 1/3;
b=3;

Animate[Graphics[{Polygon[{{-5,-5},{30,5}}],{,Disk[{A Cos[δ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{b+A Cos[δ+b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{2 b+A Cos[δ+2 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{3 b+A Cos[δ+3 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{4 b+A Cos[δ+4 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{5 b+A Cos[δ+5 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{6 b+A Cos[δ+6 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{7 b+A Cos[δ+7 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{8 b+A Cos[δ+8 b κ-2 t ω0 Sin[((b κ)/2)]],0},1],Disk[{9 b+A Cos[δ+9 b κ-2 t ω0 Sin[((b κ)/2)]],0},1]}}],{t,0,50}]

Quit

tab:=Table[x[a,t],{a,0,9}]

tab

Do[
x[a_,t_]:= b a + δx[a,t]
,{a,0,9}
]

tab

ω[κ_]:= 2 ω0 Sin[κ b/2] ;

δx[a_,t_]:=A (Cos[κ b a -ω[κ]t-δ]-Cos[κ b a +ω[κ]t+δ]);

tab

tabp=Join[{Orange},Table[Disk[{x[a,t],0},1],{a,0,9}]]

ω0=1/2;
A=1/3;
δ=0;
κ=π/(b 9) 7;
b=3;

Animate[Graphics[{Polygon[{{-5,-5},{30,5}}], {,Disk[{0,0},1],Disk[{b+A (Cos[δ-b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{2 b+A (Cos[δ-2 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+2 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{3 b+A (Cos[δ-3 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+3 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{4 b+A (Cos[δ-4 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+4 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{5 b+A (Cos[δ-5 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+5 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{6 b+A (Cos[δ-6 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+6 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{7 b+A (Cos[δ-7 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+7 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{8 b+A (Cos[δ-8 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+8 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1],Disk[{9 b+A (Cos[δ-9 b κ+2 t ω0 Sin[((b κ)/2)]]-Cos[δ+9 b κ+2 t ω0 Sin[((b κ)/2)]]),0},1]}}],{t,0,50}]

Clear[κ]

π/b

Plot[ω[κ]/κ,{κ,-π/b,π/b}]

Clear[b,x]

(Series[{x+b,y}/Sqrt[b^2+2b x+x^2+y^2](Sqrt[b^2+2b x+x^2+y^2]-b),{x,0,2},{y,0,2}])//PowerExpand//Expand//Normal//Expand

Series[Sqrt[b^2+2b ϵ x+ϵ^2 x^2+ϵ^2y^2],{ϵ,0,2}]

(PowerExpand[%]//Normal)/. ϵ-> 1