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$
3
  • $\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, 2015 at 4:04
  • 1
    $\begingroup$ I think what you're asking for is f1["BestFitParameters"]. $\endgroup$
    – Jens
    Aug 31, 2015 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, 2015 at 12:41

2 Answers 2

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$
5
  • $\begingroup$ Thanks a ton- I didnt consider simply reusing the curve itself. Thats a huge help- thank you. $\endgroup$
    – RNPF
    Aug 31, 2015 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, 2015 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, 2015 at 5:28
  • $\begingroup$ @RNPF Forget about using dynamic until you get a grip on Mathematica. You're asking for trouble :) $\endgroup$ Aug 31, 2015 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, 2015 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
  • 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, 2015 at 4:56

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