paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-23 06:39:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Fix initialization of custom fit functions for TFitSeries. Issue #35162.

Browse Source 
git-svn-id: trunk@60549 -
This commit is contained in:
wp 2019-03-01 00:23:36 +00:00
parent e88915bc93
commit 8baa6bdbc1
17 changed files with 273 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/tachart/demo/fit/Main.lfm
View File

@ -8,7 +8,7 @@ object frmMain: TfrmMain
ClientWidth = 997
OnCreate = FormCreate
ShowHint = True
LCLVersion = '1.9.0.0'
LCLVersion = '2.1.0.0'
object pnlParams: TPanel
Left = 8
Height = 487

1
components/tachart/demo/fit/Main.pas
View File

@ -227,6 +227,7 @@ begin
feCustom:
begin
FitSeries.ParamCount := 4;
FitSeries.SetFitBasisFunc(0, @FitBaseFunc_Const, '');
FitSeries.SetFitBasisFunc(1, @HarmonicBaseFunc, 'sin(x)');
FitSeries.SetFitBasisFunc(2, @HarmonicBaseFunc, 'sin(3 x)');
FitSeries.SetFitBasisFunc(3, @HarmonicBaseFunc, 'sin(5 x)');

23
components/tachart/languages/tachartstrconsts.de.po
View File

@ -182,9 +182,27 @@ msgstr "Distanzmessung"
msgid "Down triangle"
msgstr "Dreieck abwärts"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr "Nicht übereinstimmende Anzahl von x- und y-Werten."
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr "Es gibt mehr Fit-Parameter als Daten-Werte."
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr "Zu wenig benutzerdefinierte Basis-Funktionen."
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr "Keine Fit-Parameter angegeben."
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr "Die Fit-Matrix ist (fast) singulär."
#: tachartstrconsts.rserrillegalfitparamcount
#, fuzzy
#| msgid "Number of fit parameters cannot be less than 1."
msgid "The number of fit parameters cannot be less than 1."
msgstr "Die Anzahl der Fitparameter kann nicht kleiner als 1 sein."
@ -498,4 +516,3 @@ msgstr "Fehler beim Umbenennen von Komponenten: %s"
#: tachartstrconsts.tastoolseditortitle
msgid "Edit tools"
msgstr "Werkzeuge bearbeiten"

20
components/tachart/languages/tachartstrconsts.fi.po
View File

@ -170,6 +170,26 @@ msgstr "Etäisyysmittaus"
msgid "Down triangle"
msgstr ""
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.fr.po
View File

@ -180,6 +180,26 @@ msgstr "Mesure des distances"
msgid "Down triangle"
msgstr "Triangle en bas"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.hu.po
View File

@ -180,6 +180,26 @@ msgstr "Távolságmérés"
msgid "Down triangle"
msgstr "Háromszög (le)"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.lt.po
View File

@ -181,6 +181,26 @@ msgstr "Atstumo matavimas"
msgid "Down triangle"
msgstr "Trikampis į apačią"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.pl.po
View File

@ -180,6 +180,26 @@ msgstr "Pomiar odległości"
msgid "Down triangle"
msgstr ""
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.pot
View File

@ -170,6 +170,26 @@ msgstr ""
msgid "Down triangle"
msgstr ""
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.pt_BR.po
View File

@ -180,6 +180,26 @@ msgstr "Medida distância"
msgid "Down triangle"
msgstr "Triângulo descendente"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.se.po
View File

@ -183,6 +183,26 @@ msgstr "Avståndsmätning"
msgid "Down triangle"
msgstr ""
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.uk.po
View File

@ -183,6 +183,26 @@ msgstr "Вимірювання відстані"
msgid "Down triangle"
msgstr "Трикутник з вершиною донизу"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

20
components/tachart/languages/tachartstrconsts.zh_CN.po
View File

