Interactive Curve Fitting

Manipulate[
DynamicModule[{d0=0.07},
plt1=
Which[
plt===Plot,ListPlot,
plt===LogPlot,ListLogPlot,
plt===LogLogPlot,ListLogLogPlot,
plt===LogLinearPlot,ListLogLinearPlot];
range=
Which[
plt===Plot,{{0,d1},{0,d2}},
plt===LogPlot,{{0,d1},{d0,d2}},
plt===LogLogPlot,{{d0,d1},{d0,d2}},
plt===LogLinearPlot,{{d0,d1},{0,d2}}];
Panel[
Column[
{
Style["Click the graph on the left to place points.",Bold],
Grid[{
{
Column[{
Row[{Button["reset",p={};l={{}};regline={};d1=1;d2=1,ImageSize->{100}]}],
Row[{"aspect ratio: ",RadioButtonBar[Dynamic[ratio1],{1/GoldenRatio->"1/golden ratio",Automatic->"automatic"}]}],
EventHandler[
Dynamic@Show[l[[1]],Graphics[{Point[p]},PlotRange->{{0,d1},{0,d2}}],PlotRange->{{0,d1},{0,d2}},Frame->True,AspectRatio->ratio1,ImageSize->{275,275},Background->White,FrameLabel->{Style["x",Italic],Style["y",Italic]},Axes->None],
"MouseDown":>(AppendTo[p,MousePosition["Graphics"]];
If[Length[p]≥2,l=Dynamic@Plot[Evaluate[regline=(model)/.FindFit[p,model,{a,b},{x}]],{x,0,d1},PlotRange->{{0,d1},{0,d2}}]
])
]},Spacings->1],Spacer[15],
Column[{
Row[{"plotting: ",SetterBar[Dynamic[plt],{Plot->"plot",LogPlot->"log plot",LogLogPlot->"log-log plot",LogLinearPlot->"log-linear plot"}]}],
Row[{"aspect ratio: ",RadioButtonBar[Dynamic[ratio2],{1/GoldenRatio->"1/golden ratio",Automatic->"automatic"}]}],
Dynamic@Show[
Which[Length[p]≥2,
plt[Evaluate[{
regline=(model)/.FindFit[p,model,{a,b},{x}]
}
],{x,0.0001,d1},PlotRange->Evaluate[range],GridLines->Automatic],
True,
plt[x d2/d1,{x,0.0001,d1},GridLines->Automatic,PlotRange->Evaluate[range],PlotStyle->{Opacity[0]}]
],Which[
Length[p]>0, 
plt1[p,GridLines->Automatic,PlotRange->Evaluate[range]],
True,
plt1[{{d0,d0},{d1,d2}},GridLines->Automatic,PlotRange->Evaluate[range],PlotStyle->{Opacity[0]}]],
Frame->True,FrameLabel->{Style["x",Italic],Style["y",Italic]},ImageSize->{275,275},Background->White,Axes->None,AspectRatio->ratio2]
},Spacings->1
]
}}],
,Row[{"fitting curve: ",Text@TraditionalForm[Dynamic[regline]]},Background->White,FrameMargins->5,Frame->True]
}]
]
]
,{{p,{},""},ControlType->None},
{{model,a x+b,"model"},{a x+b,(E^(a x+b)),b*(x^(a )),a Log[x]+b},SetterBar},
{{d1,1,"data x-range"},1,100,1,Appearance->"Labeled"},
{{d2,1,"y-range"},1,100,1,Appearance->"Labeled"},
{{l,{{}}},ControlType->None},
{{regline,{}},ControlType->None},
{{plt,Plot},ControlType->None},
{{plt1,ListPlot},ControlType->None},
{{range,{{0,d1},{0,d2}}},ControlType->None},
{{ratio1,1/GoldenRatio},ControlType->None},
{{ratio2,1/GoldenRatio},ControlType->None},FrameMargins->-7,AutorunSequencing->{2,3,4},ControlPlacement->Top
]

CAPTION

This Demonstration is a simple interactive tool to help to understand a few common fitting models of 1D datasets as well as their visualization using logarithmic plots. It is based on an example for the EventHandler in the Mathematica documentation.

DETAILS

Click to get new points in the left graphic according to a chosen fitting model.

Click to get "wrong" points far from the desired shape. What happens to the fitting curve?

Choose "wrong" models for a given dataset.

Use different plots to see how they transform different shapes.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Interactive Curve Fitting" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/InteractiveCurveFitting/

Contributed by: Janos Karsai (University of Szeged, Hungary)

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 »