4
$\begingroup$

Projections of the 3-dimensional phase-space of a non-autonomous ODE system

Multidimensional obstacle avoidance in ODE (Visualization)

Given simple system of ODE:

$\begin{cases} \dot{x}=g \\ \dot{o}=2 \cdot(-o+x) \\ \dot{g}=(1+\sin(3 t)) \cdot (-g+\frac{df}{do}) \\ \dot{h}=-h+\frac{d^2f}{d^2o} \end{cases}$

where $f = e^{-o^2}$

It is not difficult to construct a 3D trajectory using the command ParametricPlot3D.

Clear["Derivative"]

ClearAll["Global`*"]

pars = {xs = -1, k = (1 + 1 Sin[3 t])};

f = Exp[-(o[t])^2];

s = NDSolve[{x'[t] == g[t], o'[t] == 2 (-o[t] + x[t]), 
    g'[t] == k (-g[t] + D[f, {o[t], 1}]), 
    h'[t] == -h[t] + D[f, {o[t], 2}], x[0] == xs, o[0] == xs, 
    g[0] == 0.01, h[0] == 0}, {x, o, g, h}, {t, 0, 200}, 
   MaxSteps -> \[Infinity]];
   
ParametricPlot3D[Evaluate[{o[t], g[t], h[t]} /. s], {t, 0, 200}, 
 PlotPoints -> 100, ColorFunction -> (Hue[#4] &), 
 BoxRatios -> {1, 1, 1}, PlotRange -> Full]

Questions:

  1. How to combine multiple solutions for different initial conditions on one ParametricPlot3D?
  2. How to plot the final point on the ParametricPlot3D?
  3. How to build a vector field around the trajectory?
Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ I suggest using ParametricNDSolveValue. $\endgroup$
    – Αλέξανδρος Ζεγγ
    Jun 4, 2021 at 9:05
  • $\begingroup$ @ΑλέξανδροςΖεγγ I have not used this command before. Could you demonstrate this and frame it as an answer? $\endgroup$
    – dtn
    Jun 4, 2021 at 9:08
  • 1
    $\begingroup$ OK, please see my post below. $\endgroup$
    – Αλέξανδρος Ζεγγ
    Jun 4, 2021 at 9:17
  • 1
    $\begingroup$ Perhaps a caveat: I've thought about this problem, off and on, for several years — albeit not very seriously. But that means that probably many people have thought about this problem, some seriously, at least since good, fast, color graphics have been available. AFAICT, no one has thought of a good solution. Even 3D phase spaces, which are possible to visualize, are rarely done; that might change with the new StreamPlot3D. As the dimension increases, the projection down to 3D graphics (on a 2D display) loses more and more information. The system in the Q is 5D. $\endgroup$
    – Michael E2
    Jun 4, 2021 at 20:12
  • $\begingroup$ @MichaelE2 At the moment, I decided to give up the idea of visualizing a vector field, but for now I will work with trajectories. It's enough. And yes, the task is much more difficult than I thought. $\endgroup$
    – dtn
    Jun 4, 2021 at 20:15

3 Answers 3

Reset to default
5
$\begingroup$

Several plots and the endpoints can be drawn by:

Clear["Derivative"]
ClearAll["Global`*"]
pars = {xs = -1, k = (1 + 1 Sin[3 t])};
f = Exp[-(o[t])^2];
s = Table[
   NDSolve[{x'[t] == g[t], o'[t] == 2 (-o[t] + x[t]), 
     g'[t] == k (-g[t] + D[f, {o[t], 1}]), 
     h'[t] == -h[t] + D[f, {o[t], 2}], x[0] == xs, o[0] == xs, 
     g[0] == g0, h[0] == 0}, {x, o, g, h}, {t, 0, 200}, 
    MaxSteps -> \[Infinity]], {g0, 0, 4, 0.8}];
funs[t_] = {o[t], g[t], h[t]} /. (Transpose[s][[1]]);
end = funs[200];

Show[{
  ParametricPlot3D[Evaluate[funs[t]], {t, 0, 200}, PlotPoints -> 100, 
   ColorFunction -> (Hue[#4] &), BoxRatios -> {1, 1, 1}, 
   PlotRange -> Full],
  Graphics3D[{PointSize[0.03], Point[end]}]
  }]

enter image description here

If you want different colors for different trajectories you simply eliminate the ColorFunction command:

Show[{ParametricPlot3D[Evaluate[funs[t]], {t, 0, 200}, 
   PlotPoints -> 100, 
   BoxRatios -> {1, 1, 1}, PlotRange -> Full], 
  Graphics3D[{PointSize[0.03], Point[end]}]}]

![enter image description here

The velocity field is actually 4 dimensional and can not simply be drawn. What we can do is to draw velocity vectors along the trajectories:

velocities = 
  Table[Arrow[{{o[t], g[t], 
        h[t]}, {o[t], g[t], h[t]} + 0.5 {2 (-o[t] + x[t]), 
         k (-g[t] + D[f, {o[t], 1}]), -h[t] + D[f, {o[t], 2}]}}], {t, 
      0, 200}] /. (Transpose[s][[1]]) // Flatten;
Show[{
  ParametricPlot3D[Evaluate[funs[t]], {t, 0, 200}, PlotPoints -> 100, 
   ColorFunction -> (Hue[#4] &), BoxRatios -> {1, 1, 1}, 
   PlotRange -> Full],
  Graphics3D[{Thickness[Tiny], Arrowheads[0.02], velocities, 
    PointSize[0.03], Point[end]}]
  }]

![enter image description here

Improve this answer
$\endgroup$
5
  • $\begingroup$ Thanks for answer! Yes, this is exactly the problem, and this caused difficulties for me too. Do I understand correctly that a vector field cannot be extended to the entire specified range? (ie so that the entire "cube" is filled with vectors). $\endgroup$
    – dtn
    Jun 4, 2021 at 9:06
  • $\begingroup$ Don't you know how to assign a separate color to each curve? $\endgroup$
    – dtn
    Jun 4, 2021 at 9:26
  • $\begingroup$ And another question, how to build the same graphs if several initial conditions are set not for one variable, but for several variables? For example: mathematica.stackexchange.com/questions/175253/… $\endgroup$
    – dtn
    Jun 4, 2021 at 9:27
  • 1
    $\begingroup$ The velocity field changes with the time. Therefore, you would have to draw a vector field as a function of time, e.g. using Manipulate. I added how you could draw different colors for different trajectories. $\endgroup$
    – Daniel Huber
    Jun 4, 2021 at 9:30
  • $\begingroup$ Let's try to look at a vector field with Manipulate. $\endgroup$
    – dtn
    Jun 4, 2021 at 9:31
2
$\begingroup$

The "final point" follows from

ode = {x'[t] == g[t], o'[t] == 2 (-o[t] + x[t]),g'[t] == k (-g[t] + D[f, {o[t], 1}]),h'[t] == -h[t] + D[f, {o[t], 2}]}
Reduce[ode/.   s_'[t] -> 0]
(*(g[t] == 0 && Sin[3 t] == -1 && h[t] == 2 E^-x[t]^2 (-1 + 2x[t]^2) &&o[t] == x[t]) || (x[t] == 0 && o[t] == 0 && h[t] == -2 && g[t] == 0)*)

FixedPoint: x[t]==0,o[t]==0,g[t]==0,h[t]==-2

Improve this answer
$\endgroup$
4
  • $\begingroup$ Yes, it's just solving a system of equations. The problem is how to beautifully place this point on Plots? $\endgroup$
    – dtn
    Jun 4, 2021 at 9:12
  • 1
    $\begingroup$ Perhaps Show[{"your plot", Graphics3D[{Red,Point[{0,0,-2}]]}] $\endgroup$
    – Ulrich Neumann
    Jun 4, 2021 at 9:14
  • $\begingroup$ Is it possible to do this automatically, without manually entering the fixed point? $\endgroup$
    – dtn
    Jun 4, 2021 at 9:18
  • 1
    $\begingroup$ Calculate the fixpoint = {o[t], g[t], h[t]} /. Solve[ode /. s_'[t] -> 0, {x[t], o[t], g[t], h[t]}][[1]] (*{0, 0, -2}*) and use it Show[...,Point[fixpoint]... $\endgroup$
    – Ulrich Neumann
    Jun 4, 2021 at 9:24
2
$\begingroup$

With respect to 1., I suggest using ParametricNDSolveValue

Clear["Derivative"]
Clear[f, k, s]
f = Exp[-(o[t])^2];
k = (1 + 1 Sin[3 t]);
s = ParametricNDSolveValue[{x'[t] == g[t], o'[t] == 2 (-o[t] + x[t]), 
   g'[t] == k (-g[t] + D[f, {o[t], 1}]), 
   h'[t] == -h[t] + D[f, {o[t], 2}], x[0] == xs, o[0] == xs, 
   g[0] == 0.01, h[0] == 0}, {o[t], g[t], h[t]}, {t, 0, 200}, {xs}, 
   MaxSteps -> \[Infinity]
  ]
ParametricPlot3D[s /@ {-1, -1.5, -2} // Evaluate, {t, 0, 200}, PlotPoints -> 100, BoxRatios -> {1, 1, 1}, PlotRange -> Full]
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thank you very much. $\endgroup$
    – dtn
    Jun 4, 2021 at 9:21

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.