I am very new to Mathematica, and I am trying to solve the following problem.
I have a cubic equation of the form Z = aZ^3 + bZ^2 + a + b. The first thing I want to do is to get a function that solves this analytically for Z and chooses the minimal positive root for that, as a function of a and b.
I thought that in order to get the root I could use:
Z = Solve[z == az^3 + bz^2 + a + b, z];
It seems like I am not quite getting the roots, as I would expect using the general cubic equation solution formula.
I want to integrate the minimal positive root of Z over a and b (again, preferably analytically) from 0 to 1 for a and for a to 1 for b.
I tried
Y = Integrate[Z, {a, 0, 1}, {b, a, 1}];
and that does not seem to give any formula or numerical value, but just returns an integral. (Notice I am not even sure how to pick the minimal positive root, but I am playing around with Mathematica to try to figure it out.)
Any ideas on how to do this?
Spaces between a or b and z are important. You can get the roots by:
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z]
However, are you sure this expression has a solution as you expect? For a=0.5 and b=0.5, the only real root is negative.
sol /. {a->0.5, b->0.5}
{-2.26953,0.634765-0.691601 I,0.634765+0.691601 I}
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z];
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ sol /. {a -> a0, b -> b0} ,
Element[#, Reals] && # > 0 & ]]
This returns -infinty when there are no solutions. As sirintinga noted your example integration limits are not valid..
RegionPlot[NumericQ[zz[a, b] ] , {a, -1, .5}, {b, -.5, 1}]
but you can numerically integrate if you have a valid region..
NIntegrate[zz[a, b], {a, -.5, -.2}, {b, .8, .9}] ->> 0.0370076
Edit ---
there is a bug above Select in Reals is throwin away real solutions with an infinitesimal complex part.. fix as:..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ Chop[ sol /. {a -> a0, b -> b0} ],
Element[#, Reals] && # > 0 & ]]
Edit2, a cleaner approach if you dont find Chop satisfyting..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Module[{z, a, b},
Min[z /. Solve[
Reduce[(z > 0 && z == a z^3 + b z^2 + a + b /.
{ a -> a0, b -> b0}), {z}, Reals]]]]
RegionPlot[NumericQ[zz[a, b] ] , {a, -2, 2}, {b, -2, 2}]
NIntegrate[zz[a, b], {a, 0, .5}, {b, 0, .5 - a}] -> 0.0491321
Related
So I have the below code
perturb1 =
x'[t] == mu1*x[t] + x[t]*(a*x[t] + b*y[t] + c*z[t]) +
x[t]*eps1 * (UnitStep[t - 1.5] - UnitStep[t - 2.5]);
perturb2 =
y'[t] == mu2*y[t] + y[t]*(d*x[t] + e*y[t] + f*z[t]) +
y[t]*eps2 * (UnitStep[t - 1.5] - UnitStep[t - 2.5]);
perturb3 =
z'[t] == mu3*z[t] + z[t]*(g*x[t] + h*y[t] + i*z[t]) +
z[t]*eps3 * (UnitStep[t - 1.5] - UnitStep[t - 2.5]);
perturbSol = ParametricNDSolve[
{perturb1, perturb2, perturb3, x[0] == 0.25, y[0] == 0.4,
z[0] == 0.35},
{x[t], y[t], z[t]},
{t, 0, 500},
{mu1, mu2, mu3, a, b, c, d, e, f, g, h, i, eps1, eps2, eps3}
];
Evaluate[x[t][#] /. perturbSol] & /# parameterSets
parameterSets is a list of 5000+ elements of the form {mu1, mu2, mu3, a, b, c, d, e, f, g, h, i, eps1, eps2, eps3} (but with numerical values). What I'm trying to do is to evaluate the parametric function using each parameter set. When I do as above, I get the error
ParametricNDSolve: Too many parameters in {mu1,mu2,mu3,a,b,c,d,e,f,g,h,i,eps1,eps2,eps3} to be filled from {{0.9,0.9,0.9,-2,-1,-1,-1,-2,-1,-1,-1,-2,-2,-2,-2}}.
So it seems that it's because, with a single value, you would evaluate the function as follows:
Evaluate[x[t][0.9,0.9,0.9,-2,-1,-1,-1,-2,-1,-1,-1,-2,-2,-2,-2]/.perturbSol]
Whereas when using Map on parameterSets, it does this:
Evaluate[x[t][{0.9,0.9,0.9,-2,-1,-1,-1,-2,-1,-1,-1,-2,-2,-2,-2}]/.perturbSol]
i.e. it's applying the function to a list of 15 parameters, rather than to the 15 parameters separated by commas.
Is there any elegant solution to this? I tried flatten around the #, which didn't do anything (as I sort of expected). I guess one way is to write #1,#2,#3 etc in the square brackets but that's pretty messy.
Any better way to do this?
Many thanks,
H
Probably, you want something along the lines of
u = ParametricNDSolveValue[{perturb1, perturb2, perturb3,
x[0] == 0.25, y[0] == 0.4, z[0] == 0.35}, {x, y, z}, {t, 0,
500}, {mu1, mu2, mu3, a, b, c, d, e, f, g, h, i, eps1, eps2,
eps3}];
parameterSets = RandomReal[{-1, 1}, {3, 15}];
(u[##])[[1]][t] & ### parameterSets
I'm trying to find the coefficients of a function by minimizing an equation who I know is zero with Mathematica. My code is:
Clear[f];
Clear[g];
Clear[GetGood];
Clear[int];
Clear[xlist];
Xmax = 10;
n = 10;
dx = Xmax/n;
xlist = Table[i*dx, {i, n}];
A = 3.5;
slope = (A + 2)/3;
f[x_, a_, b_, c_, d_, e_] :=a/(1 + b*x + c*x^2 + d*x^3 + e*x^4)^(slope/4 + 2);
g[x_, a_, b_, c_, d_, e_] :=Derivative[1, 0, 0, 0, 0, 0][f][x, a, b, c, d, e];
int[a_?NumericQ, b_?NumericQ, c_?NumericQ, d_?NumericQ, e_?NumericQ] :=
Module[{ans, i},ans = 0;Do[ans =ans + Quiet[NIntegrate[
y^-slope*(f[Sqrt[xlist[[i]]^2 + y^2 + 2*xlist[[i]]*y*m], a, b,
c, d, e] - f[xlist[[i]], a, b, c, d, e]), {m, -1, 1}, {y,
10^-8, \[Infinity]}, MaxRecursion -> 30]], {i, 1,
Length[xlist]}];
ans
];
GetGood[a_?NumericQ, b_?NumericQ, c_?NumericQ, d_?NumericQ,e_?NumericQ] :=
Module[{ans},ans = Abs[Sum[3*f[x, a, b, c, d, e] + x*g[x, a, b, c, d,e],
{x,xlist}]+2*Pi*int[a, b, c, d, e]];
ans
];
NMinimize[{GetGood[a, b, c, d, e], a > 0, b > 0, c > 0, d > 0,
e > 0}, {a, b, c, d, e}]
The error I get after the last line is:
Part::pspec: Part specification i$3002170 is neither an integer nor a list of integers. >>
NIntegrate::inumr: "The integrand (-(1.84529/(1+<<3>>+0.595769 Part[<<2>>]^4)^2.45833)+1.84529/(1+<<18>> Sqrt[Plus[<<3>>]]+<<1>>+<<1>>+0.595769 Plus[<<3>>]^2)^2.45833)/y^1.83333 has evaluated to non-numerical values for all sampling points in the region with boundaries {{-1,1},{\[Infinity],1.*10^-8}}"
Any ideas why I am getting an error?
Thanks
Change your NMinimize to be
NMinimize[{GetGood[a,b,c,d,e],a>0&&b>0&&c>0&&d>0&&e>0}, {a,b,c,d,e}]
to get your constraints to work correctly. Their help page should really show an example of using more than a single constraint. This old page does show an example.
http://reference.wolfram.com/legacy/v5_2/functions/AdvancedDocumentationNMinimize
If you change your int[] to
int[a_?NumericQ, b_?NumericQ, c_?NumericQ, d_?NumericQ, e_?NumericQ] :=
Module[{ans, i}, ans = 0; Do[
Print["First i=", i];
ans = ans + Quiet[NIntegrate[
Print["Second i=", i];
y^-slope*(f[Sqrt[xlist[[i]]^2 + y^2 + 2*xlist[[i]]*y*m], a,b,c,d,e] -
f[xlist[[i]], a,b,c,d,e]), {m,-1,1}, {y,10^-8, \[Infinity]}, MaxRecursion -> 30]],
{i, 1, Length[xlist]}];
ans];
you will see
First i=1
Second i=1
....
First i=10
Second i=i$28850
where the first debug print never says i=i$nnnn but the second debug print does often show that i has been unassigned a value only inside your NIntegrate, not outside it, and only after i has reached a value of 10, the length of your xlist, and at that point you can't subscript by a symbol and you get the error messages you have seen.
Nothing inside your NIntegrate is changing the value of i.
I think you may have stumbled onto a bug where Mathematica is writing over the value of i.
See if you can simplify the code without driving the bug into hiding. If you can make it simpler and still show the problem you might have more likelihood of success in getting Wolfram to admit you have found a bug.
I have a differential system like
dx/dt = A x(t) + B y(t)
dy/dt = C x(t) + D y(t)
where A, B, C, and D are real constants. Now I need to explore the behavior of the system if A, instead of being a constant number, is a random number uniformly distributed between a given range. I just need to check qualitatively. I have no background on stochastic integrals, therefore I do not know if this is actually something related with the Ito integral (and this question https://mathematica.stackexchange.com/questions/3141/how-can-you-compute-it-integrals-with-mathematica) . In any case, I do not know how to solve this differential equation.
Any guidance is highly appreciated.
The standard way to solve your system is
FullSimplify[
DSolve[{y'[t] == a x[t] + b y[t], x'[t] == c x[t] + d y[t]}, {y, x}, t]]
Now, you should think WHAT do you want to explore when {a, b, c, d} are random parameters.
Edit
Perhaps you want something like this:
s = FullSimplify[
DSolve[{y'[t] == #[[1]] x[t] + #[[2]] y[t], x'[t] == #[[3]] x[t] + #[[4]] y[t],
x[0] == 1, y[0] == 1}, {y, x}, t]] & /# RandomReal[{-1, 1}, {30, 4}];
ParametricPlot[Evaluate[{x[t], y[t]} /. s[[All, 1]]], {t, 0, 1}]
I had a math problem I solved like this:
In[1]:= Solve[2x(a-x)==0, x]
Out[1]= {{x->0}, {x->a}}
In[2]:= Integrate[2x(a-x), {x,0,a}]
Out[2]= (a^3)/3
In[3]:= Solve[(a^3)/3==a, a]
Out[3]= {{a->0}, {a->-Sqrt[3]}, {a->Sqrt[3]}}
My question is if I could rewrite this to compute it in one step, rather than having to manually input the result from the previous line. I could easily replace the integral used in step three with the Integrate command from step two. But what I can't figure out is how I would use the result from step 1 as the limits of integration in the integral.
You could combine step 1 and 2 by doing something like
Integrate[2 x (a - x), {x, ##}] & ## (x /. Solve[2 x (a - x) == 0, x]);
If you agree to delegate the choice of the (positive oriented) domain to Integrate, by means of using Clip or Boole:
In[77]:= Solve[
Integrate[
Clip[2 x (a - x), {0, Infinity}], {x, -Infinity, Infinity}] == a, a]
Out[77]= {{a -> 0}, {a -> Sqrt[3]}}
or
In[81]:= Solve[
Integrate[
2 x (a - x) Boole[2 x (a - x) > 0], {x, -Infinity, Infinity}] ==
a, a]
Out[81]= {{a -> 0}, {a -> Sqrt[3]}}
The reason only non-negative roots are found, is that Integrate will integrate from the smallest root to the largest root, i.e. from {x,0,a} for positive a and {x,a,0} for negative a.
I have a function, let's say for example,
D[x^2*Exp[x^2], {x, 6}] /. x -> 0
And I want to replace 6 by a general integer n,
Or cases like the following:
Limit[Limit[D[D[x /((-1 + x) (1 - y) (-1 + x + x y)), {x, 3}], {y, 5}], {x -> 0}], {y -> 0}]
And I want to replace 3 and 5 by a general integer m and n respectively.
How to solve these two kinds of problems in general in mma?
Many thanks.
Can use SeriesCoefficient, sometimes.
InputForm[n! * SeriesCoefficient[x^2*Exp[x^2], {x,0,n}]]
Out[21]//InputForm=
n!*Piecewise[{{Gamma[n/2]^(-1), Mod[n, 2] == 0 && n >= 2}}, 0]
InputForm[mncoeff = m!*n! *
SeriesCoefficient[x/((-1+x)*(1-y)*(-1+x+x*y)), {x,0,m}, {y,0,n}]]
Out[22]//InputForm=
m!*n!*Piecewise[{{-1 + Binomial[m, 1 + n]*Hypergeometric2F1[1, -1 - n, m - n,
-1], m >= 1 && n > -1}}, 0]
Good luck extracting limits for m, n integer, in this second case.
Daniel Lichtblau
Wolfram Research
No sure if this is what you want, but you may try:
D[x^2*Exp[x^2], {x, n}] /. n -> 4 /. x -> 0
Another way:
f[x0_, n_] := n! SeriesCoefficient[x^2*Exp[x^2], {x, x0, n}]
f[0,4]
24
And of course, in the same line, for your other question:
f[m_, n_] :=
Limit[Limit[
D[D[x/((-1 + x) (1 - y) (-1 + x + x y)), {x, m}], {y, n}], {x ->
0}], {y -> 0}]
These answers don't give you an explicit form for the derivatives, though.