@ -181,6 +181,26 @@ msgstr "距离测量"
msgid "Down triangle"
msgstr "下三角形"
#: tachartstrconsts.rserrfitdimerror
msgid "Non-matching count of x and y values."
msgstr ""
#: tachartstrconsts.rserrfitmoreparamsthanvalues
msgid "There are more fitting parameters than data values."
msgstr ""
#: tachartstrconsts.rserrfitnobasefunctions
msgid "Not enough user-provided base functions."
msgstr ""
#: tachartstrconsts.rserrfitnofitparams
msgid "No fit parameters specified."
msgstr ""
#: tachartstrconsts.rserrfitsingular
msgid "Fitting matrix is (nearly) singular."
msgstr ""
#: tachartstrconsts.rserrillegalfitparamcount
msgid "The number of fit parameters cannot be less than 1."
msgstr ""

5
components/tachart/tachartstrconsts.pas
View File

@ -141,6 +141,11 @@ resourcestring
// Fit series
rsErrIllegalFitParamCount = 'The number of fit parameters cannot be less than 1.';
rsErrFitDimError = 'Non-matching count of x and y values.';
rsErrFitMoreParamsThanValues = 'There are more fitting parameters than data values.';
rsErrFitNoFitParams = 'No fit parameters specified.';
rsErrFitSingular = 'Fitting matrix is (nearly) singular.';
rsErrFitNoBaseFunctions = 'Not enough user-provided base functions.';
rsFitNumObservations = 'Number of observations';
rsFitNumFitParams = 'Number of fit parameters';
rsFitDegreesOfFreedom = 'Degrees of freedom';

7
components/tachart/tafitlib.pas
View File

@ -20,13 +20,18 @@ type
TFitFunc = function(x: ArbFloat; Param: Integer): ArbFloat; // is nested;
TFitBaseFunc = record
Func: TFitFunc;
FuncName: String;
end;
TFitBaseFuncArray = array of TFitBaseFunc;
TFitParam = record
Func: TFitFunc;
FuncName: String;
Value: ArbFloat;
Fixed: Boolean;
end;
TFitParamArray = array of TFitParam;
TFitErrCode = (

2
components/tachart/tafitutils.pas
View File

@ -24,7 +24,7 @@ type
feExp, // y = a * exp(b * x)
fePower, // y = a * x^b
feCustom // y = b0 + b1*F1(x) + b2*F2(x) + ... bn*Fn(x),
// Fi(x) = custom "fit base function" provided by event
// Fi(x) = custom "fit base function" provided by calling SetFitBasisFunc() method
);
IFitEquationText = interface

51
components/tachart/tafuncseries.pas
View File

