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$
1
  • $\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$ Commented Apr 8, 2018 at 10:05

2 Answers 2

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$
7
  • $\begingroup$ Thanks. It looks nice. $\endgroup$
    – H. Kenan
    Commented Apr 8, 2018 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
    Commented Apr 8, 2018 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$ Commented Apr 8, 2018 at 8:53
  • $\begingroup$ Tried, but it shows "could not combine graphics objects". $\endgroup$
    – H. Kenan
    Commented Apr 8, 2018 at 16:45
  • $\begingroup$ @user, try Show[Graphics3D[{Opacity[2/3], Sphere[{0, 0, 0}, 1/2]}], ParametricPlot3D[(* stuff *)] /. Line -> Tube] $\endgroup$ Commented Apr 8, 2018 at 16:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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