Skip to main content

differential equations - Strange DAE solution


I have a system, consisting of one differential equation and one algebraic equation


req = (1 - xD)/τD - δxD xD ν;
ν = νmax (2/(1 + Exp[(-2 (u - u0))/kv]) - 1);
eqh = u == Istim + gE ν (xD - 0.5);
τD = 2; δxD = 0.01; νmax = 100; u0 = 150; kv = 20; \
Istim = 126; gE = 5;
eqs1 = xD'[t] == (req /. {xD -> xD[t], u -> u[t]});
eqs2 = eqh /. {xD -> xD[t], u -> u[t]}

ics = xD[0] == 0.99;

I try to solve it with the next command:


eqsol = NDSolve[{eqs1, eqs2, ics}, {xD[t], u[t]}, {t, 0, 1}];

Then I want to make sure that this is correct solution, so I plot both variable xD[t] and u[t] and expect to find them on the curve defined by implicit equation from the system.


ParametricPlot[Evaluate[{u[t], xD[t]} /. eqsol], {t, 0, 1}, 
PlotRange -> Full]

I also can plot that curve by expressing the variable xD[t] as a function of the variable u: xD=xD(u).



xDimp = Solve[eqh, xD];
Plot[Evaluate[xD /. xDimp], {u, u0, 300}]

But I found that these curves don't coincide with each other. I suspect that the integration was executed wrong, but no errors were displayed during the integration. By observing the apt derivative I investigated that the function u(t) can be explicitly found from the implicit equation only for xD>0.54. This solution satisfies me. Due to this constraint I set the initial value as xD=0.99. But shall I define this constraint explicitly? Or else I don't know where the error can be.



Answer



Your equation set actually has 3 solutions. Just enlarge the domain of definition of Plot a bit:


curve = Plot[Evaluate[xD /. xDimp], {u, -300, 400}, 
Epilog -> {Dashed, Line[{{-300, 0.99}, {400, 0.99}}]}]

Mathematica graphics



Clearly there're three possible values of u that satisfys the i.c. xD==0.99. What's found by NDSolve automatically is the leftmost one:


solplot1 = ParametricPlot[Evaluate[{u[t], xD[t]} /. eqsol], {t, 0, 1}, PlotStyle -> Red];

curve~Show~solplot1

Mathematica graphics


Why does NDSolve find the leftmost one only? The answer is hidden in the obscure tutorial tutorial/NDSolveDAE#1966826857. In short, since the i.c. for u isn't explicitly given in the code, NDSolve will try to determine it from an initial guess u[0] == 1, which converges to the leftmost solution in this case.


To make NDSolve converge to other solutions, we need to use other initial guesses:


eqsol2 = NDSolve[{eqs1, eqs2, ics}, {xD[t], u[t]}, {t, -1, 1/2}, 
Method -> {"DAEInitialization" -> {"Collocation",

"DefaultStartingValue" -> #}}][[1]] & /@ {-120, 150, 400}

solplot2 = ParametricPlot[Evaluate[{u[t], xD[t]} /. eqsol2], {t, -1, 1/2},
PlotStyle -> {Green, Orange, Red}];

curve~Show~solplot2

Mathematica graphics


If you don't want to play with those options, explicitly giving i.c. of u to NDSolve is OK, of course:


ustart = u /. FindRoot[eqh /. xD -> 0.99, {u, #}] & /@ {0, 160, 300}

(* {-119., 152.142, 371.} *)
eqsol3 = NDSolve[{eqs1, eqs2, ics, u[0] == #}, {xD[t], u[t]}, {t, -1, 1/2}][[1]] & /@
ustart

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[ ...

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...

calculus and analysis - Integral of the Sinc product

Let us consider the following integral $$ B_n = \int_0^\infty \prod_{k=1,3,5,\dots}^n\frac{\sin (x/k)}{x/k}dx $$ By definition, Sinc[x] == Sin[x]/x , therefore B[n_?OddQ] := Integrate[Product[Sinc[x/k], {k, 1, n, 2}], {x, 0, Infinity}] B /@ Range[1, 13, 2] {Pi/2, Pi/2, Pi/2, Pi/2, Pi/2, Pi/2, Pi/2} OK, everything is fine. But... B[15] 467807924713440738696537864469 Pi/935615849440640907310521750000 What's going on? Answer As Eckhard wrote in comments B[n] is the n-th Borwein integral . (The letter B was not accidental :) ) This funny properties of Borwein integrals is related to the Fourier transform of Sinc function FourierTransform[Sinc[x], x, k] 1/2 Sqrt[Pi/2] (Sign[1 - k] + Sign[1 + k]) Plot[%, {k, -2, 2}, Filling -> 0] which is the box function. The result is $\pi/2$ while the sum $$ 1/3+1/5+\dots+1/n $$ B_n = \frac{\pi}{2} - \pi \bigg(\sum_{k=3,5,\ldots}^n\frac{1}{k} -1\biggr)^\frac{n-1}{2}\prod_{k=3,5,\dots}^n\frac{k}{k-1}. $$ For $n=15$ it is equal to $$ \frac{46780...