How Can I animate rotating disk with spring pendulum?

Question

Here begining the question and picture I want to make animation like the double pendulum here Double Pendulum @Alexander Trounev helped me for equations.

But I can not do that on mathematica.Here my code.

Clear[R, W, l, m, g, k, l0, eqs, eqs2, t]
z1 = {-R*W*Sin[W*t] + l'[t]*Sin[\[Phi][t]] + 
    l[t]*(\[Phi]'[t])*Cos[\[Phi][t]], 
   R*W*Cos[W*t] - l'[t]*Cos[\[Phi][t]] + 
    l[t]*(\[Phi]'[t])*Sin[\[Phi][t]]};

V = m*g*(R*Sin[W*t] - l[t]*Cos[\[Phi][t]]) + 1/2*k*(l[t] - l0)^2;
T = 1/2*m*z1.z1;
Lagrange = T - V;
eqs = D[D[Lagrange, \[Phi]'[t]], t] - D[Lagrange, \[Phi][t]];
eqs2 = D[D[Lagrange, l'[t]], t] - D[Lagrange, l[t]];

g = 9.7; m = 1; l0 = 1; k = 15; R = 2; W = Pi/2;
sol = NDSolveValue[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0, 
   Derivative[1][\[Phi]][0] == 0, \[Phi][0] == 0}, {l[t], \[Phi][
    t]}, {t, 0, 20}]

{Plot[sol.{1, 0}, {t, 0, 20}, AxesLabel -> {"t", "l"}], 
 Plot[sol.{0, 1}, {t, 0, 20}, AxesLabel -> {"t", "\[Phi]"}]}

It is necessary to place the picture and give a link to the beginning of the discussion on https://community.wolfram.com/groups/-/m/t/1578585?p_p_auth=i7Qmt0ji — Alex Trounev, Jan 12 '19 at 13:07

Bob Hanlon · Answer 1 · 2019-01-12T17:58:40.677

Assuming that your equations are correct

Clear["Global`*"]
z1 = {-R*W*Sin[W*t] + l'[t]*Sin[ϕ[t]] + l[t]*(ϕ'[t])*Cos[ϕ[t]],
    R*W*Cos[W*t] - l'[t]*Cos[ϕ[t]] + l[t]*(ϕ'[t])*Sin[ϕ[t]]};

V = m*g*(R*Sin[W*t] - l[t]*Cos[ϕ[t]]) + 1/2*k*(l[t] - l0)^2;
T = 1/2*m*z1.z1;
Lagrange = T - V;

Simplify equations

eqs = D[D[Lagrange, ϕ'[t]], t] - D[Lagrange, ϕ[t]] // Simplify;

eqs2 = D[D[Lagrange, l'[t]], t] - D[Lagrange, l[t]] // Simplify;

g = 97/10; m = 1; l0 = 1; k = 15; R = 2; W = Pi/2;

sol = NDSolveValue[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0, 
    Derivative[1][ϕ][0] == 0, ϕ[0] == 0}, {l[t], ϕ[t]}, {t, 0, 
    20}];

Column[{
  Plot[sol.{1, 0}, {t, 0, 20},
   AxesLabel -> (Style[#, 12, Bold] & /@ {"t", "l"}),
   ImageSize -> 288,
   PlotStyle -> RGBColor[0.368417`, 0.506779`, 0.709798`]],
  Plot[sol.{0, 1}, {t, 0, 20},
   AxesLabel -> (Style[#, 12, Bold] & /@ {"t", "ϕ"}),
   ImageSize -> 288,
   PlotStyle -> RGBColor[0.880722`, 0.611041`, 0.142051`]]}]

pp = ParametricPlot[sol, {t, 0, 20},
   PlotStyle -> Directive[Blue, Thin]];

Animate[
 Show[pp,
  Graphics[{Red, AbsolutePointSize[4], Point[sol /. t -> t0]}]], {t0, 
  0, 20, .001},
 AnimationRate -> 1/4]

Thanks for reply.I found this code for animate , but I can see just pendulum without spring and disc.How can add the disc and spring in this code?
`sol = NDSolve[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0, Derivative[1][[Phi]][0] == 0, [Phi][0] == 0}, {l[t], [Phi][ t]}, {t, 0, 30}];

z1a = z1 /. Flatten[sol /. a_[t] -> a]; Animate[Graphics[{Red, PointSize[.05], Point[z1a /. t -> tt]}, Axes -> True, PlotRange -> {{-10, 10}, {-10, 10}}], {tt, 0, 30}]` — Carlos Campos, Jan 12 '19 at 19:29
I have no idea of the configuration/location of whatever components you have. You need to draw the configuration, say in the starting position, with appropriate labels. — Bob Hanlon, Jan 12 '19 at 20:18

score 2 · Accepted Answer · answered Jan 13 '19 at 00:21

z1 = {-R*W*Sin[W*t] + l'[t]*Sin[\[Phi][t]] + 
    l[t]*(\[Phi]'[t])*Cos[\[Phi][t]], 
   R*W*Cos[W*t] - l'[t]*Cos[\[Phi][t]] + 
    l[t]*(\[Phi]'[t])*Sin[\[Phi][t]]};

V = m*g*(R*Sin[W*t] - l[t]*Cos[\[Phi][t]]) + 1/2*k*(l[t] - l0)^2;
T = 1/2*m*z1.z1;
Lagrange = T - V;
eqs = D[D[Lagrange, \[Phi]'[t]], t] - D[Lagrange, \[Phi][t]];
eqs2 = D[D[Lagrange, l'[t]], t] - D[Lagrange, l[t]];

g = 9.7; m = 1; l0 = 1; k = 15; R = 2; W = Pi/2;
L = NDSolveValue[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0, 
    Derivative[1][\[Phi]][0] == 0, \[Phi][0] == 0}, l, {t, 0, 20}];
P = NDSolveValue[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0, 
    Derivative[1][\[Phi]][0] == 0, \[Phi][0] == 0}, \[Phi], {t, 0, 
    20}];


list = Table[
   Graphics[{Red, Circle[{0, 0}, 2], Blue, 
     Line[{{R*Cos[W*t], R*Sin[W*t]}, {R*Cos[W*t] + L[t]*Sin[P[t]], 
        R*Sin[W*t] - L[t]*Cos[P[t]]}}], Red, 
     Circle[{R*Cos[W*t] + L[t]*Sin[P[t]], 
       R*Sin[W*t] - L[t]*Cos[P[t]]}, .2]}, 
    PlotRange -> {{-4, 4}, {-5, 3}}], {t, 0, 20, .1}];
ListAnimate[list]

Thank you so much for giving me your free time..!.It was very helpful.. — Carlos Campos, Jan 14 '19 at 14:55

How Can I animate rotating disk with spring pendulum?

2 Answers2