Skip to main content

plotting - Easy way to plot ODE solutions from NDSolve?


Inspired by the closed question Beautify a NDSolve Graph ! and a comment someone made to me not too long ago:




Is there some quick way to plot NDSolve results without going through the Plot and Evaluate[funcs /. sol] stuff?



Note the documentation for NDSolve is overflowing with examples of plotting solutions, via Plot and ParametericPlot, but perhaps there are other ways.


Examples


There is a variety of problems, but perhaps all can be addressed easily.


1. A simple ODE with a single solution:


var1 = {y};
ode1 = {y''[x] + y[x]^3 == Cos[x]};
ics1 = {y[0] == 0, y'[0] == 1};

sol1 = NDSolve[{ode1, ics1}, var1, {x, 0, 10}];

2. A quadratic ODE with two solutions:


var2 = {y};
ode2 = {y''[x]^2 + y[x] y'[x] == 1};
ics2 = {y[0] == 0, y'[0] == 0};
sol2 = NDSolve[{ode2, ics2}, var2, {x, 0, 1}];

3. An ODE with a complex-valued solution:


var3 = {y};

ode3 = {y''[x] + (1 + Cos[x] I) y[x] == 0};
ics3 = {y[0] == 1, y'[0] == 0};
sol3 = First@NDSolve[{ode3, ics3}, var3, {x, 0, 20}];

4. A system of ODEs, with a single solution comprising multiple, real-valued, component functions:


var4 = {x1[t], x2[t], x3[t], x4[t]};
ode4 = {D[var4, t] ==
Cos[Range[4] t] AdjacencyMatrix@
CycleGraph[4, DirectedEdges -> True].var4 - var4 + 1};
ics4 = {(var4 /. t -> 0) == Range[4]};

sol4 = NDSolve[{ode4, ics4}, var4, {t, 0, 2}];

5. A vector-valued solution:


var5 = {x};
ode5 = {x'[t] ==
(Cos[Range[4] t] AdjacencyMatrix@ CycleGraph[4, DirectedEdges -> True]).x[t] - x[t] + 1};
ics5 = {(x[t] /. t -> 0) == Range[4]};
sol5 = NDSolve[{ode5, ics5}, var5, {t, 0, 2}];

Answer



I wanted to share some undocumented techniques that give quick rough plots of NDSolve solutions. The keys points are this, the second one being quite handy at times:




  • ListPlot[ifn] and ListLinePlot[ifn] wil plot an InterpolatingFunction ifn directly, if the domain and range are each real and one-dimensional. Points will be joined in line plots by straight segments; no recursive subdivision is performed.

  • Similarly ListPlot[ifn'] and ListLinePlot[ifn'] will plot the derivatives of an InterpolatingFunction.

  • The steps in the solution can be highlighted in line plots by either PlotMarkers -> Automatic or Mesh -> Full.


The lack of recursive subdivision means ListLinePlot is good for examining the steps, but not good for examining the interpolation between the steps. The usual default interpolation order is 3, so the interpolation error is often a bit greater than the truncation error of NDSolve. For basic plotting, though, the steps by NDSolve are usually small enough that recursion is unnecessary to produce a good plot of the solution.


Normally, there's little difference between yfn = y /. NDSolve[..] and yfn = NDSolveValue[..], but see the second example. (For this reason and because the rules returned by NDSolve make it easy to substitute the solution into expressions such as invariants and residuals, I prefer `NDSolve.)


Calls of the form NDSolve[..., y[x], {x, 0, 1}] result in ifn[x] instead of a pure InterpolatingFunction. To these, one has to apply Head to strip off the arguments in order to use ListPlot. See examples 3 and 5. (For this reason and because it difficult to substitute this form into y'[x], I usually prefer a call of the form NDSolve[..., y, {x, 0, 1}].)


Because ListLinePlot only plots real, scalar interpolating functions, complex-valued and vector-valued solutions are not as easily plotted as real, scalar interpolating functions. Some manipulation of the InterpolatingFunction is necessary. Perhaps someone else can come up with a better solution.


OP's examples:



1. Simple ODE


ListLinePlot[y /. First@sol1]

Mathematica graphics


ListLinePlot[var1 /. First@sol1,  Mesh -> Full]
(* or ListLinePlot[y /. First@sol, PlotMarkers -> Automatic] *)

Mathematica graphics


With the derivative:


ListLinePlot[{y, y'} /. First@sol1]


Mathematica graphics


2. Nonlinear, multiple solutions


ListLinePlot[var2 /. sol2 // Flatten]
ListLinePlot[var2 /. #, PlotMarkers -> {Automatic, 5}] & /@ sol2 //
Multicolumn[#, 2] &
(* or ListLinePlot[y /. #, Mesh -> Full]& /@ sol // Multicolumn[#, 2]& *)

Mathematica graphics


In this case, NDSolveValue is limited in what it does:



NDSolveValue[{ode2, ics2}, var2, {x, 0, 1}]


NDSolveValue::ndsvb: There are multiple solution branches for the equations, but NDSolveValue will return only one. Use NDSolve to get all of the solution branches.



3. Complex-valued solutions


This needs some extra handling so it is not as simple as applying ListLinePlot to the solution.


ListLinePlot[
Transpose[{Flatten[y["Grid"] /. sol3], #}] & /@
(ReIm[y["ValuesOnGrid"]] /. sol3), PlotLegends -> ReIm@y]


Mathematica graphics


4. System with multiple components


If the call returned rules of the form x1 -> InterpolatingFunction[..] etc., mapping Head would not be needed. Otherwise, it would be simply pass a flat list of the interpolating functions. (The styling options are not really needed, of course.)


ListLinePlot[Head /@ Flatten[var4 /. sol4], PlotLegends -> var4, 
PlotMarkers -> {Automatic, Tiny}, PlotStyle -> Thin]

Mathematica graphics


5. Vector-valued solution


This, too, needs some extra manipulation of InterpolatingFunction.



ListLinePlot[
Transpose[{Flatten[x["Grid"] /. sol5], #}] & /@
(Transpose[x["ValuesOnGrid"]] /. First@sol5),
PlotLegends -> Array[Inactive[Part][x, #] &, 4]]

Mathematica graphics


3D vector, with parametric plot:


var5b = x;
ode5b = {D[x[t], t] ==
(Cos[Range[3] t] AdjacencyMatrix@ CycleGraph[3, DirectedEdges -> True]).x[t]};

ics5b = {x[0] == Range[-1, 1]};
sol5b = NDSolve[{ode5b, ics5b}, x, {t, 0, 2}];

ListPointPlot3D[x["ValuesOnGrid"] /. First@sol5b]
% /. Point[p_] :> {Thick, Line[p]}


Code dump


OPs code, in one spot, for cut & paste:


ClearAll[x,y,x1, x2, x3, x4];


(* simple ODE *)
var1 = {y};
ode1 = {y''[x] + y[x]^3 == Cos[x]};
ics1 = {y[0] == 0, y'[0] == 1};
sol1 = NDSolve[{ode1, ics1}, var1, {x, 0, 10}];

(* nonlinear, multiple solutions *)
ClearAll[y];
var2 = {y};

ode2 = {y''[x]^2 + y[x] y'[x] == 1};
ics2 = {y[0] == 0, y'[0] == 0};
sol2 = NDSolve[{ode2, ics2}, var2, {x, 0, 1}];

(* complex-valued solutions *)
var3 = {y};
ode3 = {y''[x] + (1 + Cos[x] I) y[x] == 0};
ics3 = {y[0] == 1, y'[0] == 0};
sol3 = First@NDSolve[{ode3, ics3}, var3, {x, 0, 20}];


(* system with multiple components *)
var4 = {x1[t], x2[t], x3[t], x4[t]};
ode4 = {D[var4, t] ==
Cos[Range[4] t] AdjacencyMatrix@
CycleGraph[4, DirectedEdges -> True].var4 - var4 + 1};
ics4 = {(var4 /. t -> 0) == Range[4]};
sol4 = NDSolve[{ode4, ics4}, var4, {t, 0, 2}];

(* vector-valued *)
ClearAll[x];

var5 = {x};
ode5 = {x'[
t] == (Cos[Range[4] t] AdjacencyMatrix@
CycleGraph[4, DirectedEdges -> True]).x[t] - x[t] + 1};
ics5 = {(x[t] /. t -> 0) == Range[4]};
sol5 = NDSolve[{ode5, ics5}, var5, {t, 0, 2}];

Comments

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...