Linear and Quadratic Curve Fitting Practice

PointToLSPolygon[{x_,y_},fn_,var_]:=Block[{sq=Sow[(fn/.var->x)-y]},Tooltip[ Polygon[{{x,y},{x+sq,y},{x+sq,y+sq},{x,y+sq},{x,y}}],sq^2]]

Manipulate[Block[{pl,sqs,sqstot,bestfit,bestfitmodel,a,model,modelerror,x,w1,w2,w3},
(*Adjust the number of locators according to the type of fit model*)
If[Length[pts]>2&&Not[QuadraticFit],pts={First[Sort[pts]],Last[Sort[pts]]}];
If[Length[pts]<3&&QuadraticFit,AppendTo[pts,Mean[pts]]];
(*Create model and data sample*)
SeedRandom[seedrandom];
model= InterpolatingPolynomial[{{0,RandomReal[10]},If[QuadraticModel,{RandomReal[{2,8}],RandomReal[10]},Apply[Sequence,{}]],{10,RandomReal[10]}},x];
a=Table[{i,(model/.x->(i+RandomReal[If[noisedistribution==="uniform",{-Noise,Noise},NormalDistribution[0,Noise^2]]] ))+RandomReal[If[noisedistribution==="uniform",{-Noise,Noise},NormalDistribution[0,Noise^2]]]},{i,0,10,10/(numpoints-1)}];

(*Solve the best fit problem*)
bestfitmodel=If[QuadraticFit,
					w1+w2 x+w3 (x^2)/.FindFit[a,w1+w2 x+w3 (x^2),{w1,w2,w3},x],
					w1+w2 x/.FindFit[a,w1+w2 x,{w1,w2},x]];
bestfit=Total[(((((bestfitmodel/.x->#1[[1]])-#1[[2]]&)/@a))^2)];
modelerror=Total[(((((model/.x->#1[[1]])-#1[[2]]&)/@a))^2)];

(*Score the current manual fit and construct squares in case they are to be seen*)
{pl,sqs}=Reap[Map[PointToLSPolygon[#,InterpolatingPolynomial[pts,x],x]&,a]];
sqstot=Total[Flatten[sqs]^2];

(*Generate the images*)
Grid[{{
Show[
(*The manual fit*)
Plot[Evaluate[InterpolatingPolynomial[pts,x]],{x,Min[pts[[All,1]]],Max[pts[[All,1]]]}],
(*The raw data*)
ListPlot[a,PlotStyle->PointSize[0.03]],
(*The error squares*)
Graphics[Prepend[
If[ShowSquares,pl,{}],Opacity[0.3]]],
(*The solution model*)
If[ShowOriginalModel,Plot[Tooltip[model,"original model"],{x,0,10},PlotStyle->Green],Graphics[]],
If[ShowBestFit,Plot[Tooltip[bestfitmodel,"best fit"],{x,0,10},PlotStyle->Blue],Graphics[]],

(*Set appropriate ranges*)
AspectRatio->1,ImageSize->{250,250},PlotRange->MapAt[Min[#,0]&,MapAt[Max[#,10]&,Transpose[ScalingTransform[{1.1,1.1},Mean[a]][{{Min[#[[1]]],Min[#[[2]]]},{Max[#[[1]]],Max[#[[2]]]}}&[Transpose[a]]]],{{1,2},{2,2}}],{{1,1},{2,1}}],ImageSize->{250,250},AxesOrigin->{0,0}],

(*Show the scoring indicator*)
If[ShowTotalSquares,
Graphics[{GrayLevel[0.5],Tooltip[Polygon[{{0,0},{1,0},{1,sqstot},{0,sqstot},{0,0}}],sqstot],
If[ShowBestFit,
{Blue,Line[{{0,bestfit},{1,bestfit}}]},{}],
If[ShowOriginalModel,
{Green,Line[{{0,modelerror},{1,modelerror}}]},{}]
},AspectRatio->3,PlotRange->{0,20 numpoints},ImageSize->100,PlotLabel->sqstot]," "]}}]],

(*UI Controls*)

Style["models",14,Bold],
{{pts,{{1,6},{4,8},{10,1}}},Locator},
{{seedrandom,1,"data set"},1,200,1, ImageSize->Small},
{{QuadraticModel,True,"quadratic model"},{True,False}},
" ",

Style["sample data",14,Bold],
{{numpoints,10,"number of data points"},3,50,1, ImageSize->Small},
{{Noise,1,"error standard deviation"},0.01,3, ImageSize->Small},
{{noisedistribution,"uniform","error distribution"},{"uniform","normal"}},
" ",
Style["fitting tools",14,Bold],
{{QuadraticFit,True,"quadratic fit"},{True,False}},
{{ShowSquares,False,"show error squares"},{True,False}},
{{ShowTotalSquares,False,"show sum of error squares"},{True,False}},
{{ShowOriginalModel,False,"show original model"},{True,False}},
{{ShowBestFit,False,"show best fit"},{True,False}},SaveDefinitions->True,AutorunSequencing->{1,3,5,7}]

CAPTION

Practice fitting lines and curves to sample datasets, then compare your fit to the best possible.

You can choose to fit straight lines or quadratic curves to the data, and can choose data based on an underlying straight line or quadratic data.

Drag the locators to move the line and attempt to get the line to be the best fit possible for the random data. For extra help show the error squares (the square of the y axis distance between the points and your line) and try to minimize these. For further help show the sum of error squares and try to minimize that.

When you think you have the best fit, show the actual best fit and see how close you were. Then experiment with different datasets, models, and error sizes.

The best fit shown automatically minimizes the sum of squares differences between the data and fitted values. For (assumed) normally distributed errors, it can be generally assumed that least squares is the best fit possible. For other distributions, least squares will for instance not be the maximum likelihood estimate (which is commonly the criterion for best fit).

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Linear and Quadratic Curve Fitting Practice" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/LinearAndQuadraticCurveFittingPractice/

Contributed by: Jon McLoone

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »