How to animate the path traveled by double pendulum on torus - Mathematica Stack Exchange most recent 30 from mathematica.stackexchange.com 2019-08-19T08:50:24Z https://mathematica.stackexchange.com/feeds/question/184795 http://www.creativecommons.org/licenses/by-sa/3.0/rdf https://mathematica.stackexchange.com/q/184795 1 How to animate the path traveled by double pendulum on torus acoustics https://mathematica.stackexchange.com/users/53981 2018-10-28T07:32:43Z 2018-10-28T11:30:11Z <pre><code>(*Double pendulum*) ClearAll["Global*"]; &lt;&lt; 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[]]; e3 = FullSimplify[e1[]]; sol = Flatten[ NDSolve[{e2, e3, θ1 == π/2, θ2 == π, θ1' == π, θ2' == 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 -&gt; {Red, Blue}, ImageSize -&gt; Medium, PlotLegends -&gt; {"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 -&gt; {{-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 -&gt; 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}] }] </code></pre> <p>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 . </p> https://mathematica.stackexchange.com/questions/184795/-/184799#184799 4 Answer by Henrik Schumacher for How to animate the path traveled by double pendulum on torus Henrik Schumacher https://mathematica.stackexchange.com/users/38178 2018-10-28T09:49:37Z 2018-10-28T11:30:11Z <p>This could be a strategy to achieve your goals.</p> <pre><code>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 -&gt; Thick] /. Line[x_] :&gt; Tube[x, 0.01], {t, 0, 10, 0.05}]; Manipulate[ GraphicsRow[{ Show[{ background, curves[[i]] }], frames[[i]] }, ImageSize -&gt; Large ], {i, 1, Length[curves], 1}, TrackedSymbols :&gt; i ] </code></pre> <p>The idea is as follow: Given a curve</p> <p><span class="math-container">$$\gamma \colon [0,T] \to \mathbb{R}^3,$$</span></p> <p>you obtain a <a href="https://en.wikipedia.org/wiki/Homotopy" rel="nofollow noreferrer">homotopy</a> of this curve to a point by</p> <p><span class="math-container">$$H \colon[0,T] \times [0,1] \to \mathbb{R}^3, \qquad H(t,s) = \gamma(s t).$$</span></p> <p>You can now use one of the parameters <span class="math-container">$s$</span> or <span class="math-container">$t$</span> as animation parameter and the other one as plotting parameter. If you use <code>t</code> as "time" in the animation and if you plot the curve <span class="math-container">$s \mapsto H(t,s)$</span> for <span class="math-container">$s \in [0,1]$</span> and fixed <code>t</code>, you obtain exactly the curve that <span class="math-container">$\gamma$</span> traveled from time <span class="math-container">$0$</span> to time <span class="math-container">$t$</span>. That's it basically.</p> <p>The replacement rule</p> <pre><code>Line[x_] :&gt; Tube[x, 0.01] </code></pre> <p>just turns the rather thin curves produced by <code>ParametricPlot3D</code> into a tubular curves for better visibility.</p>