Message Boards Message Boards

Universal data (graph) fitting

Sungwoo Yang, MIT
Posted 11 years ago

Hi all, I'm a newbie and I'm trying to use Mathematica as much as possible during my data analysis as a practice. By the way, I'm trying to create a Mathmatical notebook that is able to fit my data and find the best equation. (Polynomial equation) Here is my first trial. It is not beautiful as you can see.

I am hoping to get you experts' help on this. 1. Can I create a universal equation instead of going from x2, x3, .... and etc? So, I can use "Manipulate" function? 2. When I tried to add "PlotLegend", it keep giving me an error. I can't figure it out.

Any help will be very appreciable. Thank you so much for looking. I really appreciate it.

PS - my trial notebook is attached.

data = {{0.64`, 0.0156`}, {0.72`, 0.035`}, {0.8`, 0.055`}, {0.868`, 
    0.0701`}, {0.935`, 0.084`}, {1.019`, 0.09`}, {1.2`, 0.0925`}};
nlm2 = NonlinearModelFit[data, a + b x^1 + c x^2, {a, b, c}, x]
nlm2["BestFitParameters"]

nlm3 = NonlinearModelFit[data, 
  a + b x^1 + c x^2 + d x^3, {a, b, c, d}, x]
nlm3["BestFitParameters"]

nlm4 = NonlinearModelFit[data, 
  a + b x^1 + c x^2 + d x^3 + e x^4, {a, b, c, d, e}, x]
nlm4["BestFitParameters"]

nlm5 = NonlinearModelFit[data, 
  a + b x^1 + c x^2 + d x^3 + e x^4 + f x^5, {a, b, c, d, e, f}, x]
nlm5["BestFitParameters"]

nlm6 = NonlinearModelFit[data, 
  a + b x^1 + c x^2 + d x^3 + e x^4 + f x^5 + g x^6, {a, b, c, d, e, 
   f, g}, x]
nlm6["BestFitParameters"]

nlm7 = NonlinearModelFit[data, 
  a + b x^1 + c x^2 + d x^3 + e x^4 + f x^5 + g x^6 + h x^7, {a, b, c,
    d, e, f, g, h}, x]
nlm7["BestFitParameters"]

Show[Plot[{nlm2[x], nlm3[x], nlm4[x], nlm5[x], nlm6[x], nlm7[x]}, {x, 
   0.55, 1.25}], ListPlot[data, PlotStyle -> {PointSize[0.03]}]]
Attachments:
POSTED BY: Sungwoo Yang
3 Replies
Sort By:

Hi,

this function might be useful:

nlm[d_, data_] := NonlinearModelFit[data, Evaluate[Sum[Subscript[a, i] x^i, {i, 0, d}]], Evaluate[Table[Subscript[a, i], {i, 0, d}]], x]

d is the dimension of the polynomial and data is the list of points.

Here's an interactive interface:

M = 10; data = RandomReal[1, M];Manipulate[
Show[ListPlot[data, PlotStyle -> Red], Plot[Evaluate[Normal[NonlinearModelFit[data, Evaluate[Sum[Subscript[a, i] x^i, {i, 0, d}]], 
Evaluate[Table[Subscript[a, i], {i, 0, d}]], x]]], {x, 0, M + 1}, PlotRange -> All ]], {d, 0, 10}]

Some of the Evaluate functions are redundant. The thing looks like this:

enter image description here

Cheers,

Marco
POSTED BY: Marco Thiel

Hi,

I forgot to say that this works of course also if you want to add legends.

M = 10; data = RandomReal[1, M];
Manipulate[
 Show[ListPlot[data, PlotStyle -> Red], 
  Plot[Evaluate[
    Normal[NonlinearModelFit[data, 
      Evaluate[Sum[Subscript[a, i] x^i, {i, 0, d}]], 
      Evaluate[Table[Subscript[a, i], {i, 0, d}]], x]]], {x, 0, 
    M + 1}, PlotRange -> All , 
   PlotLegends -> 
    Placed["Polynomial \nf(x)=" <> 
      ToString[
       TraditionalForm[
        Evaluate[
         Normal[NonlinearModelFit[data, 
           Evaluate[Sum[Subscript[a, i] x^i, {i, 0, d}]], 
           Evaluate[Table[Subscript[a, i], {i, 0, d}]], x]]]]], 
     Below]]], {d, 0, 10}]

Cheers,

M.
POSTED BY: Marco Thiel
Sungwoo Yang
Sungwoo Yang, MIT
Posted 11 years ago

Hi Marco,

Thank you so much. This is exactly what I was looking for. You are awesome.
POSTED BY: Sungwoo Yang
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract