I`ve seen several answers for quite similar topics with usage of ?NumericQ explained and still can not quite understand what is wrong with my implementation and could my example be evaluated at all the way I want it.
I have solution of differential equation in form of ParametricNDSolve (I believe that exact form of equation is irrelevant):
sol = ParametricNDSolve[{n'[t] == g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2, n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
After that I am trying to construct a function for FindFit or similar procedure, Nintegrating over function n[a,b,c,g,f,y,t] I have got above with some multiplier (I have chosen Log[z] as multiplier for simplicity)
Func[z_, a_, b_, c_, g_, f_] :=
NIntegrate[
Log[z]*(n[a, b, c, g, f, y][t] /. sol), {t, 0, 10}, {y, 0, Log[z]}]
So I have NIntegrate over my function n[params,t] derived from ParametricNDSolve with multiplier introducing new variable (z) wich also present in the limits of integration (in the same form as in multiplier for simplicity of example)
I am able to evaluate the values of my function Func at any point (z) with given values of parameters (a,b,c,g,f): Func(0,1,2,3,4,5) could be evaluated.
But for some reasons I cannot use FindFit like that:
FindFit[data, Func[z, a, b, c, g, f], {a, b, c, g, f}, z]
The error is: NIntegrate::nlim: y = Log[z] is not a valid limit of integration.
I`ve tried a lot of different combinations of ?NumericQ usage and all seems to lead nowhere. Any help would be appreciated!
Thanks in advance and sorry for pure english in the problem explanation.
Here is a way to define your function:
sol = n /.
ParametricNDSolve[{n'[t] ==
g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2,
n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
Func[z_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ, g_?NumericQ,
f_?NumericQ] :=
NIntegrate[Log[z]*sol[a, b, c, g, f, y][t],
{t, 0, 10}, {y, 0, Log[z]}]
test: Func[2, .45, .5, .13, .12, .2] -> 0.106107
I'm not optimistic you will get good results from FindFit with a function with so many parameters and which is so computationally expensive.
Related
I am trying to fit a curve to this set of data, and nothing I've tried is working.
data = {{290, 3.3}, {300, 1.1*10}, {310, 2.9*10}, {320, 7.5*10}, {330, 1.8*10^2}, {340, 4.3*10^2}, {350, 8.3*10^2}, {360, 1.5*10^3}, {370, 3.7*10^3}, {380, 6.3*10^3}, {390, 1.2*10^4}, {400, 2.4*10^4}};
https://i.stack.imgur.com/W3Qd4.jpg
I've tried
FindFit[data, Exp[a*x + b], {a, b}, x],
NonlinearModelFit[data, {A*Exp[B*x + D]}, {A, B, D}, x],
and many other attempts.
I keep getting the error message
"Failed to converge to the requested accuracy or precision within 100
iterations"
. I am at a loss. Any ideas?
The problem is that the function being fitted does not model the data well.
ClearAll[a, b, c];
nlm = NonlinearModelFit[data, a Exp[b Sqrt[x]] + c, {a, b, c}, x, MaxIterations -> 1000]
Show[ListPlot#data, Plot[nlm[x], {x, 290, 400}]]
During times like this, it is always useful to take the logarithm of the y-axis values to obtain a better fit. Otherwise, the data points having smaller x-values will be neglected in the fit.
ClearAll["`*"];
Clear["Global`*"];
data = {{290, 3.3}, {300, 1.1*10}, {310, 2.9*10}, {320, 7.5*10}, {330, 1.8*10^2}, {340, 4.3*10^2}, {350, 8.3*10^2}, {360, 1.5*10^3}, {370, 3.7*10^3}, {380, 6.3*10^3}, {390, 1.2*10^4}, {400, 2.4*10^4}};
data[[All, 2]] = Log#data[[All, 2]];
nlm = NonlinearModelFit[data, a*x + b, {a, b}, x, MaxIterations -> Infinity]
Show[ListPlot#data, Plot[nlm[x], {x, 290, 400}]]
Plot of data and fit, with the y-axis scaled after taking the logarithm:
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.
again!
I am trying to fit a list of data points with Mathematica. The problem is that it gives me an error that the function is complex when it tries to fit even though I made the assumption that all parameters are Reals and no imaginary unit is in the function. What makes me believe it's about me not knowing Mathematica enough is that the imaginary term that it says it gets when evaluating the function is what should be considered a perfect zero: 2.975219565012465*10^-753 I. But where did it come from?
And now the code:
FindFit[Table[{X[[i]], weight[[i]]}, {i, Length[weight]}], {allFunc[x,
a, b, c, d, e, f, g], {a \[Element] Reals, b \[Element] Reals,
x \[Element] Reals, c \[Element] Reals, d \[Element] Reals,
e \[Element] Reals, f \[Element] Reals, g \[Element] Reals}}, {{a,
10.42}, {b, -0.05435}, {c, 7.59}, {d, 3.986}, {e, 88.19}, {f,
6.958}, {g, 104500}}, x]
While that allFunc is:
crystalBall[x_, \[Alpha]_, n_, \[Mu]_, \[Sigma]_, Norma_] :=
If[(x - \[Mu])/\[Sigma] > -\[Alpha],
Norma*Exp[-((x - \[Mu])^2/(2 \[Alpha]^2))],
Norma*(n/Abs[\[Alpha]])^
n Exp[-(Abs[\[Alpha]]^2/2)] (n/Abs[\[Alpha]] - Abs[\[Alpha]] - (
x - \[Mu])/\[Sigma])^-n];
allFunc[x_, const_, slope_, alpha_, en_, miu_, sigma_, norm_] :=
Exp[const + slope*x] + crystalBall[x, alpha, en, miu, sigma, norm];
Sorry about the aspect of the code.
The error I get is:
FindFit::nrnum: The function value 1.74493*10^14+2.975219565012465*10^-753 I is not a real number at {a,b,c,d,e,f,g} = {13.3122,0.0104586,-58.8739,3.986,87.764,6.958,104500.}. >>
I've plotted the function with those arguments in my fit range and no complex warning appeared. I also looked for a solution on the internet but I only get questions from people who wanted to do a complex fit, which I don't.
wrap your function in Re[] or Chop[]
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
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}]