0
$\begingroup$

I am trying to fit this data with this two models. In the first one, the solution is too far from the exact values. In the second one, there is an error. Could you please help?

enter image description here

data = {{18.87`, 4.12`}, {19`, 13.97`}, {19.05`, 
   18.24`}, {19.34`, 57.2`}, {19.46`, 68.56`}}
nlm = NonlinearModelFit[data, 
   a*(Exp[-Exp[k1*t]]), {a, k1}, t];
nlm["BestFitParameters"]


nlm = NonlinearModelFit[data, 
  E^(-((k (-u0 - (k2 p0 - k1 (p0 + u0))/k2))/(-k1 + k2)) + (
    k (-E^(-k1 t) u0 - (E^(-k2 t) (k2 p0 - k1 (p0 + u0)))/k2))/(-k1 + 
     k2)) x0, {p0, u0, k, k1, k2}, t]
$\endgroup$
  • $\begingroup$ Please provide your mathematica code ,not a pixel screenshot. $\endgroup$ – Ulrich Neumann Nov 12 '19 at 20:18
  • 2
    $\begingroup$ You need a lot more data. You don't even has as many data points as unknowns. $\endgroup$ – Bob Hanlon Nov 12 '19 at 20:59
  • $\begingroup$ What about the first one? Why the result is so far from the data? $\endgroup$ – Ксения Цочева Nov 12 '19 at 21:25
  • $\begingroup$ I can't reproduce your first output of a and k1 with data given on MMA 12, it issues a warning. Try plot your data: ListLinePlot[data, Mesh -> All], and a model function with varying parameters (with Manipulate e.g.), probably you need to change model. $\endgroup$ – Alx Nov 13 '19 at 2:37
  • $\begingroup$ Based upon Jim's analysis I think the model is way off for this data. Suggest you check as to whether another model is more applicable. The double exponent is highly suspicious. $\endgroup$ – Jack LaVigne Nov 25 '19 at 17:12
2
$\begingroup$

There are two issues for your first fit: (1) Numerical instability and (2) The function used does not describe the data generation process. (There's a joke about a restaurant: "The food is bad and the portions too small.")

To account for the numerical instability one can rationalize the data and look for an estimation approach that minimizes the effect of the numerical instability.

(* Rationalize data *)
data = Rationalize[{{18.87`, 4.12`}, {19`, 13.97`}, {19.05`, 18.24`}, 
  {19.34`, 57.2`}, {19.46`, 68.56`}}, 0];

(* Define mean square error (mse) *)
mse = Mean[(data[[All, 2]] - a Exp[-Exp[k1 data[[All, 1]]]])^2];

(* We can solve for a in terms of k1 that minimizes mse *)
(* Solve for a when the partial derivative of mse with respect to a \
is zero *)
aMLE = Solve[D[mse, a] == 0, a][[1]];

(* Substitute the maximum likelihood estimate for a into mse *)
msek1 = mse /. aMLE // Simplify;

(* Show the mean square error with respect to a range of values of k1 
so that we can get a good starting value for determining the maximum
likelihood estimate of k1 *)
Plot[msek1, {k1, -15/100, 0}, WorkingPrecision -> 30, Frame -> True,
 FrameLabel -> (Style[#, Bold, 18] &) /@ {"k1", "Mean square error"}]

Mean square error vs k1

It looks like using -0.05 as a starting value would be good.

(* Find the value of k1 that minimizes the mean square error *)
mlek1 = FindMinimum[msek1, {k1, -5/100}, WorkingPrecision -> 30]
(* {645.535378482149759242839439463, {k1 -> -0.0521446026994104927047957817487}} *)

(* Find the value of a that minimizes the mean square error *)
aMLE = aMLE /. mlek1[[2]]
(* {a -> 47.0187082854078929751066054679} *)

(* Now plot the data and the fit *)
Show[ListPlot[data],
 Plot[a Exp[-Exp[k1 t]] /. Flatten[{aMLE, mlek1[[2]]}],
  {t, Min[data[[All, 1]]], Max[data[[All, 1]]]}]]

Data and fit

With more reasonable starting values NonlinearModelFit arrives at the same solution as above.

nlm = NonlinearModelFit[data, 
   a*(Exp[-Exp[k1*t]]), {{a, 50}, {k1, -5/100}}, t, 
   WorkingPrecision -> 30];
nlm["BestFitParameters"]
(* {a -> 47.0187082854078921351911223749, k1 -> -0.0521446026994104962006888082853} *)

So now we have a fit that minimizes the mean square error (and is also the maximum likelihood fit) but the fit is at best poor. If there is a theoretical reason for the chosen function, then the data is either selected from some other generating model or the theory needs rethinking.

|improve this answer|||||
$\endgroup$
0
$\begingroup$

Your data requires no double-exponential function. This is much too much for such a data. It is fitted by s quadratic polynomial:

data = {{18.87`, 4.12`}, {19`, 13.97`}, {19.05`, 18.24`}, {19.34`, 
    57.2`}, {19.46`, 68.56`}};

model = a + b*x + c*x^2;
ff = FindFit[data, model, {a, b, c}, x]
Show[{
  ListPlot[data],
  Plot[model /. ff, {x, 17, 19.5}, PlotStyle -> Red]
  }]

(*   {a -> 15335.6, b -> -1711.45, c -> 47.6369}   *)

enter image description here

Have fun!

|improve this answer|||||
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.