@ -284,7 +284,7 @@ type
TFitParamsState = (fpsUnknown, fpsInvalid, fpsValid);
TFitFuncIndex = 1..MaxInt;
TFitFuncIndex = 0..MaxInt;
TFitFuncEvent = procedure(AIndex: TFitFuncIndex; AFitFunc: TFitFunc) of object;
@ -294,6 +294,7 @@ type
FDrawFitRangeOnly: Boolean;
FFitEquation: TFitEquation;
FFitParams: TFitParamArray; // raw values, not transformed!
FCustomFuncs: TFitBaseFuncArray;
FFitRange: TChartRange;
FFixedParams: String;
FOnFitComplete: TNotifyEvent;
@ -339,6 +340,7 @@ type
public
function Calculate(AX: Double): Double; virtual;
procedure Draw(ADrawer: IChartDrawer); override;
function ErrorMsg: String;
procedure ExecFit; virtual;
function Extent: TDoubleRect; override;
function EquationText: IFitEquationText;
@ -1646,7 +1648,7 @@ begin
de := PrepareIntervals;
try
PrepareGraphPoints(FChart.CurrentExtent, true);
if FState = fpsValid then
if (FState = fpsValid) and (FErrCode = fitOK) then
with TDrawFuncHelper.Create(Self, de, @Calculate, Step) do
try
DrawFunction(ADrawer);
@ -1678,6 +1680,20 @@ begin
Result.TextFormat(Marks.TextFormat).Equation(FitEquation).Params(FitParams).BasisFuncs(basis);
end;
function TFitSeries.ErrorMsg: String;
begin
case ErrCode of
fitOK : Result := '';
fitDimError : Result := rsErrFitDimError;
fitMoreParamsThanValues : Result := rsErrFitMoreParamsThanValues;
fitNoFitParams : Result := rsErrFitNoFitParams;
fitSingular : Result := rsErrFitSingular;
fitNoBaseFunctions : Result := rsErrFitNoBaseFunctions;
else
raise EChartError.CreateFmt('[TFitSeries.ErrorMsg] No message text assigned to error code #%d.', [ord(ErrCode)]);
end;
end;
procedure TFitSeries.ExecFit;
var
xmin, xmax: Double;
@ -1723,7 +1739,7 @@ var
// Prepare fit parameters
if not PrepareFitParams then begin
fitRes.ErrCode := fitNoBaseFunctions;
FErrCode := fitNoBaseFunctions;
exit;
end;
@ -1750,7 +1766,10 @@ var
end;
begin
if (State <> fpsUnknown) or not Active then exit;
if (State <> fpsUnknown) or not Active or IsEmpty or
([csLoading, csDestroying] * ComponentState <> [])
then
exit;
FState := fpsInvalid;
try
TryFit;
@ -1994,7 +2013,7 @@ end;
procedure TFitSeries.Loaded;
begin
inherited;
if FAutoFit then ExecFit;
if FAutoFit and (FFitEquation <> feCustom) then ExecFit;
end;
{ FFixedParams contains several items separated by semicolon or bar ('|'). Any
@ -2009,10 +2028,11 @@ end;
.Fixed = true. Variable parameters are stored in the outpust list as
.Value = NaN, and .Fixed = false.
By default, the fit base functions (.Func) are set to a polygon because
By default, the fit base functions (.Func) are set to a polynomial because
all implemented fitting types are of this kind.
However, if handlers are assigned to the event OnGetFitBaseFunc then these
functions are used instead.
In case of custom fitting, the fit base functions become equal to the
functions FCustomFuncs defined separately by the method SetFitBasisFunc().
}
function TFitSeries.PrepareFitParams: Boolean;
var
@ -2027,8 +2047,12 @@ begin
FFitParams[i].Value := NaN;
if FFitEquation <> feCustom then
FFitParams[i].Func := @FitBaseFunc_Poly
else if FFitParams[i].Func = nil then
exit;
else begin
FFitParams[i].Func := FCustomFuncs[i].Func;
FFitParams[i].FuncName := FCustomFuncs[i].FuncName;
if FFitParams[i].Func = nil then
exit;
end;
end;
if FFixedParams <> '' then begin
@ -2091,8 +2115,10 @@ end;
procedure TFitSeries.SetFitBasisFunc(AIndex: TFitFuncIndex; AFitFunc: TFitFunc;
AFitFuncName: String);
begin
FFitParams[AIndex].Func := AFitFunc;
FFitParams[AIndex].FuncName := AFitFuncName; // e.g. 'sin(x)';
if AIndex > High(FCustomFuncs) then
SetLength(FCustomFuncs, AIndex+1);
FCustomFuncs[AIndex].Func := AFitFunc;
FCustomFuncs[AIndex].FuncName := AFitFuncName; // e.g. 'sin(x)';
end;
procedure TFitSeries.SetFitRange(AValue: TChartRange);
@ -2118,6 +2144,7 @@ begin
if AValue <= 0 then
raise EChartError.Create(rsErrIllegalFitParamCount);
SetLength(FFitParams, AValue);
SetLength(FCustomFuncs, AValue);
InvalidateFitResults;
UpdateParentChart;
end;