1
$\begingroup$
(*Double pendulum*)
ClearAll["Global`*"];
<< VariationalMethods`
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
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 .

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – acoustics Oct 28 '18 at 9:20
4
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – acoustics Oct 28 '18 at 10:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.