# How to animate the path traveled by double pendulum on torus

(*Double pendulum*)
ClearAll["Global*"];
<< VariationalMethods
Needs["DifferentialEquationsNDSolveProblems"];
Needs["DifferentialEquationsNDSolveUtilities"];
L1 = 1;
L2 = 1;
m1 = 1;
m2 = 1;
g = 9.81;
x1 = L1*Sin[θ1[t]];
x2 = L1*Sin[θ1[t]] + L2*Sin[θ2[t]];
y1 = -L1*Cos[θ1[t]];
y2 = -L1*Cos[θ1[t]] - L2*Cos[θ2[t]];
v1 = m1*g*y1;
v2 = m2*g*y2;
V = v1 + v2;
t1 = TrigReduce[0.5*m1*((D[x1, {t, 1}])^2 + (D[y1, {t, 1}])^2)];
t2 = TrigReduce[0.5*m2*((D[x2, {t, 1}])^2 + (D[y2, {t, 1}])^2)];
T = t1 + t2;
Lg = T - V;
e1 = EulerEquations[Lg, {θ1[t], θ2[t]}, {t}];
e2 = FullSimplify[e1[[1]]];
e3 = FullSimplify[e1[[2]]];
sol = Flatten[
NDSolve[{e2, e3, θ1[0] == π/2, θ2[0] == π, θ1'[0] == π, θ2'[0] == 0}, {θ1[t], θ2[t]}, {t, 0, 10}]];
Plot[{θ1[t] /. sol, θ2[t] /. sol}, {t, 0, 10}];
xx1[t_] := Evaluate[L1*Sin[θ1[t]] /. sol];
yy1[t_] := Evaluate[-L1*Cos[θ1[t]] /. sol];
xx2[t_] := Evaluate[L1*Sin[θ1[t]] + L2*Sin[θ2[t]] /. sol];
yy2[t_] := Evaluate[-(L1*Cos[θ1[t]] + L2*Cos[θ2[t]]) /. sol];

gr = ParametricPlot[
Evaluate[{{xx1[t], yy1[t]}, {xx2[t], yy2[t]}} /. sol], {t, 0, 10},
PlotStyle -> {Red, Blue}, ImageSize -> Medium,
PlotLegends -> {"Trajectory of pendulum 1",
"Trajectory of pendulum 2"}]

frames = Table[
Graphics[{Gray, Thick,
Line[{{0, 0}, {xx1[t], yy1[t]}, {xx2[t], yy2[t]}}],
Darker[Green], Disk[{0, 0}, .2], Darker[Yellow],
Disk[{xx1[t], yy1[t]}, .2], Darker[Red],
Disk[{xx2[t], yy2[t]}, .2]},
PlotRange -> {{-3.5, 3.5}, {-3.5, 3.5}}], {t, 0, 10, .05}];
ListAnimate[frames]

With[{rr = 3, r = 1},
torus[{u_, v_}] := {(rr + r*Cos[2 Pi u])* Cos[2 Pi v], (rr + r*Cos[2 Pi u])*Sin[2 Pi v], r*Sin[2 Pi u]}]
ParametricPlot3D[
Evaluate[torus@{θ2[t], θ1[t]} /. sol], {t, 0, 10},
PlotStyle -> Red];
torus[θ1_, θ2_] := (1 + 1/3 Cos[θ2]) {Cos[θ1], Sin[θ1], 0} + {0, 0, Sin[θ2]/3}
Show[{
ParametricPlot3D[ torus[θ1, θ2], {θ1, 0, 2 Pi}, {θ2, 0, 2 Pi}],
ParametricPlot3D[ torus[θ1[t], θ2[t]] /. sol, {t, 0, 10}]
}]


I have a working code of animation of a double pendulum. I have theta1 and theta2. I wanted to trace the path followed by double pendulum on the torus. meaning as the pendulums moves the path should be traced simultaneously on torous. And I wanted to put both these annimation side by side .

• ListAnimate I used but seems it is not working. as I tried before , for each instant of time I tried to save the trajectory in a table form later used ListAnimate , but failed. Oct 28 '18 at 9:20

This could be a strategy to achieve your goals.

background = ParametricPlot3D[ torus[θ1, θ2], {θ1, 0, 2 Pi}, {θ2, 0, 2 Pi}];
curve[t_] = torus[θ1[t], θ2[t]] /. sol;

(* creating the curve plots for all discete times: all computations are done here and not in Manipulate so that computations have to be done only once, speeding up the animation process  *)
curves = Table[
ParametricPlot3D[curve[s t], {s, 0, 1}, PlotStyle -> Thick] /.
Line[x_] :> Tube[x, 0.01],
{t, 0, 10, 0.05}];

Manipulate[
GraphicsRow[{
Show[{
background,
curves[[i]]
}],
frames[[i]]
},
ImageSize -> Large
],
{i, 1, Length[curves], 1},
TrackedSymbols :> i
]


The idea is as follow: Given a curve

$$\gamma \colon [0,T] \to \mathbb{R}^3,$$

you obtain a homotopy of this curve to a point by

$$H \colon[0,T] \times [0,1] \to \mathbb{R}^3, \qquad H(t,s) = \gamma(s t).$$

You can now use one of the parameters $$s$$ or $$t$$ as animation parameter and the other one as plotting parameter. If you use t as "time" in the animation and if you plot the curve $$s \mapsto H(t,s)$$ for $$s \in [0,1]$$ and fixed t, you obtain exactly the curve that $$\gamma$$ traveled from time $$0$$ to time $$t$$. That's it basically.

The replacement rule

Line[x_] :> Tube[x, 0.01]


just turns the rather thin curves produced by ParametricPlot3D into a tubular curves for better visibility.

• Sir can you briefly explain it, please. what exactly you have done. It sever the purpose and I take this as an answer. I wanted to understand what is happening. Oct 28 '18 at 10:19