Nonlinear Least Squares Fitting

Author

Eric W. Weisstein
August 6, 2002

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Statistics/NonlinearLeastSquaresFitting.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/NonlinearLeastSquaresFitting.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Notes

This is some of Eric's very old code.  It should be rewritten and cleaned up.

Code

NonlinearFitList[f_,var0_List,y_List,xi_List,n_]:=Module[
  {i,x,F,F0,db,len=Length[xi],var,vari,soln},
  var=Table[vari[i],{i,Length[var0]}];
  F0=Table[D[f[x,var],var[[i]]],{i,Length[var]}];
  dB=Table[y[[i]]-f[xi[[i]],var0],{i,len}];
  soln={{var0,dB.dB}};
  Print[0,". ",{var0,dB.dB}];
  Do[
    F=Table[F0 /. x->xi[[i]] /. var->var0,{i,len}];
    var0+=LinearSolve[Transpose[F].F,Transpose[F].dB];
    dB=Table[y[[i]]-f[xi[[i]],var0],{i,len}];
    Print[i,". ",{var0,dB.dB}];
    soln=Append[soln,{var0,dB.dB}],
    {i,n}
  ];
  soln
]

Gaussian Fit

Gaussian[x_,{A_,x0_,sigma_}]:=A Exp[-(x-x0)^2/(2sigma^2)]

GaussianFitList[f_List,xi_List,{Ai_,x0i_,sigmai_},n_]:=Module[{i,x,F,F0,db,len=Length[xi],A0=Ai,x00=x0i,sigma0=sigmai,soln},F0={D[Gaussian[x,{A,x0,sigma}],A],D[Gaussian[x,{A,x0,sigma}],x0],D[Gaussian[x,{A,x0,sigma}],sigma]};
dB=Table[f[[i]]-Gaussian[xi[[i]],{A0,x00,sigma0}],{i,len}];
soln={{{A0,x00,sigma0},dB.dB}};
Print[0,". ",{{A0,x00,sigma0},dB.dB}];
Do[F=Table[F0/.{x->xi[[i]],A->A0,x0->x00,sigma->sigma0},{i,len}];
{A0,x00,sigma0}+=LinearSolve[Transpose[F].F,Transpose[F].dB];
dB=Table[f[[i]]-Gaussian[xi[[i]],{A0,x00,sigma0}],{i,len}];
Print[i,". ",{{A0,x00,sigma0},dB.dB}];
soln=Append[soln,{{A0,x00,sigma0},dB.dB}],{i,n}];
soln]

GaussianFit[f_List,xi_List,{Ai_,x0i_,sigmai_},n_]:=GaussianFitList[f,xi,{Ai,x0i,sigmai},n][[-1]]

x=N[Table[i,{i,50}]];
y=Table[Gaussian[i,{1.,20.,5.}]+.1 Random[Real,{-1,1}],{i,50}];

GaussianFitList[y,x,{.8,15.,4.},10]

NonlinearFitList[Gaussian,{.8,15.,4.},y,x,4]

fitlist=GaussianFitList[data,xi,{.8,15,4},4];
Show[
  ListPlot[data,PlotJoined->True,DisplayFunction->Identity],
  Plot[Evaluate[Table[Gaussian[x,fitlist[[i,1]]],{i,Length[fitlist]}]],{x,1,50},
    DisplayFunction->Identity,
    PlotStyle->Flatten[{Dashing[{1,0}],Table[Dashing[{.02,.02}],{3}],Thickness[.01]}]],
 DisplayFunction->$DisplayFunction,Ticks->None]