Botulus
Botulus

Reputation: 27

Mathematica Fit to Polynomial does not work correctly

I am trying to fit data from a simulation to a polynomial. Luckily I do know the exact data and I know that my values are not bad at all! However, when trying to fit the data to a polynomial function using mathematica, the outcome is not satisfying at all. The (reduced) data compared to the exact data:

A = {{1, 4.20109`*^7}, {1.2214`, 5.92216`*^7}, {1.49182`, 
    9.21732`*^7}, {1.82212`, 1.60874`*^8}, {2.22554`, 
    3.21498`*^8}, {2.71828`, 7.4201`*^8}, {3.32012`, 
    2.01259`*^9}, {4.0552`, 6.24526`*^9}, {4.95303`, 
    2.2347`*^10}, {6.04965`, 9.13043`*^10}, {7.38906`, 
    4.12888`*^11}, {9.02501`, 2.03485`*^12}, {11.0232`, 
    1.07487`*^13}, {13.4637`, 5.98665`*^13}, {16.4446`, 
    3.49113`*^14}, {20.0855`, 1.96163`*^15}, {24.5325`, 
    1.15952`*^16}, {29.9641`, 8.46196`*^16}, {36.5982`, 
    5.93001`*^17}, {44.7012`, 2.86328`*^18}, {54.5982`, 
    1.56988`*^19}, {66.6863`, 8.60926`*^19}, {81.4509`, 
    4.95028`*^20}, {99.4843`, 2.56403`*^21}, {121.51`, 
    1.85016`*^22}};
InterFunc = Simplify[InterpolatingPolynomial[A, x]];
poly = Fit[A, {1, x, x^2, x^3, x^4, x^5, x^6, x^7, x^9}, x]
FindFit[A, 
 a + b*x + c*x^2 + d*x^3 + e*x^4 + l*x^5 + m*x^6 + h*x^7 + o*x^9, {a, 
  b, c, d, e, l, m, h, o}, x]

func = 10966470 + 12755136*x + 9092592*x^2 + 5269920*x^3 + 
   2435256*x^4 + 1059120*x^5 + 257880*x^6 + 94272*x^7 + 3504*x^9;

Show[ListLogPlot[A, PlotStyle -> Red], 
 LogPlot[{poly}, {x, 0, First[Last[A]]}, PlotStyle -> Orange], 
 LogPlot[{func}, {x, 0, First[Last[A]]}, PlotStyle -> Blue]]

My first idea was to use the InterpolatingPolynomial command and reduce the indata to 10 so I get a polynomial of order 9. It does not work, neither do Fit or FindFit, although 'func' shows there exist a polynomial fitting the data well. Is there another way to do the fit properly? Mathematica uses the LeastSquare fit, is there anothe method that can be used?

Another more mathemtical question: A polynomial is well-behaving, why does the LeastSquare fails here?

Upvotes: 2

Views: 814

Answers (1)

agentp
agentp

Reputation: 6989

elaborating on my comment, here is a fit to the log of the data..

 fit = a + b x + c Sqrt[x ] /.
    FindFit[MapAt[Log, A, {All, 2}], a + b x + c Sqrt[x ] ,
         {a, b, c}, x]
 Show[{LogPlot[ Exp[fit] , {x, 0, 120}], ListLogPlot[A]}]

enter image description here

of course that fit is not the polynomial you wanted..

 E^(10.686624598376872 + 6.617878262099062*Sqrt[x] - 0.2731299046868744*x)

Here is a direct polynomial fit using NormFunction

 fn =  Sum[ a[i] x^i, {i, 0, 9}];
 vars = CoefficientList[fn, x];
 fit = fn /. FindFit[A, fn, vars, x , NormFunction -> (Norm[Log[#]] &)]
 Show[{LogPlot[ fit , {x, 0, 120}], ListLogPlot[A]}]

  (* 1. + 1. x + 0.917982 x^2 + 1.76793 x^3 + 0.917982 x^4 + 1. x^5 + 4.36769 x^6 + 14.3472 x^7 + 133.75 x^8 + 3202.96 x^9 *)

This is very hit or miss, sometimes giving garbage depending on the order of the polynomial.

enter image description here

For reference here is the poor quality original fit:

enter image description here

The "error" where it looks bad is "only" order 10^17, which is basically negligible compared to any error at the high end of the data. ( The circled point is the maximum error on the plot ) Fitting in linear space is effectively fitting only to the large data values.

Upvotes: 1

Related Questions