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[]
Related
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.
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
Applying Orthogonalize[] once:
v1 = PolyhedronData["Dodecahedron", "VertexCoordinates"][[1]];
Graphics3D[Line[{{0, 0, 0}, #}] & /#
Orthogonalize[{a, b, c} /.
FindInstance[{a, b, c}.v1 == 0 && (Chop#a != 0.||Chop#b != 0.||Chop#c != 0.),
{a, b, c}, Reals, 4]], Boxed -> False]
And now twice:
Graphics3D[Line[{{0, 0, 0}, #}] & /#
Orthogonalize#Orthogonalize[{a, b, c} /.
FindInstance[{a, b, c}.v1 == 0 && (Chop#a != 0.||Chop#b != 0.||Chop#c != 0.),
{a, b, c}, Reals, 4]], Boxed -> False]
Errr ... Why?
I think the first result is due to numerical error, taking
sys = {a,b,c}/.FindInstance[
{a, b, c}.v1 == 0 && (Chop#a != 0. || Chop#b != 0. || Chop#c !=0.),
{a, b, c}, Reals, 4];
then MatrixRank#sys returns 2, therefor the system itself is only two dimensional. To me, this implies that the first instance of Orthogonalize is generating a numerical error, and the second instance is using the out of plane error to give you your three vectors. Removing the Chop conditions fixes this,
Orthogonalize[{a, b, c} /.
N#FindInstance[{a, b, c}.v1 == 0,{a, b, c}, Reals, 4]]
where N is necessary to get rid of the Root terms that appear. This gives you a two-dimensional system, but you can get a third by taking the cross product.
Edit: Here's further evidence that its numerical error due to Chop.
With Chop, FindInstance gives me
{{64., 3.6, 335.108}, {-67., -4.3, -350.817}, {0, 176., 0},
{-2., -4.3, -10.4721}}
Without Chop, I get
{{-16.8, 3.9, -87.9659}, {6.6, -1.7, 34.558}, {13.4, -4.3, 70.1633},
{19.9, -4.3, 104.198}}
which is a significant difference between the two.
I also assumed it would be a numerical error, but didn't quite understand why, so I tried to implement Gram-Schmidt orthogonalization myself, hoping to understand the problem on the way:
(* projects onto a unit vector *)
proj[u_][v_] := (u.v) u
Clear[gm, gramSchmidt]
gm[finished_, {next_, rest___}] :=
With[{v = next - Plus ## Through[(proj /# finished)[next]]},
gm[Append[finished, Normalize#Chop[v]], {rest}]
]
gm[finished_, {}] := finished
gramSchmidt[vectors_] := gm[{}, vectors]
(Included for illustration only, I simply couldn't quite figure out what's going on before I reimplemented it myself.)
A critical step here, which I didn't realize before, is deciding whether a vector we get is zero or not before the normalization step (see Chop in my code). Otherwise we might get something tiny, possibly a mere numerical error, which is then normalized back into a large value.
This seems to be controlled by the Tolerance option of Orthogonalize, and indeed, raising the tolerance, and forcing it to discard tiny vectors fixes the problem you describe. Orthogonalize[ ... , Tolerance -> 1*^-10] works in a single step.
Perhaps it is a characteristic of the default GramSchmidt method?
Try: Method -> "Reorthogonalization" or Method -> "Householder".
The derivative functions D and Dt don't appear to be functioning as advertised.
Following the first example in the "Properties and Relations" section of http://reference.wolfram.com/mathematica/ref/Constants.html I have:
In[1]:= {Dt[ax^2 + b, x, Constants -> {a, b}], D[ax^2 + b, x]}
Out[1]= {2 ax Dt[ax, x, Constants -> {a, b}], 0}
I've duplicated the input, but the output is totally different. How do I get the expected output { 2 a x, 2 a x}?
I am using Mathematica 8.0.1.0 64-bit as installed at Rutgers University.
You need a space between a and x, otherwise it thinks you're talking about a variable named ax:
In[2]:= {Dt[a x^2 + b, x, Constants -> {a, b}], D[a x^2 + b, x]}
Out[2]= {2 a x, 2 a x}
(I realize this isn't really answering the OP's question. But given the level of the question, along with OP's desire to use the Contants option, the following info may prove useful for others in the future.)
My 2 cents on Dt.
IMO, using the Constants option is less than ideal---mainly because it produces messy output. For example:
In[1]:= Dt[x^a y^b, Constants -> {a, b}]
Out[1]= a x^(-1 + a) y^b Dt[x, Constants -> {a, b}] +
b x^a y^(-1 + b) Dt[y, Constants -> {a, b}]
Am I the only one who finds the above behavior annoying/redundant? Is there a practical reason for this design? If so, please educate me... :)
Alternative approaches:
If you don't want to use the Constants option, here are some alternative approaches.
Use UpValues to force constants.
In[2]:= Remove[a, b];
a /: Dt[a] = 0;
b /: Dt[b] = 0;
Dt[x^a y^b]
Out[5]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
Use Attributes. (i.e., give certain symbols the Constant Attribute.
In[6]:= Remove[a, b];
SetAttributes[{a, b}, Constant];
Dt[x^a y^b]
Out[8]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
Use Rules to alter the output of the main Dt[] expression.
In[9]:= Remove[a, b];
Dt[x^a y^b] /. Dt[a] -> 0 /. Dt[b] -> 0
Out[10]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
I have a system of ODE's. One of the ODE's has a constant parameter which I want to alter between two different values depending on one of the ODE solutions.
So for example let's say that I have the following equations:
{
A'[x] == -q A[x]B[x],
B'[x] == q A[x]B[x] - g B[x],
C'[x] == g B[x]
}
Now I can solve them easily using the NDSolve function when q and g are constant values. What I want to do though is vary the value of q so that it has one value when B[x] is below a certain threshold but then changes in value when B[x] rises above this threshold value.
I've tried using If statements and Piecewise functions outside of the NDSolve but I haven't managed to get it working.
This might do something like what you want. I left out the third equation, which seems superfluous.
Clear[f, g, s, t, x];
s[a_, b_] = Piecewise[{{a*b - b, b < 1}, {2 a*b - b, b >= 1}}];
t[a_, b_] = Piecewise[{{-a*b, b < 1}, {-2 a*b, b >= 1}}];
{f[x_], g[x_]} = {f[x], g[x]} /.
First[NDSolve[{
f'[x] == t[f[x], g[x]],
g'[x] == s[f[x], g[x]],
f[0] == 10, g[0] == 1},
{f[x], g[x]}, {x, 0, 2}]]