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?
$\endgroup$
5
  • 1
    $\begingroup$ I suggest using ParametricNDSolveValue. $\endgroup$ – Αλέξανδρος Ζεγγ Jun 4 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 at 9:08
  • 1
    $\begingroup$ OK, please see my post below. $\endgroup$ – Αλέξανδρος Ζεγγ Jun 4 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 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 at 20:15
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

$\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 at 9:06
  • $\begingroup$ Don't you know how to assign a separate color to each curve? $\endgroup$ – dtn Jun 4 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 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 at 9:30
  • $\begingroup$ Let's try to look at a vector field with Manipulate. $\endgroup$ – dtn Jun 4 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

$\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 at 9:12
  • 1
    $\begingroup$ Perhaps Show[{"your plot", Graphics3D[{Red,Point[{0,0,-2}]]}] $\endgroup$ – Ulrich Neumann Jun 4 at 9:14
  • $\begingroup$ Is it possible to do this automatically, without manually entering the fixed point? $\endgroup$ – dtn Jun 4 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 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]
$\endgroup$
1
  • $\begingroup$ Thank you very much. $\endgroup$ – dtn Jun 4 at 9:21

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.