Skip to main content

differential equations - Numerical solution of IVP for linear ODE with variable coefficient runs wild soon


Cross posted in scicomp.SE.


A friend of mine showed me this initial value problem (IVP) for a linear ordinary differential equation (ODE) with variable coefficient:



$$y''(x)=\left(x^2-1\right) y(x)$$$$y(0)=1$$$$y'(0)=0$$


Seems to be a simple one, right? Actually it can be solved analytically by DSolve:


asol = DSolve[{y''[x] == (x^2 - 1) y[x], y[0] == 1, y'[0] == 0}, y[x], x]


{{y[x] -> E^(-(x^2/2))}}

But its numerical solution given by NDSolve runs wild very fast:


l = 10;
nsol = NDSolve[{y''[x] == (x^2 - 1) y[x], y[0] == 1, y'[0] == 0},

y, {x, 0, l}]; // AbsoluteTiming
Manipulate[Plot[y[x] /. nsol // Evaluate, {x, 0, l2},
PlotRange -> {{0, 7}, {-10, 1}}], {l2, 1/10, 7}]


{0.015600, Null}

enter image description here


How to resolve the problem?


Well, actually I found two solution for this problem but one is time-consuming and the other is limited so I'm not quite satisfied.



Solution 1


A higher WorkingPrecision will help:


l = 10;
nsol = NDSolve[{y''[x] == (x^2 - 1) y[x], y[0] == 1, y'[0] == 0},
y, {x, 0, l}, WorkingPrecision -> 50]; // AbsoluteTiming
Plot[y[x] /. nsol, {x, 0, l}, PlotRange -> All]


{2.857000, Null}


enter image description here


Nonetheless, this solution is slow, and will need a higher WorkingPrecision and be even slower when l gets larger.


Solution 2


Noticing the analytic solution involves a Exp, given the experience that Exp often causes trouble in numerical calculation, the transformation $y(x)=e^{z(x)}$ is used:


l = 50;
rule = y -> (Exp[z@#] &);

(* z[0] == 0 is manually substituted because it seems that
NDSolveValue has some difficulty in understanding y[0] == 1 /. rule *)
nsol = NDSolveValue[{y''[x] == (x^2 - 1) y[x], z[0] == 0, y'[0] == 0} /. rule,

z, {x, 0, l}]; // AbsoluteTiming
Plot[Exp@nsol[x], {x, 0, l}, PlotRange -> All]


 {0.013000, Null}

enter image description here


However, as mentioned above, this solution is limited, I wouldn't have thought it out if I was unaware of the analytic solution, and I really doubt if this method can be extended: I guess there's a sort of problem behind this specific example, once it's solved, more complicated problem might be solved too, for example this and this.


I'd appreciate if anyone can give an in-depth explanation for the problem or find a better solution.



Answer




I think this shows what the problem is. The ODE is inherently numerically unstable as any deviation from the exact solution goes to ±∞.


asol = DSolve[{y''[x] == (x^2 - 1) y[x], y[0] == 1, y'[0] == p}, y[x], x];
Manipulate[
Plot[y[x] /. asol /. {{p -> 0}, {p -> 10^(-error)}, {p -> -10^(-error)}} // Evaluate,
{x, 0, 7}, PlotRange -> 2],
{error, 1, 10, Appearance -> "Labeled"}]

Mathematica graphics




Update - Possible workaround



Aside from increasing the working precision and increasing the "DifferenceOrder", one can try the approach I took toward the Airy equation in my answer to how to solve ODE with boundary at infinity, which is similar both in form and in having a single solution (for a given initial value for y[0]) that does not diverge to infinity. For that approach, we have to set up the problem as a boundary-value problem on $[0, \infty)$ instead of an initial-value problem. One can see from the equation that $y = 0$ is a solution, and that for some $x > 1$, if $y$, $y'$ are both positive or both negative, the solution diverges. Thus if a solution crosses the $x$-axis, it will diverge. And if $y$ is positive (negative) and reaches a local minimum (maximum resp.), then $y$ will diverge. Further $y$ cannot approach a finite nonzero value because $|y''|$ will be bounded away from $0$. One might surmise that there is a solution that starts at $y = 1$ and approaches $y = 0$. (It's harder to know that this will have the initial condition $y' = 0$, but I suppose one could check that afterwards. If it doesn't satisfy it, then I suppose the IVP actually has a diverging solution and the straightforward NDSolve solution should be used.)


First we transform the differential equation with the substitutions $x = \tan t$ and $u(t) = y(\tan t)$ to transform $[0,\infty)$ to $[0,\pi/2]$. (You might want to evaluate the NestList separately if you cannot see what it does.)


eqn = (-(x[t]^2 - 1) y[x[t]]
+ D[D[y[x[t]], t]/D[x[t], t], t]/D[x[t], t]) x'[t]^3 == 0 /.
x -> Tan;
bvp = {eqn, u[0] == 1, u[Pi/2] == 0} /.
Solve[NestList[D[#, t] &, u[t] == y[Tan[t]], 2],
{y''[Tan[t]], y'[Tan[t]], y[Tan[t]]}];

femsol = y -> (u[ArcTan[#]] &) /.

First@NDSolve[bvp, u, {t, 0, Pi/2},
Method -> {"FiniteElement", "MeshOptions" -> {"MaxCellMeasure" -> 0.01}}]

Plot[y[x] /. femsol // Evaluate, {x, 0, 7}]

Mathematica graphics


Comparison with the exact solution:


Plot[Exp[-x^2/2] - (y[x] /. femsol) // Evaluate, {x, 0, 7}, PlotRange -> All]

Mathematica graphics



Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...