mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-20 11:59:26 +02:00
TAChart: Add goodness-of-fit calculation to TFitSeries. Update FitDemo.
git-svn-id: trunk@49571 -
This commit is contained in:
wp
parent
dab2caa6c5
commit
56a19261f9
@ -8,7 +8,7 @@ object frmMain: TfrmMain
|
||||
ClientWidth = 800
|
||||
OnCreate = FormCreate
|
||||
ShowHint = True
|
||||
LCLVersion = '1.1'
|
||||
LCLVersion = '1.5'
|
||||
object pnlParams: TPanel
|
||||
Left = 8
|
||||
Height = 487
|
||||
@ -27,7 +27,7 @@ object frmMain: TfrmMain
|
||||
Width = 376
|
||||
Align = alTop
|
||||
Caption = ' Data generation '
|
||||
ClientHeight = 87
|
||||
ClientHeight = 85
|
||||
ClientWidth = 372
|
||||
TabOrder = 0
|
||||
object btnSave: TSpeedButton
|
||||
@ -76,42 +76,42 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object cbTestFunction: TComboBox
|
||||
Left = 94
|
||||
Height = 21
|
||||
Height = 23
|
||||
Hint = 'Select a dataset for fitting'
|
||||
Top = 8
|
||||
Width = 264
|
||||
ItemHeight = 13
|
||||
ItemHeight = 15
|
||||
OnSelect = cbTestFunctionSelect
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblTestFunction: TLabel
|
||||
Left = 14
|
||||
Height = 13
|
||||
Height = 15
|
||||
Top = 12
|
||||
Width = 63
|
||||
Width = 70
|
||||
Caption = 'Test function'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblOfRange: TLabel
|
||||
Left = 195
|
||||
Height = 13
|
||||
Height = 15
|
||||
Top = 46
|
||||
Width = 55
|
||||
Width = 57
|
||||
Caption = '% of range'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblNoiseY: TLabel
|
||||
Left = 14
|
||||
Height = 13
|
||||
Height = 15
|
||||
Top = 46
|
||||
Width = 78
|
||||
Width = 90
|
||||
Caption = 'Noise amplitude '
|
||||
ParentColor = False
|
||||
end
|
||||
object edNoiseY: TFloatSpinEdit
|
||||
Left = 118
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 44
|
||||
Width = 66
|
||||
DecimalPlaces = 0
|
||||
@ -130,22 +130,22 @@ object frmMain: TfrmMain
|
||||
Width = 376
|
||||
Align = alClient
|
||||
Caption = ' Fitting '
|
||||
ClientHeight = 364
|
||||
ClientHeight = 362
|
||||
ClientWidth = 372
|
||||
TabOrder = 1
|
||||
object gbResults: TGroupBox
|
||||
Left = 14
|
||||
Height = 142
|
||||
Height = 140
|
||||
Top = 207
|
||||
Width = 344
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
Caption = ' Fit results '
|
||||
ClientHeight = 124
|
||||
ClientHeight = 120
|
||||
ClientWidth = 340
|
||||
TabOrder = 0
|
||||
object lbResults: TListBox
|
||||
Left = 12
|
||||
Height = 104
|
||||
Height = 100
|
||||
Top = 8
|
||||
Width = 316
|
||||
Align = alClient
|
||||
@ -164,30 +164,30 @@ object frmMain: TfrmMain
|
||||
Top = 84
|
||||
Width = 344
|
||||
Caption = 'Fit range'
|
||||
ClientHeight = 97
|
||||
ClientHeight = 95
|
||||
ClientWidth = 340
|
||||
TabOrder = 1
|
||||
object cbFitRangeUseMin: TCheckBox
|
||||
Left = 17
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 7
|
||||
Width = 81
|
||||
Width = 95
|
||||
Caption = 'Use minimum'
|
||||
OnClick = cbFitRangeUseMinClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object cbFitRangeUseMax: TCheckBox
|
||||
Left = 17
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 33
|
||||
Width = 85
|
||||
Width = 96
|
||||
Caption = 'Use maximum'
|
||||
OnClick = cbFitRangeUseMaxClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object edFitRangeMin: TFloatSpinEdit
|
||||
Left = 150
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 7
|
||||
Width = 90
|
||||
Increment = 1
|
||||
@ -200,7 +200,7 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object edFitRangeMax: TFloatSpinEdit
|
||||
Left = 150
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 35
|
||||
Width = 90
|
||||
Increment = 1
|
||||
@ -213,9 +213,9 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object cbDrawFitRangeOnly: TCheckBox
|
||||
Left = 17
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 64
|
||||
Width = 166
|
||||
Width = 179
|
||||
Caption = 'Draw fit curve in fit range only'
|
||||
Checked = True
|
||||
Enabled = False
|
||||
@ -226,7 +226,7 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object edFitOrder: TSpinEdit
|
||||
Left = 169
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 53
|
||||
OnChange = edFitOrderChange
|
||||
@ -235,19 +235,19 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object lblFitOrder: TLabel
|
||||
Left = 14
|
||||
Height = 13
|
||||
Height = 15
|
||||
Top = 50
|
||||
Width = 101
|
||||
Width = 114
|
||||
Caption = 'Degree of polynomial'
|
||||
ParentColor = False
|
||||
end
|
||||
object cbFitEquation: TComboBox
|
||||
Left = 86
|
||||
Height = 21
|
||||
Height = 23
|
||||
Hint = 'Select a function type to be used for fitting to the generated data'
|
||||
Top = 16
|
||||
Width = 272
|
||||
ItemHeight = 13
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Polynomial (y = b0 + b1*x + ... bn*x^n)'
|
||||
@ -262,9 +262,9 @@ object frmMain: TfrmMain
|
||||
end
|
||||
object lblFitEquation: TLabel
|
||||
Left = 14
|
||||
Height = 13
|
||||
Height = 15
|
||||
Top = 19
|
||||
Width = 57
|
||||
Width = 63
|
||||
Caption = 'Fit equation'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -327,7 +327,6 @@ object frmMain: TfrmMain
|
||||
)
|
||||
Align = alClient
|
||||
DoubleBuffered = True
|
||||
ParentColor = False
|
||||
object DataSeries: TLineSeries
|
||||
Title = 'Test data'
|
||||
AxisIndexX = 1
|
||||
@ -362,18 +361,18 @@ object frmMain: TfrmMain
|
||||
TabOrder = 1
|
||||
object cbLogX: TCheckBox
|
||||
Left = 48
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 3
|
||||
Width = 83
|
||||
Width = 92
|
||||
Caption = 'Logarithmic x'
|
||||
OnClick = cbLogClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object cbLogY: TCheckBox
|
||||
Left = 176
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 3
|
||||
Width = 83
|
||||
Width = 93
|
||||
Caption = 'Logarithmic y'
|
||||
OnClick = cbLogClick
|
||||
TabOrder = 1
|
||||
|
||||
@ -96,14 +96,17 @@ var
|
||||
s: TStream;
|
||||
fs: TFormatSettings;
|
||||
si: PChartDataItem;
|
||||
line: String;
|
||||
begin
|
||||
if not SaveDialog.Execute then exit;
|
||||
fs := DefaultFormatSettings;
|
||||
fs.DecimalSeparator := '.';
|
||||
s := TFileStream.Create(SaveDialog.FileName, fmCreate);
|
||||
try
|
||||
for si in ListChartSource do
|
||||
s.WriteAnsiString(Format('%.9g'#9'%.9g'#13#10, [si^.X, si^.Y], fs));
|
||||
for si in ListChartSource do begin
|
||||
line := Format('%.9g'#9'%.9g'#13#10, [si^.X, si^.Y], fs);
|
||||
s.WriteBuffer(line[1], Length(line));
|
||||
end;
|
||||
finally
|
||||
s.Free;
|
||||
end;
|
||||
@ -250,6 +253,7 @@ begin
|
||||
Add(Format('a = %g', [FitSeries.Param[0]]));
|
||||
Add(Format('b = %g', [FitSeries.Param[1]]));
|
||||
end;
|
||||
Add(Format('R-squared = %g', [FitSeries.GoodnessOfFit]));
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
@ -264,7 +268,6 @@ begin
|
||||
Items.Add(eq.Equation(feLinear).Params(LIN_PARAMS));
|
||||
Items.Add(eq.Equation(feExp).Params(EXP_PARAMS));
|
||||
Items.Add(eq.Equation(fePower).Params(PWR_PARAMS));
|
||||
Items.Add(eq.Equation(fePower).Params(PWR_PARAMS));
|
||||
ItemIndex := Ord(fePolynomial);
|
||||
end;
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
@ -41,7 +41,6 @@
|
||||
<Unit0>
|
||||
<Filename Value="fitdemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="fitdemo"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="Main.pas"/>
|
||||
@ -49,7 +48,6 @@
|
||||
<ComponentName Value="frmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
@ -76,12 +74,6 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
@ -247,6 +247,9 @@ type
|
||||
|
||||
TFitParamsState = (fpsUnknown, fpsInvalid, fpsValid);
|
||||
|
||||
TCalcGoodnessOfFitEvent = procedure (Sender: TObject; var x,y: ArbFloat;
|
||||
n: Integer; out AResult: Double) of object;
|
||||
|
||||
TFitSeries = class(TBasicPointSeries)
|
||||
strict private
|
||||
FDrawFitRangeOnly: Boolean;
|
||||
@ -257,6 +260,8 @@ type
|
||||
FPen: TChartPen;
|
||||
FState: TFitParamsState;
|
||||
FStep: TFuncSeriesStep;
|
||||
FGoodnessOfFit: Double;
|
||||
FOnCalcGoodnessOfFit: TCalcGoodnessOfFitEvent;
|
||||
function GetParam(AIndex: Integer): Double;
|
||||
function GetParamCount: Integer;
|
||||
function PrepareIntervals: TIntervalList;
|
||||
@ -272,6 +277,7 @@ type
|
||||
procedure Transform(AX, AY: Double; out ANewX, ANewY: Extended);
|
||||
protected
|
||||
procedure AfterAdd; override;
|
||||
function CalcGoodnessOfFit(var x,y: ArbFloat; n: Integer): Double; virtual;
|
||||
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
||||
procedure SourceChanged(ASender: TObject); override;
|
||||
public
|
||||
@ -289,26 +295,30 @@ type
|
||||
const AParams: TNearestPointParams;
|
||||
out AResults: TNearestPointResults): Boolean; override;
|
||||
property Param[AIndex: Integer]: Double read GetParam write SetParam;
|
||||
property GoodnessOfFit: Double read FGoodnessOfFit;
|
||||
property State: TFitParamsState read FState;
|
||||
published
|
||||
property AxisIndexX;
|
||||
property AxisIndexY;
|
||||
property DrawFitRangeOnly: Boolean
|
||||
read FDrawFitRangeOnly write SetDrawFitRangeOnly default true;
|
||||
property FitEquation: TFitEquation read FFitEquation write SetFitEquation default fePolynomial;
|
||||
property FitEquation: TFitEquation
|
||||
read FFitEquation write SetFitEquation default fePolynomial;
|
||||
property FitRange: TChartRange read FFitRange write SetFitRange;
|
||||
property OnFitComplete: TNotifyEvent read FOnFitComplete write FOnFitComplete;
|
||||
property ParamCount: Integer
|
||||
read GetParamCount write SetParamCount default DEF_FIT_PARAM_COUNT;
|
||||
property Pen: TChartPen read FPen write SetPen;
|
||||
property Source;
|
||||
property Step: TFuncSeriesStep read FStep write SetStep default DEF_FIT_STEP;
|
||||
property OnCalcGoodnessOfFit: TCalcGoodnessOfFitEvent
|
||||
read FOnCalcGoodnessOfFit write FOnCalcGoodnessOfFit;
|
||||
property OnFitComplete: TNotifyEvent
|
||||
read FOnFitComplete write FOnFitComplete;
|
||||
end;
|
||||
|
||||
TFuncCalculate3DEvent =
|
||||
procedure (const AX, AY: Double; out AZ: Double) of object;
|
||||
|
||||
|
||||
TColorMapSeries = class(TBasicFuncSeries)
|
||||
public
|
||||
type
|
||||
@ -1307,6 +1317,40 @@ begin
|
||||
FFitRange.SetOwner(ParentChart);
|
||||
end;
|
||||
|
||||
{ Calculates the R-squared parameter as a simple measure for the goodness-of-fit.
|
||||
More advanced calculations require the standard deviation of the y values
|
||||
which are not available.
|
||||
Method can be overridden for more advanced calculations.
|
||||
x and y are the first values of arrays containing the transformed values
|
||||
used during fitting. n indicates the number of these value pairs. }
|
||||
function TFitSeries.CalcGoodnessOfFit(var x,y: ArbFloat; n: Integer): Double;
|
||||
type
|
||||
TArbFloatArray = array[0..0] of Arbfloat;
|
||||
var
|
||||
yave, ycalc, SStot, SSres: Double;
|
||||
i, j: Integer;
|
||||
na: Integer;
|
||||
begin
|
||||
{$IFOPT R+}{$DEFINE RANGE_CHECK_ON}{$ENDIF}
|
||||
{$IFDEF RANGE_CHECK_ON}{$R-}{$ENDIF}
|
||||
yave := 0;
|
||||
for i:=0 to n-1 do
|
||||
yave := yave + TArbFloatArray(y)[i];
|
||||
yave := yave / n;
|
||||
|
||||
SStot := 0.0;
|
||||
SSres := 0.0;
|
||||
for i:=0 to n-1 do begin
|
||||
SStot := SStot + sqr(TArbFloatArray(y)[i] - yave);
|
||||
ycalc := 0.0;
|
||||
for j:=High(FFitParams) downto 0 do
|
||||
ycalc := ycalc * TArbFloatArray(x)[i] + FFitParams[j];
|
||||
SSres := SSres + sqr(TArbFloatArray(y)[i] - ycalc);
|
||||
end;
|
||||
Result := 1.0 - SSres / SStot;
|
||||
{$IFDEF RANGE_CHECK_ON}{$R+}{$ENDIF}
|
||||
end;
|
||||
|
||||
function TFitSeries.Calculate(AX: Double): Double;
|
||||
var
|
||||
i: Integer;
|
||||
@ -1357,6 +1401,7 @@ begin
|
||||
FPen.OnChange := @StyleChanged;
|
||||
FStep := DEF_FIT_STEP;
|
||||
ParamCount := DEF_FIT_PARAM_COUNT; // Parabolic fit as default.
|
||||
FGoodnessOfFit := NaN;
|
||||
end;
|
||||
|
||||
destructor TFitSeries.Destroy;
|
||||
@ -1409,6 +1454,8 @@ var
|
||||
var
|
||||
i, j, term, ns, np, n: Integer;
|
||||
xv, yv, fp: array of ArbFloat;
|
||||
ssTot, ssRes: Double;
|
||||
ycalc, yave: Double;
|
||||
begin
|
||||
np := ParamCount;
|
||||
ns := Source.Count;
|
||||
@ -1441,6 +1488,12 @@ var
|
||||
for i := 0 to High(FFitParams) do
|
||||
FFitParams[i] := fp[i];
|
||||
|
||||
// Calculate goodness-of-fit parameter
|
||||
if Assigned(FOnCalcGoodnessOfFit) then
|
||||
FOnCalcGoodnessOfFit(Self, xv[0], yv[0], Length(yv), FGoodnessOfFit)
|
||||
else
|
||||
FGoodnessOfFit := CalcGoodnessOfFit(xv[0], yv[0], Length(yv));
|
||||
|
||||
// See comment for "Transform": for exponential and power fit equations, the
|
||||
// first fitted parameter is the logarithm of the "real" parameter. It needs
|
||||
// to be transformed back to real units by exp function.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user