3
$\begingroup$

I have a NonlinearModelFit in a very large program,

f1 = NonlinearModelFit[d1, a Exp[-(b (x - c1))^2] + yoff, {a, b}, x]

Which is used in my program to produce a nice Gaussian fit to a set of data. The issue being I need to find the FWHM, and the Fitted Model seems to reject having any of its fitted variables accessed from the outside.

So, as a work around, I tried to manually pull out the FWHM with

Dynamic[peakpos = FindMaximum[f1[x0], x0]]
Dynamic[FindRoot[
  f1[x] == 0.5*peakpos[[1]], {x, (x0 /. peakpos[[2]]) + 0.05}]]
Dynamic[FindRoot[
  f1[x] == 0.5*peakpos[[1]], {x, (x0 /. peakpos[[2]]) - 0.05}]]

However, this is also failing with a laundry list of errors, and I have no doubt I'm misunderstanding how this is supposed to work.

How can I drag the Full Width at Half-Maximum out of a Fitted Model?

$\endgroup$
  • $\begingroup$ I didnt include it in the main bulk of the question due to size and irrelevance, but if anyone needs the original program and test data for whatever reason, here they are: pastebin.ca/3139921 pastebin.ca/3116443 (Just note they're very large- I think the program can be solved without touching them, however) $\endgroup$ – RNPF Aug 31 '15 at 4:04
  • 1
    $\begingroup$ I think what you're asking for is f1["BestFitParameters"]. $\endgroup$ – Jens Aug 31 '15 at 4:21
  • $\begingroup$ A side note: I don't see what purpose Dynamic serves and suspect you've misunderstood how it works. I think it can just be omitted and also that leaving it in might cause trouble down the road. If it is just to avoid having to type shift-enter when f1 changes, I still think that might cause trouble. $\endgroup$ – Michael E2 Aug 31 '15 at 12:41
4
$\begingroup$

The maximum occurs at x = c1 and that value is a + yoff. So you can solve for the two values where the curve equals half of that maximum value assuming a > 0 and yoff > 0 (but only if (a+yoff)/2 >= yoff as otherwise there will be no intersection with the curve).

a =.;
b =.;
c1 =.;
yoff =.;
sol = Solve[(a + yoff)/2 == a Exp[-(b (x - c1))^2] + yoff, x] /. C[1] -> 0;
x1 = x /. sol[[1]]
x2 = x /. sol[[2]]

with output

solution

For an example consider the following:

a = 2;
b = 4;
c1 = 5;
yoff = 1/2;
sol = Solve[(a + yoff)/2 == a Exp[-(b (x - c1))^2] + yoff, x] /. C[1] -> 0;
x1 = x /. sol[[1]];
x2 = x /. sol[[2]];
p1 = Plot[{a Exp[-(b (x - c1))^2] + yoff, (a + yoff)/2}, {x, 3, 7}, PlotRange -> All];
p2 = ListPlot[{{x1, (a + yoff)/2}, {x2, (a + yoff)/2}}, PlotStyle -> PointSize[0.03]];
Show[{p1, p2}] 

with output

example

$\endgroup$
  • $\begingroup$ Thanks a ton- I didnt consider simply reusing the curve itself. Thats a huge help- thank you. $\endgroup$ – RNPF Aug 31 '15 at 5:07
  • 1
    $\begingroup$ And rather than putting in values as I've done above, you'd use what @Jens suggested with f1["BestFitParameters"]. $\endgroup$ – JimB Aug 31 '15 at 5:08
  • $\begingroup$ Okay- Real quick, how can I assign f1["BestFitParameters"] to a and b? It outputs a list with two elements, it seems, but it doesnt like being separated like a list. Using: Dynamic[f1["BestFitParameters"]] Dynamic[sol = Solve[(a + yoff)/2 == a Exp[-(b (x - c1))^2] + yoff, x] /. C[1] -> 0;] Doesnt seem to work, spitting out a full unfitted function. $\endgroup$ – RNPF Aug 31 '15 at 5:28
  • $\begingroup$ @RNPF Forget about using dynamic until you get a grip on Mathematica. You're asking for trouble :) $\endgroup$ – Dr. belisarius Aug 31 '15 at 6:29
  • $\begingroup$ @RNPF: Here's an example modified slightly from the NonlinearModelFit documentation: data = {{0, 1}, {1, 0}, {3, 2}, {5, 4}, {6, 4}, {7, 5}}; nlm = NonlinearModelFit[data, Log[a + b x^2], {a, b}, x]; sol = nlm["BestFitParameters"] a + b 10.2 /. sol $\endgroup$ – JimB Aug 31 '15 at 14:51
5
$\begingroup$
c1 = 1;
yoff = .1;
f[x_] := a Exp[-(b (x - c1))^2] + yoff
d1 = Table[{x, f[x]} /. {a -> 2, b -> 3}, {x, 0, 4, .1}]
nlm = NonlinearModelFit[d1, a Exp[-(b (x - c1))^2] + yoff, {a, b}, x]
nlm["BestFitParameters"]

{peakVal, peakPos} = FindMaximum[nlm[x0], x0]
x1 = FindRoot[nlm[x] == 0.5*peakVal, {x, (x0 /. peakPos) + 0.05}]
x2 = FindRoot[nlm[x] == 0.5*peakVal, {x, (x0 /. peakPos) - 0.05}]
Plot[nlm[x], {x, 0, 4}, 
             Epilog -> {Point@d1, Red, Line[{{x, nlm[x]} /. x1, {x, nlm[x]} /. x2}]}]

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ Once again I owe you, and further insert my foot into my mouth for my idiocy the first time around. Thanks so much for your help. $\endgroup$ – RNPF Aug 31 '15 at 4:56

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