1
$\begingroup$

I have some collected data that should be modeled by a damped oscillation. Here are the data in a list of ordered pairs:

data = {{60, 1.1}, {180, 27.7}, {300, 44.5}, {420, 37.1}, {540, 17.5}, {660, 7.6}, {780, 15.25}, {900, 29.3}, {1020, 34.5}, {1140, 27.5}, {1260, 17.7}, {1380, 15.25}, {1500, 21.25}, {1620, 28.1}}

Indeed, a plot of the data shows that this looks to be a good fit:

Plot of Collected Data

I'm trying to fit a damped sine wave of the form

A*Exp[-k*t]*Sin[w*t + p] + h

I tried to do this in Mathematica, generally following the documentation on NonlinearModelFit. I used the following code:

model = A*Exp[-k*t]*Sin[w*t + p] + h;
f = NonlinearModelFit[data, model, {A, k, w, p, h}, t];
Normal[f]

When I run this, however, I get the following function:

5.50389 - 6.06739 E^(0.202624 t) Sin[2.00518 + 0.485183 t]

Plotted, it looks like this:

Plot of Fitted Function

That doesn't seem to be an appropriate fit for the data. Does anyone have an idea as to how I can produce a better model? Thanks!

$\endgroup$
1
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$
    – bbgodfrey
    Feb 20 '15 at 5:50
6
$\begingroup$

Finding parameter starting estimates is an important starting point. I post this for illustration. There are many ways to approximate.

Manipulate[
 Show[ListPlot[data], 
  Plot[s Exp[- a t] Sin[ b t + c] + f, {t, 0, 1000}]], {a, 0, 
  0.1}, {b, 0.001, 0.01}, {c, 1, 10}, {s, 20, 50}, {f, 5, 50}]

enter image description here

Now fit model:

nlm = NonlinearModelFit[data, 
  amp Exp[- k t] Sin[ a t + b] + 
   c, {{amp, 20}, {k, 0.0006}, {a, 0.009}, {b, 20}, {c, 25}}, t]
Show[ListPlot[data], Plot[nlm[t], {t, 0, 1600}], 
 PlotLabel -> Framed[nlm[t]], Frame -> True]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ That was really helpful. I didn't know how to set those starting estimates. Thank you so much! $\endgroup$ Feb 20 '15 at 23:56

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.