1
$\begingroup$

I have the following set of 4 differential equations

x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p]; y'[t] == 4 a z[t]*y[t] - 2 (1 - a Cos[p]) z[t]; z'[t] == a (4 (z'[t])^2 - 1) + 2 y[t] - 2 b (y[t] Cos[p] + x[t] Sin[p]);

With $p=0$, $a=0.3$ and $b=0.5$ and given that $x^2 + y^2 + z^2 = 0.25$ at all times, how can I make a 3D plot showing $x$, $y$ and $z$?. For $a=0.3$, $b=0.5$ and $\phi=0$, I am expecting the following plot

enter image description here

$\endgroup$
  • $\begingroup$ "I am expecting the following plot" - whenever you use a picture that you did not produce yourself, it is customary to include the source (book, paper, website, etc.) of the picture in the question. $\endgroup$ – J. M. will be back soon Apr 8 '18 at 10:05
3
$\begingroup$

Use Show and ParametricPlot3D

p=0;
a=3/10;
b=1/2;

sols = {x, y, z} /.First@NDSolve[{
x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p],
y'[t] == 4 a z[t] y[t] - 2(1 - a Cos[p]) z[t],
z'[t] == a (4 (z'[t])^2 - 1) + 2 y[t] - 2 b (y[t] Cos[p] + x[t] Sin[p]),
x[0]==1/(2 Sqrt[3]),y[0]==-1/(2 Sqrt[3]),z[0]==1/(2 Sqrt[3])},{x,y,z},{t,0,100},
Method -> {"Projection", Method ->"ExplicitRungeKutta",
"Invariants" -> {x[t]^2 + y[t]^2 + z[t]^2}},WorkingPrecision->20]

Show[{
ParametricPlot3D[{sols[[1]][t],sols[[2]][t],sols[[3]][t]},{t,0,100},
PlotRange->{{-1/2,1/2},{-1/2,1/2},{-1/2,1/2}},AxesLabel->{x,y,z}],
Graphics3D[Sphere[{0,0,0},1/2]]
}]

enter image description here

$\endgroup$
2
$\begingroup$

The "Projection" method of NDSolve[] is suited for this task, since you wish to maintain an invariant.

With[{p = 0, a = 3/10, b = 1/2},
     sols = {x, y, z} /. NDSolve[{x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p], 
                                  y'[t] == 4 a z[t] y[t] - 2 (1 - a Cos[p]) z[t], 
                                  z'[t] == a (4 z'[t]^2 - 1) + 2 y[t] -
                                           2 b (y[t] Cos[p] + x[t] Sin[p]), 
                                  x[0] == -1/2, y[0] == 0, z[0] == 0},
                                 {x, y, z}, {t, 0, 100}, 
                                 Method -> {"Projection", Method -> "StiffnessSwitching", 
                                            "Invariants" -> {x[t]^2 + y[t]^2 + z[t]^2}, 
                                            MaxIterations -> 100}, WorkingPrecision -> 30]]

(As you had neglected to provide initial conditions, I made some up.)

Plot the solutions and the corresponding invariants:

{ParametricPlot3D[Through[sols[[1]][t]], {t, 0, 100}, PlotRange -> All], 
 Plot[Norm[Through[sols[[1]][t]]]^2 - 1/4, {t, 0, 100}]} // GraphicsRow

solution and invariant

{ParametricPlot3D[Through[sols[[2]][t]], {t, 0, 100}, PlotRange -> All], 
 Plot[Norm[Through[sols[[1]][t]]]^2 - 1/4, {t, 0, 100}]} // GraphicsRow

solution and invariant 2

$\endgroup$
  • $\begingroup$ Thanks. It looks nice. $\endgroup$ – H. Kenan Apr 8 '18 at 7:48
  • $\begingroup$ Is it possible to draw a sphere in the same plot to compare that spiral with respect to the sphere? $\endgroup$ – H. Kenan Apr 8 '18 at 8:05
  • $\begingroup$ Yes, you may combine the ParametricPlot with the desired sphere by the Show statement. An advice is to make the sphere transparent to be able to see a part of the trajectory diving into the sphere. Do it using the Opacity option in the Graphics3D statement. $\endgroup$ – Alexei Boulbitch Apr 8 '18 at 8:53
  • $\begingroup$ Tried, but it shows "could not combine graphics objects". $\endgroup$ – H. Kenan Apr 8 '18 at 16:45
  • $\begingroup$ @user, try Show[Graphics3D[{Opacity[2/3], Sphere[{0, 0, 0}, 1/2]}], ParametricPlot3D[(* stuff *)] /. Line -> Tube] $\endgroup$ – J. M. will be back soon Apr 8 '18 at 16:54

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.