# How Can I animate rotating disk with spring pendulum?

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]"}]}

• Did you take the solution of equations from another forum? Jan 12, 2019 at 12:41
• It is necessary to place the picture and give a link to the beginning of the discussion on community.wolfram.com/groups/-/m/t/1578585?p_p_auth=i7Qmt0ji Jan 12, 2019 at 13:07
• Yes. @AlexTrounev Thanks for helping me. Jan 12, 2019 at 19:32

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.. Jan 14, 2019 at 14:55

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}]` Jan 12, 2019 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. Jan 12, 2019 at 20:18
• link Here picture and details. Jan 12, 2019 at 20:37