How to solve this NDSolve problem in Mathematica - wolfram-mathematica

I found a confusing problem in solving ODE problems with NDSolve in Mathematica, the code is as follows:
I have tried 'Clear[Derivative]' and restart the kernel but these methods don't work.
CODE:
Clear[Derivative];
ClearSystemCache;
r = 0.3; a = 3; delta = 0.45; M0 = 0.975; T = 20;
u[t] = 0.5*l[t]*delta*M[t];
eql1 = M'[t] == r*M[t] Log[1/M[t]] - u[t]*delta*M[t];
eql2 = l'[t] == -2 *a *M[t] - l[t]* r *Log[1/M[t]] + l[t]*r -
l[t]*u[t]*delta;
condition = {M[0] == M0, l[T] == 0};
sol = NDSolve[Flatten#{{eql1, eql2}, condition}, {M, l}, {t, 0, 20}]
The result is as follows:
Power::infy: Infinite expression 1/0. encountered.
Infinity::indet: Indeterminate expression 0. \[Infinity] encountered.
Power::infy: Infinite expression 1/0. encountered.
Infinity::indet: Indeterminate expression 0. \[Infinity] encountered.
Power::infy: Infinite expression 1/0. encountered.
General::stop: Further output of Power::infy will be suppressed during this calculation.
Infinity::indet: Indeterminate expression 0. ComplexInfinity encountered.
General::stop: Further output of Infinity::indet will be suppressed during this calculation.
NDSolve::ndnum: Encountered non-numerical value for a derivative at t == 0.
enter image description here
I can't figure out why there be "non-numerical value for a derivative at t == 0", there shouldn't be the non-numerical value at t==0, the whole M[t] should be >0 when t<=20. I have spent a lot of time on this problem and still could not find an answer, please help me.
Best regards!

The reason these code doesn't work is that mathematica can not solve ODES with singular points and bounded condition. I use python write Ronge-Kutta method to solve the problem and it works. Life is short, I use python :>

Related

How to write a subroutine for initial condition in Nonlinear Schrodinger Equation that depends on x

I am solving Nonlinear Schrodinger equation by split-step Fourier method:
i df/dz+1/2* d^2f/dX^2+|f|^2*f=0
using an initial condition:
f=q*exp(-(X/X0)^24).
But I have to use the condition that q=1 for |x|<1, otherwise, q=0.
So I write the following subroutine (excerpt of the code involving transverse variable) for transverse variable x:
fs=120;
N_fx=2^11; %number of points in frequency domain
dX=1/fs;
N_X=N_fx;
X=(-(N_X-1)/2:(N_X-1)/2)*dX;
X0=1;
Xn=length(X);
for m=1:Xn
Xnn=Xn/8;
pp=m;
if pp>3*Xnn && pp<5*Xnn
q=1.0;
f=q*exp(-(X/X0).^24);
else
f=0;
end
end
But it seems that 'f' is getting wrong and it is a 1 by 2048 vector with all entries zero. I'm not getting the expected result. If my initial condition is only f=q*exp(-(X/X0).^24), q=1, it is straightforward, but with the above condition (q=1 for |x|<1, otherwise, q=0) what I need to do?
Any help will be much appreciated.
Thanks in advance.
A MWE, this has 0 < [f(867) : f(1162)] <= 1:
fs=120;
N_fx=2^11; %number of points in frequency domain
dX=1/fs;
N_X=N_fx;
X=(-(N_X-1)/2:(N_X-1)/2)*dX;
X0=1;
Xn=length(X);
f = zeros(1,Xn); % new: preallocate f size and initialise it to 0
for m=1:Xn
Xnn=Xn/8;
if m>3*Xnn && m<5*Xnn
%if abs(X(m)) < 1 %alternative to line above
q=1.0;
% error was here below: you overwrote a 1x1 f at each iteration
f(m)=q*exp(-(X(m)/X0).^24);
else
f(m)=0;
end
end

Wolfram Mathematica Solve command for a nonlinear system of equations

I am trying to solve a nonlinear system of equations by using the Solve (and NSolve) command, but the evaluation get stuck.
For a very similar system, basically the same but with the derivatives of the equations I get no problems. I define the functions I need, write the equations, define the variables, define the solutions through the Solve command, and, once obtained with another system the initial values, I try to solve the system with NSolve.
Defining the functions:
a[x_] := A (1 - ms[x])
b[x_]:=2 ((ArcSinh[nn[x]/ms[x]] ms[x]^3 + nn[x] ms[x] Sqrt[nn[x]^2 + ms[x]^2])/(8 \[Pi]^2) + (ArcSinh[pp[x]/ms[x]] ms[x]^3 + pp[x] ms[x] Sqrt[pp[x]^2 + ms[x]^2])/(8 \[Pi]^2))
where A is a constant. Here I deleted some multiplicative constants to simplify the problem.
Then I have the equations:
eq1[x_]:= B a[x] + C a[x]^2 + D a[x]^3 - F b[x]
eq2[x_]:= pp[x]^3 - nn[x]^3
eq3[x_]:= G - (pp[x]^3 + nn[x]^3)
eq4[x_]:= Sqrt[nn[x]^2 + ms[x]^2] - Sqrt[pp[x]^2 + ms[x]^2] - Sqrt[m + ee[x]^2] + H (pp[x]^3 - nn[x]^3)
where B, C, D, G, m and H are constants. Here too, I deleted some multiplicative constants, to simplify the code for you.
Finally, I define the variables:
Var = {ee[x], pp[x], nn[x], ms[x]}
then solve the system "implicitly":
Sol =
Solve[{eq1[x] == 0, eq2[x] == 0, eq3[x] == 0, eq4[x] == 0}, Var]
(N.B: it is here that the code get stuck!!!! Despite, as I said, with a similar system with derivatives of the equations, everything work fine.)
and make a list of the equations:
eqs =
Table[Var[[i]] == (Var[[i]] /. Sol[[1]]), {i, Length[Var]}];
To conclude, after having obtained the initial conditions, I would try to solve the system:
system0 = Flatten[{eqs, ee[xi] == eei, pp[xi] == ppi, nn[xi] == nni, ms[xi] == msi}];
sol0 = NSolve[system0, {ee, kpp, nn, ms}, {x, xi, xf}, Flatten[{MaxSteps -> 10^4, MaxStepFraction -> 10^-2, WorkingPrecision -> 30, InterpolationOrder -> All}, 1]];
where I previously set xi = 10^-8 and xf = 10.
Trying to be more clear, when I try to evaluate the system through the Solve command, the evaluation continues indefinitely and I cannot understand why, where is the mistake. Despite a similar system with the derivative of the previous equations and NSolve replaced with NDSolve, works without any problem, and the execution of the "equivalent" line (Sol = Solve[{eq1[x] == 0, eq2[x] == 0, eq3[x] == 0, eq4[x] == 0}, Core]) is extremely fast (~1 sec).
Any help to understand where I am wrong is welcome, as well any suggestion to solve numerically this kind of system of equations.
Trying to be more clear, when I try to evaluate the system through the Solve command, the evaluation continues indefinitely and I cannot understand why, where is the mistake. Despite a similar system with the derivative of the previous equations and NSolve replaced with NDSolve, works without any problem, and the execution of the "equivalent" line (Sol = Solve[{eq1[x] == 0, eq2[x] == 0, eq3[x] == 0, eq4[x] == 0}, Core]) is extremely fast (~1 sec).
Any help to understand where I am wrong is welcome, as well any suggestion to solve numerically this kind of system of equations.

Performance of Wolfram Mathematica InverseFunction

given the constants
mu = 20.82;
ex = 1.25;
kg1 = 1202.76;
kp = 76.58;
kvb = 126.92;
I need to invert the function
f[Vpx_,Vgx_] := Vpx Log[1 + Exp[kp (1/mu + Vgx/(Vpx s[Vpx]))]];
where
s[x_] := 1 + kvb/(2 x^2);
so that I get a function of two variables, the second one being Vgx.
I tried with
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2];
tested with t[451,-4]
It takes so much time that every time I try it I stop the evaluation.
On the other side, working with only one variable, everything works:
Vgx = -4;
t = InverseFunction[Function[{Vpx}, f[Vpx,Vgx]]];
t[451]
It's my fault? the method is inappropriate? or it's a limitation of Wolfram Mathematica?
Thanks
Teodoro Marinucci
P.S. For everyone interested it's a problem related to the Norman Koren model of triodes.
As I said in my comment, my guess is that InverseFunction first tries to solve symbolically for the inverse, e.g. Solve[Function[{Vpx, Vgx}, f[Vpx, Vgx]][X, #2] == #1, X], which takes a very long time (I didn't let it finish). However, I came across a system option that seems to turn this off and produce a function:
With[{opts = SystemOptions["ExtendedInverseFunction"]},
Internal`WithLocalSettings[
SetSystemOptions["ExtendedInverseFunction" -> False],
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2],
SetSystemOptions[opts]
]];
t[451, -4]
(* 199.762 *)
A couple of notes:
According to the documentation, InverseFunction with exact input should produce an exact answer. Here some of the parameters are approximate (floating-point) real numbers, so the answer above is a numerical approximation.
The actual definition of t depends on f. If f changes, then a side effect will be that t changes. If that is not something you explicitly want, then it is probably better to define t this way:
t = InverseFunction[Function[{Vpx, Vgx}, Evaluate#f[Vpx, Vgx]], 1, 2]
As my late Theoretical Physics professor said, "a simple and beautiful solution is likely to be true".
Here is the piece of code that works:
mu = 20.82; ex = 1.25; kg1 = 1202.76; kp = 76.58; kvb = 126.92;
Ip[Vpx_, Vgx_] = Power[Vpx/kp Log[1 + Exp[kp (1/mu + Vgx/Sqrt[kvb + Vpx^2])]], ex] 2/kg1;
Vp[y_, z_] := x /. FindRoot[Ip[x, z] == y, {x, 80}]
The "real" amplification factor of a tube is the partial derivative of Ip[Vpx, Vgx] by respect to Vgx, with give Vpx. I would be happier if could use the Derivative, but I'm having errors.
I'll try to understand why, but for the moment the definition
[CapitalDelta]x = 10^-6;
[Micro][Ipx_, Vgx_] := Abs[Vp[Ipx, Vgx + [CapitalDelta]x] - Vp[Ipx, Vgx]]/[CapitalDelta]x
works well for me.
Thanks, it was really the starting point of the FindRoot the problem.

how to find the non-causal vectors from a difference equation in matlab?

I am trying to find the causality from a given difference equation and here's what I have already done.
y[n] = x[n]-x[n-4]
I know that I can find the causality by the necessary condition of impulse response h[n]=0,n<0.
I already know how to find the response using filter and filtic operations in Matlab to any input so, one way would be to make an input only equal to '1' at n=0 and '0' everywhere else at the defined interval and finding the response.
My question is about making the numerator and denominator vectors in filter operation. This particular case has num = [1 0 0 0 -1] and den = 1 and I know how to make those with [value of n progressing downwards correspond to vector entries] but what will be the value of these vectors in a non-causal system for example:
y[n]=x[n]+x[n+1]
I am still learning Matlab so I will appreciate any help.
Thanks for your consideration.
In the domain the recurrence y[n] = x[n] + x[n+1] becomes:
In MATLAB you can do
>> num = [1 1];
>> den = [0 1];
>> sys = filt([1 1], [0 1]) % Alternatively: sys = tf([1 1], [0 1], -1, 'variable', 'z^-1')
sys =
1 + z^-1
--------
z^-1
Sample time: unspecified
Discrete-time transfer function.
Anyway when you try to use stepplot() or impz() you get the following errors:
>> stepplot(sys)
Error using DynamicSystem/stepplot (line 107)
Cannot simulate the time response of improper (non-causal) models.
>> impz([1 1], [0 1])
Error using filter
First denominator filter coefficient must be non-zero.
the same happens when you try to use zplane():
>> zplane([1 1], [0 1])
Error using tf2zp (line 41)
Denominator must have non-zero leading coefficient.
And that's because non-causal filters are not physically realizable, therefore MATLAB can't simulate such responses or identify transfer function's zeros and poles neither.
There is possibility that you are interpreting the use of num and den incorrectly.
Primarily, num/den is used for representing transfer function of a given equation.
Transfer function is generally used to find if the system/eqn is stable/feasible and find output for any input.
A transfer function(H(s)) is,
H(s)=( Y(s)/X(s) )
and Y(s) and X(s) are the laplace transform of y(t) and x(t).
For sampled signal, rules are same for x[n].
For original question, take laplace transform on either side will give-
y[n] = x[n]-x[n-4]
Y(s)=X(s)-(s^4)*X(s)
or, Y(s)/X(s)= (1-(s^4))
so, num=[-1 0 0 0 1] and den=1
For the second equation,
y[n]=x[n]+x[n+1]
Y(s)=X(s)-X(s)/s
or, Y(s)/X(s)= (1-1/s)=(s-1)/s
so, num=[1 -1] and den=[1 0]
And the transfer fn will be tf(num/den)
Hopefully that helps.

Set::write error when using For loop

Solving a complicated formula f(u,v)==0, where
I assign some constant value to u and then solve v.
I can solve it without for-loop, but encounter errors by adding For[] enclosing the codes,
where saying
Set::write: Tag Times in "Solve[] with exact coefficients solns is Protected.
A simple example to illustrate my idea:
For[ i = 1, i < 5, i++,
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y]
]
will get error:
Set::write: "Tag Times in (-9+y^2) is Protected."
Only when I add For[ ] at the outside of the code
(inner 4-line code works fine without for loop)
So it seems that there is an variable assignment permission issue in the for loop
How can I avoid it?
I no longer have Mathematica 7 installed, and your code runs (although with no printed output...) on Mathematica 10. Based on the error message, it sounds like you need to Clear[f] before trying to reassign it.
For[i = 1, i < 5, i++,
Clear[f];
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y];
Print[soln]
]
However, you're still really mixing things up. Consider what happens with your code as the loop executes. First it starts with i=1 and says:
Clear[f] -- or don't, this isn't the only issue
f = x^2 + y^2 - 10 -- This gives me an expression with symbols x and y
x=i -- This sets x=1 since i=1 already
At this point, the expression for f has become y^2 - 9`. Next time it comes around, it will repeat:
f = x^2 + y^2 - 10 -- But x is no longer a symbol!! So now it still treats x=1...
This becomes a nightmare. I could try to hack your code into working with the fewest changes (e.g. make it Clear[f,x] or something), but that's not really the best advice I can give.
A better overall construction would be something like:
Eqn[x_,y_]=(x^2+y^2-10==0);
For[i=1,i<5,i++,
Print[Solve[Eqn[i,y],y]];
];
Your function f is a function, so you should make it a function like f[x_,y_]=something. Better yet, just make the entire equation into a function as above. That way, you never actually modify the values of x or y and don't get caught with issues in your loop.
And before you use this new code I've given you, clear everything or just quit the Kernel.

Resources