Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have some problems with the NonlinearModelFit:

NonlinearModelFit[data, A (1 + Cos[a x]) + B (1 + Cos[b x]) + c , {A, B, a, b, c}, x]

The model should fit my data:

data plot

I tried all sort of things described in this thread.

The best Fit Mathematica gave me was a really noisy horizontal line. Even if I constrain c on a reasonable Value and give a good guess, things don't get much better. I don't know what to try next and hope to find help here in the forum.


Thank you again.

I can't really give you more data, since this data is the result of a quantum chemical calculation and because of the periodicity I would just get the same data again for the next period (accuracy about 0.0000002).

Just if you are interested: The data represents the absolute Energy [Hartree] of a ethylene dichloride molecule as a function of the Dihedral angle Cl-C-C-Cl.

I did a little literature research and found that all the models you suggested here were at least once used to fit similar data in some papers. You are doing a great job in this forum, I much appreciate it.

share|improve this question
    
One obvious problem: your c, A, and B are indistinguishable parameters in the current formulation of your model. Try fitting with the model A Cos[a x] + B Cos[b x] + c and report back. Also, don't you have at least a reasonable guess for your parameters? –  J. M. Aug 18 '12 at 18:40
    
Perhaps you could comment where does that data come from ... –  belisarius Aug 18 '12 at 20:57
    
Pascal, welcome to Mathematica.SE! Please consider registering your account so that any upvotes you get on this question are added to those you might get on future questions and answers. That way, over time you will be able to do more on the site (post graphics, edit things, etc). –  Sjoerd C. de Vries Aug 19 '12 at 13:32
    
Pascal, allow me to welcome you to Mathematica.SE and remind you of three things we usually do here: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the FAQs! 3) When you see good Q&A, 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, remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign` –  belisarius Aug 19 '12 at 23:06
    
Can you provide a few more periods for your data? –  Vitaliy Kaurov Aug 20 '12 at 0:36

2 Answers 2

up vote 12 down vote accepted

The fact that your data are periodic changes thinking quite a bit. But to check this all out we need to deal with symmetric part of your data that can be interpreted as a complete single period:

data = Sort[data][[19 ;; -1]]; ListPlot[data, Frame -> True]

enter image description here

There could be something similar to interference effect going on, when around center both cosines amplify each other, and away from the center they cancel each other out and total intensity decays fast. I decided to check this idea with a simple demo:

Manipulate[ Plot[Cos[x] + Cos[f x], {x, -3 Pi, 3 Pi}], {{f, .45, 
   "frequency"}, .1, 2, Appearance -> "Labeled"}]

enter image description here

So there is this sweet spot in the frequency ratio f2 ~ .45 f1 that gives a shape that looks like your data a bit. This can be reflected in setting initial values to fitting parameters:

nlm = NonlinearModelFit[data,  A Cos[a x] + B Cos[b x] + 
   c, {{A, 0.01}, {B, 0.01}, {a, 0.05}, {b, .05 .45}, {c, -997.02}}, x];

nlm[x]

-997.019 + 0.0088702 Cos[0.0250939 x] + 0.00783324 Cos[0.0527904 x]

And it turned out to be quite good for just two cos functions:

Show[ListPlot[data], Plot[nlm[x], {x, -252, 180}, PlotStyle -> Red, PlotRange -> All], 
 Frame -> True]

enter image description here

The conclusion is that model needs to be analysed very carefully in order to provide wise initial values to fitting parameters. Now you can better your model by introducing more cos or something else.

share|improve this answer
    
Thanks for your helpful answer. You are right, the model seems to be very bad to aproximate the data. But my supervisor told me to use this model. The addition of a gaussian-function does not help much because the function is supposed to be periodic (T=360), i forgot to mention that. –  Pascal Wink Aug 19 '12 at 13:06
    
@PascalWink I updated my answer based on the info you provided in the comment. –  Vitaliy Kaurov Aug 20 '12 at 0:23
    
Vitaliy: The problem with your update is that the OP initially forgot to mention that his function has a period of 360 (degrees??) ... Try Show[ListPlot[data], Plot[nlm[x], {x, -300, 480}, PlotStyle -> Red, PlotRange -> All], Frame -> True] –  belisarius Aug 20 '12 at 0:23
2  
@Verde I see your point. I think we should ask to see a few periods of the real data. –  Vitaliy Kaurov Aug 20 '12 at 0:34
1  
@Verde I know you did, I saw your answer. I have a feeling his real data are different from that - I maybe wrong though ;) I will have time to come back to this only much later. I asked him to provide the data in a comment. –  Vitaliy Kaurov Aug 20 '12 at 0:38

After your new info about the periodicity, I made the following:

data = ... Your data ...
l1 = {-1, 1} # & /@ Select[data, #[[1]] < 0 &];
l2 = {-1, 1} # & /@ Select[data, #[[1]] > 0 &];
ListLinePlot[data1 = MovingAverage[Sort[Join[data, l1, l2]], 3]]
data3 = data1 /. {a_, b_} -> {a + 365, b};
data4 = data1 /. {a_, b_} -> {a + 730, b};
ListLinePlot[data5 = Sort@Join[data1, data3, data4]]

Mathematica graphics

Then I used that data as an input to Formulize

And I got the following function (two frequencies and one phase involved):

f1 = 0.0518618;
f2 = 0.0172907;
d  = 0.0463127; 
yy[u_] := -997.024 + 1/200 (      Cos[d - f1 u] + 
                          1.28314 Cos[f2 u] + 
                         0.649146 Cos[f2 u]^2 + 
                         0.760871 Cos[d - f1 u] Cos[f2 u]^4 + 
                          1.10543 Cos[d - f1 u] Cos[f2 u]^5)

Show[{ListPlot[data5, PlotRange -> Full], 
          Plot[yy[x], {x, -200, 1000}, PlotStyle -> Directive[Red]]}]

Mathematica graphics

Of course not a simple Cos[] combination ... tell your supervisor :)

Edit

Please note that:

$f1 \approx 1/(6 \pi)$ and $f2 \approx 1/(18 \pi)$

but of course that may be just a coincidence.

Edit 2

You could always find the Fourier expansion

l1 = {-1, 1} # & /@ Select[data, #[[1]] < 0 &];
l2 = {-1, 1} # & /@ Select[data, #[[1]] > 0 &];
data2 = Last /@ GatherBy[Sort[Join[data, l1, l2]], #[[1]] &];
data3 = Plus[#, {0, 997.03}] & /@ data2[[2 ;; -2]];
cc = FourierDCT[data3[[All, 2]], 3]/Sqrt[Length@data3];
(*Now plotting*)
xg = N[Range[0, Length@data3 - 1]]/Length@data3;
fp = ListPlot[Transpose[{xg, data3[[All, 2]]}], PlotRange -> All];
Show[fp, Plot[Sum[cc[[r]]*Cos[Pi (r - 1/2) x], {r, Length[cc]}], 
              {x, -.99, .99}, PlotRange -> All]]

Mathematica graphics

And the spectra is something like:

ListPlot[cc]

Mathematica graphics

share|improve this answer
    
Wow, thank you! This is realy impressive and helped me out a lot. I will tell my supervisor ;) –  Pascal Wink Aug 19 '12 at 22:14

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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