How to plot a function on a torus?

Question

<< VariationalMethods`
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
L1 = 1;
L2 = 0.0001;
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] == 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]}]

I have two functions Theta1[t] and Theta2[t], and I know how these two functions vary from t=0 to t=10. I want to color the points of the torus based on Theta1[t] and Theta2[t]. I have constructed the torus. Now I want to plot the Theta1[t] and Theta2[t], for different initial conditions of Theta1[t] and Theta2[t]. Now I want to extract the lines obtained from the parametric plot and plot on the torus.

Actually, it is the solution of the double pendulum , The code is bit lenghty — acoustics, Sep 17 '18 at 10:06
Perhaps you could give us a similar function with a similar prototype then? Something you can later replace with your complicated function? — Johu, Sep 17 '18 at 11:34
It's unclear to me what you mean by "plotting on a torus". Do you want to draw some lines/curves on the torus? If yes, how do you position them based on the $(x,t)$ values? Or you want to colour the points of the torus based on some function? Please make the question unambiguous. — Szabolcs, Sep 17 '18 at 13:02
Also show what you've tried. Can you plot a torus (ParametricPlot3D)? A torus of what shape? Do you have a specific coordinate system in mind to identify points on the surface of the torus? — Szabolcs, Sep 17 '18 at 13:03
maybe ParametricPlot3D[ Evaluate[{torus@{xx1[t], yy1[t/2/Pi]}, torus@{xx2[t], yy2[t]}} /. sol], {t, 0, Pi/2}, PlotStyle -> {Red, Blue}]? — kglr, Sep 18 '18 at 04:06
Can we plot theta[1] and theta[2] on torus, instead of xx1[t],xx2[t],yy1[t],yy2[t], I tried changing it but nothing is appearing in the plot — acoustics, Sep 18 '18 at 07:49
ParametricPlot3D[ Evaluate[torus@{θ2[t], θ1[t]} /. sol], {t, 0, Pi/8}, PlotStyle -> Red]? — kglr, Sep 18 '18 at 08:54
You mention that your equation is for a double pendulum. Is it in two dimensions (restricted to the x-y plane)? Do you simply want to treat the angles of the two levers as the coordinates of a torus? — LLlAMnYP, Sep 18 '18 at 09:40

score 2 · Answer 1 · answered Sep 18 '18 at 09:48

Hopefully I got your intent right. I take the equations for a double pendulum from this question.

sol = First@
  NDSolve[{2*phi1''[t] + phi2''[t]*Cos[phi1[t] - phi2[t]] + 
      phi2'[t]^(2)*Sin[phi1[t] - phi2[t]] + 2*9.81*Sin[phi1[t]] == 
     phi2''[t] + phi1''[t]*Cos[phi1[t] - phi2[t]] - 
      phi1'[t]^(2)*Sin[phi1[t] - phi2[t]] + 9.81*Sin[phi2[t]] == 0, 
    phi1[0] == Pi/2, phi2[0] == Pi, phi1'[0] == 0, 
    phi2'[0] == 0}, {phi1, phi2}, {t, 0, 10}]

I parametrize a torus with center at the origin, major radius of 1, minor radius of 1/3 as follows:

torus[phi1_, phi2_] := 
  (1 + 1/3 Cos[phi2]) {Cos[phi1], Sin[phi1], 0} + {0, 0, Sin[phi2]/3}

I plot the torus itself with the trajectory of the double pendulum as follows:

Show[
 {ParametricPlot3D[torus[phi1, phi2], {phi1, 0, 2 Pi}, {phi2, 0, 2 Pi}],
  ParametricPlot3D[torus[phi1[t], phi2[t]] /. sol, {t, 0, 10}]}]

How to plot a function on a torus?

1 Answers1