mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-07 14:12:39 +02:00
1686 lines
44 KiB
ObjectPascal
1686 lines
44 KiB
ObjectPascal
{
|
|
|
|
Function series for TAChart.
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Authors: Alexander Klenin
|
|
|
|
}
|
|
unit TAFuncSeries;
|
|
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Graphics, typ, Types,
|
|
TAChartUtils, TACustomSeries, TACustomSource, TADrawUtils, TALegend, TATypes;
|
|
|
|
const
|
|
DEF_FUNC_STEP = 2;
|
|
DEF_SPLINE_DEGREE = 3;
|
|
DEF_SPLINE_STEP = 4;
|
|
DEF_FIT_STEP = 4;
|
|
DEF_FIT_PARAM_COUNT = 3;
|
|
DEF_COLORMAP_STEP = 4;
|
|
|
|
type
|
|
TFuncCalculateEvent = procedure (const AX: Double; out AY: Double) of object;
|
|
|
|
TFuncSeriesStep = 1..MaxInt;
|
|
|
|
{ TBasicFuncSeries }
|
|
|
|
TBasicFuncSeries = class(TCustomChartSeries)
|
|
strict private
|
|
FExtent: TChartExtent;
|
|
procedure SetExtent(AValue: TChartExtent);
|
|
protected
|
|
procedure AfterAdd; override;
|
|
procedure GetBounds(var ABounds: TDoubleRect); override;
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Active default true;
|
|
property Extent: TChartExtent read FExtent write SetExtent;
|
|
property ShowInLegend;
|
|
property Title;
|
|
property ZPosition;
|
|
end;
|
|
|
|
{ TFuncSeries }
|
|
|
|
TFuncSeries = class(TBasicFuncSeries)
|
|
strict private
|
|
FDomainExclusions: TIntervalList;
|
|
FOnCalculate: TFuncCalculateEvent;
|
|
FPen: TChartPen;
|
|
FStep: TFuncSeriesStep;
|
|
|
|
function DoCalcIdentity(AX: Double): Double;
|
|
function DoCalculate(AX: Double): Double;
|
|
procedure SetOnCalculate(AValue: TFuncCalculateEvent);
|
|
procedure SetPen(AValue: TChartPen);
|
|
procedure SetStep(AValue: TFuncSeriesStep);
|
|
protected
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
function IsEmpty: Boolean; override;
|
|
public
|
|
property DomainExclusions: TIntervalList read FDomainExclusions;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property OnCalculate: TFuncCalculateEvent
|
|
read FOnCalculate write SetOnCalculate;
|
|
property Pen: TChartPen read FPen write SetPen;
|
|
property Step: TFuncSeriesStep
|
|
read FStep write SetStep default DEF_FUNC_STEP;
|
|
end;
|
|
|
|
TSplineDegree = 1..100;
|
|
|
|
{ TBSplineSeries }
|
|
|
|
TBSplineSeries = class(TBasicPointSeries)
|
|
strict private
|
|
FDegree: TSplineDegree;
|
|
FPen: TChartPen;
|
|
FStep: TFuncSeriesStep;
|
|
|
|
procedure SetDegree(AValue: TSplineDegree);
|
|
procedure SetPen(AValue: TChartPen);
|
|
procedure SetStep(AValue: TFuncSeriesStep);
|
|
protected
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
published
|
|
property Active default true;
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property ShowInLegend;
|
|
property Source;
|
|
property Title;
|
|
property ZPosition;
|
|
published
|
|
property Degree: TSplineDegree
|
|
read FDegree write SetDegree default DEF_SPLINE_DEGREE;
|
|
property Pen: TChartPen read FPen write SetPen;
|
|
property Pointer;
|
|
property Step: TFuncSeriesStep
|
|
read FStep write SetStep default DEF_SPLINE_STEP;
|
|
end;
|
|
|
|
TBadDataChartPen = class(TChartPen)
|
|
published
|
|
property Color default clRed;
|
|
end;
|
|
|
|
TCubicSplineOptions = set of (
|
|
csoDrawFewPoints, csoDrawUnorderedX, csoExtrapolateLeft,
|
|
csoExtrapolateRight);
|
|
|
|
{ TCubicSplineSeries }
|
|
|
|
TCubicSplineSeries = class(TBasicPointSeries)
|
|
strict private
|
|
FBadDataPen: TBadDataChartPen;
|
|
FOptions: TCubicSplineOptions;
|
|
FPen: TChartPen;
|
|
FStep: TFuncSeriesStep;
|
|
|
|
procedure SetPen(AValue: TChartPen);
|
|
procedure SetStep(AValue: TFuncSeriesStep);
|
|
strict private
|
|
FUnorderedX: Boolean;
|
|
FX, FY, FCoeff: array of ArbFloat;
|
|
|
|
procedure PrepareCoeffs;
|
|
function PrepareIntervals: TIntervalList;
|
|
procedure SetBadDataPen(AValue: TBadDataChartPen);
|
|
procedure SetOptions(AValue: TCubicSplineOptions);
|
|
protected
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
procedure SourceChanged(ASender: TObject); override;
|
|
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
function Calculate(AX: Double): Double;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function Extent: TDoubleRect; override;
|
|
function GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
published
|
|
property Active default true;
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property Pointer;
|
|
property ShowInLegend;
|
|
property Source;
|
|
property Title;
|
|
property ZPosition;
|
|
published
|
|
// Used when data is not suitable for drawing cubic spline --
|
|
// e.g. points are too few or not ordered by X value.
|
|
property BadDataPen: TBadDataChartPen read FBadDataPen write SetBadDataPen;
|
|
property Options: TCubicSplineOptions
|
|
read FOptions write SetOptions default [];
|
|
property Pen: TChartPen read FPen write SetPen;
|
|
property Step: TFuncSeriesStep
|
|
read FStep write SetStep default DEF_SPLINE_STEP;
|
|
end;
|
|
|
|
TFitEquation = (
|
|
fePolynomial, // y = b0 + b1*x + b2*x^2 + ... bn*x^n
|
|
feLinear, // y = a + b*x
|
|
feExp, // y = a * exp(b * x)
|
|
fePower // y = a * x^b
|
|
);
|
|
|
|
TFitSeries = class(TBasicPointSeries)
|
|
public
|
|
type
|
|
IEquationText = interface
|
|
function Equation(AEquation: TFitEquation): IEquationText;
|
|
function X(AText: String): IEquationText;
|
|
function Y(AText: String): IEquationText;
|
|
function NumFormat(AFormat: String): IEquationText;
|
|
function NumFormats(const AFormats: array of String): IEquationText;
|
|
function Params(const AParams: array of Double): IEquationText;
|
|
function Get: String;
|
|
end;
|
|
|
|
TEquationText = class(TInterfacedObject, IEquationText)
|
|
strict private
|
|
FEquation: TFitEquation;
|
|
FX: String;
|
|
FY: String;
|
|
FNumFormat: String;
|
|
FNumFormats: array of String;
|
|
FParams: array of Double;
|
|
function GetNumFormat(AIndex: Integer): String;
|
|
public
|
|
constructor Create;
|
|
function Equation(AEquation: TFitEquation): IEquationText;
|
|
function X(AText: String): IEquationText;
|
|
function Y(AText: String): IEquationText;
|
|
function NumFormat(AFormat: String): IEquationText;
|
|
function NumFormats(const AFormats: array of String): IEquationText;
|
|
function Params(const AParams: array of Double): IEquationText;
|
|
function Get: String;
|
|
end;
|
|
|
|
strict private
|
|
FDrawFitRangeOnly: Boolean;
|
|
FFitEquation: TFitEquation;
|
|
FFitParams: TDoubleDynArray;
|
|
FFitRange: TChartRange;
|
|
FOnFitComplete: TNotifyEvent;
|
|
FPen: TChartPen;
|
|
FStep: TFuncSeriesStep;
|
|
FValidFitParams: Boolean;
|
|
function GetParam(AIndex: Integer): Double;
|
|
function GetParamCount: Integer;
|
|
function PrepareIntervals: TIntervalList;
|
|
procedure SetDrawFitRangeOnly(AValue: Boolean);
|
|
procedure SetFitEquation(AValue: TFitEquation);
|
|
procedure SetFitRange(AValue: TChartRange);
|
|
procedure SetParam(AIndex: Integer; AValue: Double);
|
|
procedure SetParamCount(AValue: Integer);
|
|
procedure SetPen(AValue: TChartPen);
|
|
procedure SetStep(AValue: TFuncSeriesStep);
|
|
strict protected
|
|
procedure CalcXRange(out AXMin, AXMax: Double);
|
|
procedure Transform(AX, AY: Double; out ANewX, ANewY: Extended);
|
|
protected
|
|
procedure AfterAdd; override;
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
procedure SourceChanged(ASender: TObject); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
public
|
|
function Calculate(AX: Double): Double; virtual;
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
procedure ExecFit; virtual;
|
|
function EquationText: IEquationText;
|
|
function GetFitEquationString(
|
|
ANumFormat: String; AXText: String = 'x'; AYText: String = 'y'): String;
|
|
deprecated 'Use EquationText';
|
|
function GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
property Param[AIndex: Integer]: Double read GetParam write SetParam;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property DrawFitRangeOnly: Boolean
|
|
read FDrawFitRangeOnly write SetDrawFitRangeOnly default true;
|
|
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;
|
|
end;
|
|
|
|
TFuncCalculate3DEvent =
|
|
procedure (const AX, AY: Double; out AZ: Double) of object;
|
|
|
|
{ TColorMapSeries }
|
|
|
|
TColorMapSeries = class(TBasicFuncSeries)
|
|
strict private
|
|
FBrush: TBrush;
|
|
FColorSource: TCustomChartSource;
|
|
FColorSourceListener: TListener;
|
|
FInterpolate: Boolean;
|
|
FOnCalculate: TFuncCalculate3DEvent;
|
|
FStepX: TFuncSeriesStep;
|
|
FStepY: TFuncSeriesStep;
|
|
procedure SetBrush(AValue: TBrush);
|
|
procedure SetColorSource(AValue: TCustomChartSource);
|
|
procedure SetInterpolate(AValue: Boolean);
|
|
procedure SetOnCalculate(AValue: TFuncCalculate3DEvent);
|
|
procedure SetStepX(AValue: TFuncSeriesStep);
|
|
procedure SetStepY(AValue: TFuncSeriesStep);
|
|
protected
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
public
|
|
function ColorByValue(AValue: Double): TColor;
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function IsEmpty: Boolean; override;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property Brush: TBrush read FBrush write SetBrush;
|
|
property ColorSource: TCustomChartSource
|
|
read FColorSource write SetColorSource;
|
|
property Interpolate: Boolean
|
|
read FInterpolate write SetInterpolate default false;
|
|
property OnCalculate: TFuncCalculate3DEvent
|
|
read FOnCalculate write SetOnCalculate;
|
|
property StepX: TFuncSeriesStep
|
|
read FStepX write SetStepX default DEF_COLORMAP_STEP;
|
|
property StepY: TFuncSeriesStep
|
|
read FStepY write SetStepY default DEF_COLORMAP_STEP;
|
|
end;
|
|
|
|
// Builds an equation string based on the parameters and the type of equation.
|
|
// AXText and AYText are placeholders for the x and y variables, respectively.
|
|
// Parameters are formatted by passing ANumFormat to the "Format" function.
|
|
function ParamsToEquation(
|
|
AEquation: TFitEquation; const AParams: array of Double;
|
|
ANumFormat: String; AXText: String = 'x'; AYText: String = 'y'): String;
|
|
deprecated 'Use TFitSeries.IEquationText';
|
|
operator :=(AEq: TFitSeries.IEquationText): String; inline;
|
|
|
|
implementation
|
|
|
|
uses
|
|
ipf, Math, StrUtils, SysUtils, TAGeometry, TAGraph, TAMath;
|
|
|
|
type
|
|
TMakeDoublePoint = function (AX, AY: Double): TDoublePoint;
|
|
|
|
TDrawFuncHelper = class
|
|
strict private
|
|
FAxisToGraphXr, FAxisToGraphYr, FGraphToAxisXr: TTransformFunc;
|
|
FCalc: TTransformFunc;
|
|
FChart: TChart;
|
|
FDomainExclusions: TIntervalList;
|
|
FDrawer: IChartDrawer;
|
|
FExtent: TDoubleRect;
|
|
FGraphStep: Double;
|
|
FMakeDP: TMakeDoublePoint;
|
|
FPrev: TDoublePoint;
|
|
FPrevInExtent: Boolean;
|
|
FSeries: TCustomChartSeries;
|
|
|
|
procedure CalcAt(AXg, AXa: Double; out APt: TDoublePoint; out AIn: Boolean);
|
|
procedure LineTo(AXg, AXa: Double);
|
|
procedure MoveTo(AXg, AXa: Double);
|
|
public
|
|
constructor Create(
|
|
ASeries: TCustomChartSeries; ADomainExclusions:
|
|
TIntervalList; ACalc: TTransformFunc; AStep: Integer);
|
|
procedure DrawFunction(ADrawer: IChartDrawer);
|
|
function GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
end;
|
|
|
|
TFitSeriesRange = class(TChartRange)
|
|
strict private
|
|
FSeries: TFitSeries;
|
|
strict protected
|
|
procedure StyleChanged(ASender: TObject); override;
|
|
public
|
|
constructor Create(ASeries: TFitSeries);
|
|
end;
|
|
|
|
function DoublePointRotated(AX, AY: Double): TDoublePoint;
|
|
begin
|
|
Result.X := AY;
|
|
Result.Y := AX;
|
|
end;
|
|
|
|
function ParamsToEquation(
|
|
AEquation: TFitEquation; const AParams: array of Double;
|
|
ANumFormat, AXText, AYText: String): String;
|
|
begin
|
|
Result :=
|
|
TFitSeries.TEquationText.Create.Equation(AEquation).
|
|
X(AXText).Y(AYText).NumFormat(ANumFormat).Params(AParams);
|
|
end;
|
|
|
|
operator := (AEq: TFitSeries.IEquationText): String;
|
|
begin
|
|
Result := AEq.Get;
|
|
end;
|
|
|
|
{ TFitSeries.TEquationText }
|
|
|
|
constructor TFitSeries.TEquationText.Create;
|
|
begin
|
|
FX := 'x';
|
|
FY := 'y';
|
|
FNumFormat := '%.9g';
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.Equation(
|
|
AEquation: TFitEquation): IEquationText;
|
|
begin
|
|
FEquation := AEquation;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.Get: String;
|
|
var
|
|
ps: String = '';
|
|
i: Integer;
|
|
begin
|
|
if Length(FParams) = 0 then exit('');
|
|
Result := Format('%s = ' + GetNumFormat(0), [FY, FParams[0]]);
|
|
if FEquation in [fePolynomial, feLinear] then
|
|
for i := 1 to High(FParams) do begin
|
|
if FParams[i] = 0 then continue;
|
|
if i > 1 then ps := Format('^%d', [i]);
|
|
Result += Format(
|
|
' %s ' + GetNumFormat(i) + '*%s%s',
|
|
[IfThen(FParams[i] > 0, '+', '-'), Abs(FParams[i]), FX, ps]);
|
|
end
|
|
else if (Length(FParams) >= 2) and (FParams[0] <> 0) and (FParams[1] <> 0) then
|
|
case FEquation of
|
|
feExp:
|
|
Result += Format(' * exp(' + GetNumFormat(1) +' * %s)', [FParams[1], FX]);
|
|
fePower:
|
|
Result += Format(' * %s^' + GetNumFormat(1), [FX, FParams[1]]);
|
|
end;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.GetNumFormat(AIndex: Integer): String;
|
|
begin
|
|
if AIndex < Length(FNumFormats) then
|
|
Result := FNumFormats[AIndex]
|
|
else
|
|
Result := FNumFormat;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.NumFormat(AFormat: String): IEquationText;
|
|
begin
|
|
FNumFormat := AFormat;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.NumFormats(
|
|
const AFormats: array of String): IEquationText;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(FNumFormats, Length(AFormats));
|
|
for i := 0 to High(AFormats) do
|
|
FNumFormats[i] := AFormats[i];
|
|
Result := Self;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.Params(
|
|
const AParams: array of Double): IEquationText;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(FParams, Length(AParams));
|
|
for i := 0 to High(AParams) do
|
|
FParams[i] := AParams[i];
|
|
Result := Self;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.X(AText: String): IEquationText;
|
|
begin
|
|
FX := AText;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TFitSeries.TEquationText.Y(AText: String): IEquationText;
|
|
begin
|
|
FY := AText;
|
|
Result := Self;
|
|
end;
|
|
|
|
{ TFitSeriesRange }
|
|
|
|
constructor TFitSeriesRange.Create(ASeries: TFitSeries);
|
|
begin
|
|
inherited Create(ASeries.ParentChart);
|
|
FSeries := ASeries;
|
|
end;
|
|
|
|
procedure TFitSeriesRange.StyleChanged(ASender: TObject);
|
|
begin
|
|
FSeries.ExecFit;
|
|
inherited;
|
|
end;
|
|
|
|
{ TDrawFuncHelper }
|
|
|
|
procedure TDrawFuncHelper.CalcAt(
|
|
AXg, AXa: Double; out APt: TDoublePoint; out AIn: Boolean);
|
|
begin
|
|
APt := FMakeDP(AXg, FAxisToGraphYr(FCalc(AXa)));
|
|
AIn := (FExtent.a <= APt) and (APt <= FExtent.b);
|
|
end;
|
|
|
|
constructor TDrawFuncHelper.Create(
|
|
ASeries: TCustomChartSeries; ADomainExclusions: TIntervalList;
|
|
ACalc: TTransformFunc; AStep: Integer);
|
|
begin
|
|
FChart := ASeries.ParentChart;
|
|
FExtent := FChart.CurrentExtent;
|
|
FSeries := ASeries;
|
|
FDomainExclusions := ADomainExclusions;
|
|
FCalc := ACalc;
|
|
|
|
with FSeries do
|
|
if IsRotated then begin
|
|
FAxisToGraphXr := @AxisToGraphY;
|
|
FAxisToGraphYr := @AxisToGraphX;
|
|
FGraphToAxisXr := @GraphToAxisY;
|
|
FMakeDP := @DoublePointRotated;
|
|
FGraphStep := FChart.YImageToGraph(-AStep) - FChart.YImageToGraph(0);
|
|
end
|
|
else begin
|
|
FAxisToGraphXr := @AxisToGraphX;
|
|
FAxisToGraphYr := @AxisToGraphY;
|
|
FGraphToAxisXr := @GraphToAxisX;
|
|
FMakeDP := @DoublePoint;
|
|
FGraphStep := FChart.XImageToGraph(AStep) - FChart.XImageToGraph(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TDrawFuncHelper.DrawFunction(ADrawer: IChartDrawer);
|
|
var
|
|
hint: Integer;
|
|
xg, xa, xg1, xa1, xmax: Double;
|
|
begin
|
|
if FGraphStep = 0 then exit;
|
|
|
|
FDrawer := ADrawer;
|
|
with FSeries do
|
|
if IsRotated then begin
|
|
xg := FExtent.a.Y;
|
|
xmax := FExtent.b.Y;
|
|
end
|
|
else begin
|
|
xg := FExtent.a.X;
|
|
xmax := FExtent.b.X;
|
|
end;
|
|
|
|
hint := 0;
|
|
xa := FGraphToAxisXr(xg);
|
|
if FDomainExclusions.Intersect(xa, xa, hint) then
|
|
xg := FAxisToGraphXr(xa);
|
|
|
|
MoveTo(xg, xa);
|
|
|
|
while xg < xmax do begin
|
|
xg1 := xg + FGraphStep;
|
|
xa1 := FGraphToAxisXr(xg1);
|
|
if FDomainExclusions.Intersect(xa, xa1, hint) then begin
|
|
LineTo(FAxisToGraphXr(xa), xa);
|
|
xg1 := FAxisToGraphXr(xa1);
|
|
MoveTo(xg1, xa1);
|
|
end
|
|
else
|
|
LineTo(xg1, xa1);
|
|
xg := xg1;
|
|
xa := xa1;
|
|
end;
|
|
end;
|
|
|
|
function TDrawFuncHelper.GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
|
|
procedure CheckPoint(AXg, AXa: Double);
|
|
var
|
|
inExtent: Boolean;
|
|
gp: TDoublePoint;
|
|
ip: TPoint;
|
|
d: Integer;
|
|
begin
|
|
CalcAt(AXg, AXa, gp, inExtent);
|
|
if not inExtent then exit;
|
|
ip := FChart.GraphToImage(gp);
|
|
d := AParams.FDistFunc(AParams.FPoint, ip);
|
|
if (d >= AResults.FDist) or (d > Sqr(AParams.FRadius)) then exit;
|
|
AResults.FDist := d;
|
|
AResults.FImg := ip;
|
|
AResults.FValue.X := AXa;
|
|
Result := true;
|
|
end;
|
|
|
|
var
|
|
hint: Integer;
|
|
xg, xa, xg1, xa1, xmax: Double;
|
|
begin
|
|
AResults.FIndex := -1;
|
|
AResults.FDist := MaxInt;
|
|
Result := false;
|
|
|
|
with AParams do
|
|
if FSeries.IsRotated then begin
|
|
xg := Max(FExtent.a.Y, FChart.YImageToGraph(FPoint.Y - FRadius));
|
|
xmax := Min(FExtent.b.Y, FChart.YImageToGraph(FPoint.Y + FRadius));
|
|
end
|
|
else begin
|
|
xg := Max(FExtent.a.X, FChart.XImageToGraph(FPoint.X - FRadius));
|
|
xmax := Min(FExtent.b.X, FChart.XImageToGraph(FPoint.X + FRadius));
|
|
end;
|
|
|
|
hint := 0;
|
|
xa := FGraphToAxisXr(xg);
|
|
if FDomainExclusions.Intersect(xa, xa, hint) then
|
|
xg := FAxisToGraphXr(xa);
|
|
|
|
CheckPoint(xg, xa);
|
|
|
|
while xg < xmax do begin
|
|
xg1 := xg + FGraphStep;
|
|
xa1 := FGraphToAxisXr(xg1);
|
|
if FDomainExclusions.Intersect(xa, xa1, hint) then begin
|
|
CheckPoint(FAxisToGraphXr(xa), xa);
|
|
xg1 := FAxisToGraphXr(xa1);
|
|
CheckPoint(xg1, xa1);
|
|
end
|
|
else
|
|
CheckPoint(xg1, xa1);
|
|
xg := xg1;
|
|
xa := xa1;
|
|
end;
|
|
end;
|
|
|
|
procedure TDrawFuncHelper.LineTo(AXg, AXa: Double);
|
|
var
|
|
p, t: TDoublePoint;
|
|
inExtent: Boolean;
|
|
begin
|
|
CalcAt(AXg, AXa, p, inExtent);
|
|
t := p;
|
|
if inExtent and FPrevInExtent then
|
|
FDrawer.LineTo(FChart.GraphToImage(p))
|
|
else if LineIntersectsRect(FPrev, t, FExtent) then begin
|
|
FDrawer.MoveTo(FChart.GraphToImage(FPrev));
|
|
FDrawer.LineTo(FChart.GraphToImage(t));
|
|
end;
|
|
FPrevInExtent := inExtent;
|
|
FPrev := p;
|
|
end;
|
|
|
|
procedure TDrawFuncHelper.MoveTo(AXg, AXa: Double);
|
|
begin
|
|
CalcAt(AXg, AXa, FPrev, FPrevInExtent);
|
|
if FPrevInExtent then
|
|
FDrawer.MoveTo(FChart.GraphToImage(FPrev));
|
|
end;
|
|
|
|
{ TBasicFuncSeries }
|
|
|
|
procedure TBasicFuncSeries.AfterAdd;
|
|
begin
|
|
inherited AfterAdd;
|
|
FExtent.SetOwner(FChart);
|
|
end;
|
|
|
|
procedure TBasicFuncSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TBasicFuncSeries then
|
|
with TBasicFuncSeries(ASource) do
|
|
Self.Extent := FExtent;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
constructor TBasicFuncSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FExtent := TChartExtent.Create(FChart);
|
|
end;
|
|
|
|
destructor TBasicFuncSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FExtent);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBasicFuncSeries.GetBounds(var ABounds: TDoubleRect);
|
|
begin
|
|
with Extent do begin
|
|
if UseXMin then ABounds.a.X := XMin;
|
|
if UseYMin then ABounds.a.Y := YMin;
|
|
if UseXMax then ABounds.b.X := XMax;
|
|
if UseYMax then ABounds.b.Y := YMax;
|
|
end;
|
|
end;
|
|
|
|
procedure TBasicFuncSeries.SetExtent(AValue: TChartExtent);
|
|
begin
|
|
if FExtent = AValue then exit;
|
|
FExtent.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
{ TFuncSeries }
|
|
|
|
procedure TFuncSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TFuncSeries then
|
|
with TFuncSeries(ASource) do begin
|
|
Self.FDomainExclusions.Assign(FDomainExclusions);
|
|
Self.FOnCalculate := FOnCalculate;
|
|
Self.Pen := FPen;
|
|
Self.FStep := FStep;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
constructor TFuncSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDomainExclusions := TIntervalList.Create;
|
|
FDomainExclusions.OnChange := @StyleChanged;
|
|
FPen := TChartPen.Create;
|
|
FPen.OnChange := @StyleChanged;
|
|
FStep := DEF_FUNC_STEP;
|
|
end;
|
|
|
|
destructor TFuncSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FDomainExclusions);
|
|
FreeAndNil(FPen);
|
|
inherited;
|
|
end;
|
|
|
|
function TFuncSeries.DoCalcIdentity(AX: Double): Double;
|
|
begin
|
|
Result := AX;
|
|
end;
|
|
|
|
function TFuncSeries.DoCalculate(AX: Double): Double;
|
|
begin
|
|
OnCalculate(AX, Result)
|
|
end;
|
|
|
|
procedure TFuncSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
calc: TTransformFunc;
|
|
begin
|
|
if Assigned(OnCalculate) then
|
|
calc := @DoCalculate
|
|
else if csDesigning in ComponentState then
|
|
calc := @DoCalcIdentity
|
|
else
|
|
exit;
|
|
ADrawer.Pen := Pen;
|
|
with TDrawFuncHelper.Create(Self, DomainExclusions, calc, Step) do
|
|
try
|
|
DrawFunction(ADrawer);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFuncSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemLine.Create(Pen, LegendTextSingle));
|
|
end;
|
|
|
|
function TFuncSeries.GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
begin
|
|
Result := false;
|
|
AResults.FIndex := -1;
|
|
if not Assigned(OnCalculate) then exit;
|
|
|
|
with TDrawFuncHelper.Create(Self, DomainExclusions, @DoCalculate, Step) do
|
|
try
|
|
Result := GetNearestPoint(AParams, AResults);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function TFuncSeries.IsEmpty: Boolean;
|
|
begin
|
|
Result := not Assigned(OnCalculate);
|
|
end;
|
|
|
|
procedure TFuncSeries.SetOnCalculate(AValue: TFuncCalculateEvent);
|
|
begin
|
|
if TMethod(FOnCalculate) = TMethod(AValue) then exit;
|
|
FOnCalculate := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFuncSeries.SetPen(AValue: TChartPen);
|
|
begin
|
|
if FPen = AValue then exit;
|
|
FPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFuncSeries.SetStep(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStep = AValue then exit;
|
|
FStep := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
{ TBSplineSeries }
|
|
|
|
procedure TBSplineSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TBSplineSeries then
|
|
with TBSplineSeries(ASource) do begin
|
|
Self.FDegree := FDegree;
|
|
Self.Pen := FPen;
|
|
Self.FStep := FStep;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
constructor TBSplineSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDegree := DEF_SPLINE_DEGREE;
|
|
FPen := TChartPen.Create;
|
|
FPen.OnChange := @StyleChanged;
|
|
FPointer := TSeriesPointer.Create(ParentChart);
|
|
FStep := DEF_SPLINE_STEP;
|
|
end;
|
|
|
|
destructor TBSplineSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FPen);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TBSplineSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
p: array of TDoublePoint;
|
|
startIndex: Integer;
|
|
|
|
function SplinePoint(APos: Double): TPoint;
|
|
var
|
|
i, d: Integer;
|
|
w, denom: Double;
|
|
begin
|
|
// Duplicate end points Degree times to fix spline to them.
|
|
for i := 0 to Degree do
|
|
p[i] := FGraphPoints[
|
|
EnsureRange(startIndex - Degree + i, 0, High(FGraphPoints))];
|
|
// De Boor's algorithm, source points used as control points.
|
|
// Parametric coordinate is equal to point index.
|
|
for d := 1 to Degree do begin
|
|
denom := 1 / (Degree + 1 - d);
|
|
for i := Degree downto d do begin
|
|
w := (APos + Degree - i) * denom;
|
|
p[i].X := WeightedAverage(p[i - 1].X, p[i].X, w);
|
|
p[i].Y := WeightedAverage(p[i - 1].Y, p[i].Y, w);
|
|
end;
|
|
end;
|
|
Result := ParentChart.GraphToImage(p[Degree]);
|
|
end;
|
|
|
|
var
|
|
level: Integer = 0;
|
|
|
|
// Pass screen coordinates down to calculate them only once for each point.
|
|
procedure SplineSegment(AL, AR: Double; const APL, APR: TPoint);
|
|
const
|
|
INF_SENTINEL = 15; // Arbitrary guard against infinite recursion.
|
|
var
|
|
m: Double;
|
|
pm: TPoint;
|
|
begin
|
|
if (level > INF_SENTINEL) or (PointDist(APL, APR) <= Sqr(Step)) then
|
|
// Left-then-right recursive call order guarantees that
|
|
// the last drawn segment is the immediately preceding one.
|
|
ADrawer.LineTo(APR)
|
|
else begin
|
|
m := (AL + AR) / 2;
|
|
pm := SplinePoint(m);
|
|
level += 1;
|
|
SplineSegment(AL, m, APL, pm);
|
|
SplineSegment(m, AR, pm, APR);
|
|
level -= 1;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ext: TDoubleRect;
|
|
begin
|
|
if IsEmpty then exit;
|
|
|
|
with Extent do begin
|
|
ext.a := AxisToGraph(a);
|
|
ext.b := AxisToGraph(b);
|
|
end;
|
|
NormalizeRect(ext);
|
|
ExpandRange(ext.a.X, ext.b.X, 1.0);
|
|
ExpandRange(ext.a.Y, ext.b.Y, 1.0);
|
|
PrepareGraphPoints(ext, true);
|
|
|
|
SetLength(p, Degree + 1);
|
|
ADrawer.Pen := Pen;
|
|
ADrawer.MoveTo(ParentChart.GraphToImage(FGraphPoints[0]));
|
|
for startIndex := 0 to High(FGraphPoints) + Degree - 1 do
|
|
SplineSegment(0.0, 1.0, SplinePoint(0.0), SplinePoint(1.0));
|
|
DrawLabels(ADrawer);
|
|
DrawPointers(ADrawer);
|
|
end;
|
|
|
|
procedure TBSplineSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemLine.Create(Pen, LegendTextSingle));
|
|
end;
|
|
|
|
procedure TBSplineSeries.SetDegree(AValue: TSplineDegree);
|
|
begin
|
|
if FDegree = AValue then exit;
|
|
FDegree := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBSplineSeries.SetPen(AValue: TChartPen);
|
|
begin
|
|
if FPen = AValue then exit;
|
|
FPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBSplineSeries.SetStep(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStep = AValue then exit;
|
|
FStep := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
{ TCubicSplineSeries }
|
|
|
|
procedure TCubicSplineSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TCubicSplineSeries then
|
|
with TCubicSplineSeries(ASource) do begin
|
|
Self.Pen := FPen;
|
|
Self.FStep := FStep;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
function TCubicSplineSeries.Calculate(AX: Double): Double;
|
|
var
|
|
ok: Integer = 0;
|
|
begin
|
|
Result := ipfspn(High(FCoeff), FX[0], FY[0], FCoeff[0], AX, ok);
|
|
if ok > 1 then
|
|
Result := SafeNaN;
|
|
end;
|
|
|
|
constructor TCubicSplineSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBadDataPen := TBadDataChartPen.Create;
|
|
FBadDataPen.OnChange := @StyleChanged;
|
|
FPen := TChartPen.Create;
|
|
FPen.OnChange := @StyleChanged;
|
|
FPointer := TSeriesPointer.Create(ParentChart);
|
|
FStep := DEF_SPLINE_STEP;
|
|
FUseReticule := true;
|
|
end;
|
|
|
|
destructor TCubicSplineSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FBadDataPen);
|
|
FreeAndNil(FPen);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.Draw(ADrawer: IChartDrawer);
|
|
|
|
function DrawFewPoints: Boolean;
|
|
const
|
|
MIN_SPLINE_POINTS = 4;
|
|
var
|
|
pts: TPointArray;
|
|
i: Integer;
|
|
begin
|
|
Result := Length(FX) < MIN_SPLINE_POINTS;
|
|
if
|
|
not Result or not (csoDrawFewPoints in Options) or not BadDataPen.Visible
|
|
then
|
|
exit;
|
|
SetLength(pts, Length(FGraphPoints));
|
|
for i := 0 to High(FGraphPoints) do
|
|
pts[i] := ParentChart.GraphToImage(FGraphPoints[i]);
|
|
ADrawer.Pen := BadDataPen;
|
|
ADrawer.Polyline(pts, 0, Length(pts));
|
|
end;
|
|
|
|
procedure DrawSpline;
|
|
var
|
|
de: TIntervalList;
|
|
p: TChartPen;
|
|
begin
|
|
if FCoeff = nil then exit;
|
|
if FUnorderedX then begin
|
|
if csoDrawUnorderedX in Options then
|
|
p := BadDataPen
|
|
else
|
|
exit;
|
|
end
|
|
else
|
|
p := Pen;
|
|
if not p.Visible then exit;
|
|
ADrawer.Pen := p;
|
|
de := PrepareIntervals;
|
|
try
|
|
with TDrawFuncHelper.Create(Self, de, @Calculate, Step) do
|
|
try
|
|
DrawFunction(ADrawer);
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
de.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if IsEmpty then exit;
|
|
if FCoeff = nil then
|
|
PrepareCoeffs;
|
|
|
|
PrepareGraphPoints(FChart.CurrentExtent, true);
|
|
if not DrawFewPoints then
|
|
DrawSpline;
|
|
|
|
DrawLabels(ADrawer);
|
|
DrawPointers(ADrawer);
|
|
end;
|
|
|
|
function TCubicSplineSeries.Extent: TDoubleRect;
|
|
var
|
|
r: Integer = 0;
|
|
minv, maxv: ArbFloat;
|
|
begin
|
|
Result := inherited Extent;
|
|
if FCoeff = nil then
|
|
PrepareCoeffs;
|
|
if FCoeff = nil then exit;
|
|
minv := Result.a.Y;
|
|
maxv := Result.b.Y;
|
|
ipfsmm(High(FCoeff), FX[0], FY[0], FCoeff[0], minv, maxv, r);
|
|
Result.a.Y := minv;
|
|
Result.b.Y := maxv;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemLine.Create(Pen, LegendTextSingle));
|
|
end;
|
|
|
|
function TCubicSplineSeries.GetNearestPoint(
|
|
const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
de: TIntervalList;
|
|
begin
|
|
if FUnorderedX and not (csoDrawUnorderedX in Options) then
|
|
exit(false);
|
|
de := PrepareIntervals;
|
|
try
|
|
with TDrawFuncHelper.Create(Self, de, @Calculate, Step) do
|
|
try
|
|
Result := GetNearestPoint(AParams, AResults);
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
de.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.PrepareCoeffs;
|
|
var
|
|
i, n: Integer;
|
|
begin
|
|
n := Source.Count;
|
|
SetLength(FX, n);
|
|
SetLength(FY, n);
|
|
SetLength(FCoeff, n);
|
|
FUnorderedX := false;
|
|
n := 0;
|
|
for i := 0 to Source.Count - 1 do
|
|
with Source[i]^ do
|
|
if (i > 0) and (FX[n - 1] >= X) then
|
|
FUnorderedX := true
|
|
else begin
|
|
FX[n] := X;
|
|
FY[n] := Y;
|
|
n += 1;
|
|
end;
|
|
SetLength(FX, n);
|
|
SetLength(FY, n);
|
|
SetLength(FCoeff, n);
|
|
ipfisn(n - 1, FX[0], FY[0], FCoeff[0], i);
|
|
if i > 1 then
|
|
FCoeff := nil;
|
|
end;
|
|
|
|
function TCubicSplineSeries.PrepareIntervals: TIntervalList;
|
|
begin
|
|
Result := TIntervalList.Create;
|
|
try
|
|
if not (csoExtrapolateLeft in Options) then
|
|
Result.AddRange(NegInfinity, FX[0]);
|
|
if not (csoExtrapolateRight in Options) then
|
|
Result.AddRange(FX[High(FX)], SafeInfinity);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.SetBadDataPen(AValue: TBadDataChartPen);
|
|
begin
|
|
if FBadDataPen = AValue then exit;
|
|
FBadDataPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.SetOptions(AValue: TCubicSplineOptions);
|
|
begin
|
|
if FOptions = AValue then exit;
|
|
FOptions := AValue;
|
|
FCoeff := nil;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.SetPen(AValue: TChartPen);
|
|
begin
|
|
if FPen = AValue then exit;
|
|
FPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.SetStep(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStep = AValue then exit;
|
|
FStep := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TCubicSplineSeries.SourceChanged(ASender: TObject);
|
|
begin
|
|
inherited SourceChanged(ASender);
|
|
FCoeff := nil;
|
|
end;
|
|
|
|
{ TFitSeries }
|
|
|
|
procedure TFitSeries.AfterAdd;
|
|
begin
|
|
inherited AfterAdd;
|
|
FFitRange.SetOwner(ParentChart);
|
|
end;
|
|
|
|
function TFitSeries.Calculate(AX: Double): Double;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if IsInfinite(AX) then exit(AX);
|
|
Result := SafeNaN;
|
|
if IsNaN(AX) or not FValidFitParams then exit;
|
|
|
|
case FFitEquation of
|
|
fePolynomial, feLinear:
|
|
begin
|
|
Result := 0;
|
|
for i := High(FFitParams) downto 0 do
|
|
Result := Result * AX + FFitParams[i];
|
|
end;
|
|
feExp:
|
|
Result := FFitParams[0] * Exp(FFitParams[1] * AX);
|
|
fePower:
|
|
if AX < 0 then
|
|
Result := SafeNaN
|
|
else
|
|
Result := FFitParams[0] * Power(AX, FFitParams[1]);
|
|
end;
|
|
end;
|
|
|
|
procedure TFitSeries.CalcXRange(out AXMin, AXMax: Double);
|
|
var
|
|
ext: TDoubleRect;
|
|
begin
|
|
with Extent do begin
|
|
ext.a := AxisToGraph(a);
|
|
ext.b := AxisToGraph(b);
|
|
end;
|
|
NormalizeRect(ext);
|
|
AXMin := GraphToAxisX(ext.a.X);
|
|
AXMax := GraphToAxisX(ext.b.X);
|
|
EnsureOrder(AXMin, AXMax);
|
|
FFitRange.Intersect(AXMin, AXMax);
|
|
end;
|
|
|
|
constructor TFitSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FFitEquation := fePolynomial;
|
|
FFitRange := TFitSeriesRange.Create(Self);
|
|
FDrawFitRangeOnly := true;
|
|
FPen := TChartPen.Create;
|
|
FPen.OnChange := @StyleChanged;
|
|
FStep := DEF_FIT_STEP;
|
|
ParamCount := DEF_FIT_PARAM_COUNT; // Parabolic fit as default.
|
|
end;
|
|
|
|
destructor TFitSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FPen);
|
|
FreeAndNil(FFitRange);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TFitSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
de : TIntervalList;
|
|
begin
|
|
if IsEmpty or not FValidFitParams then exit;
|
|
ADrawer.Pen := Pen;
|
|
de := PrepareIntervals;
|
|
try
|
|
with TDrawFuncHelper.Create(Self, de, @Calculate, Step) do
|
|
try
|
|
DrawFunction(ADrawer);
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
de.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFitSeries.EquationText: IEquationText;
|
|
begin
|
|
Result := TEquationText.Create.Equation(FitEquation).Params(FFitParams);
|
|
end;
|
|
|
|
procedure TFitSeries.ExecFit;
|
|
var
|
|
i, j, term, ns, np, n: Integer;
|
|
xmin, xmax: Double;
|
|
xv, yv, fp: array of ArbFloat;
|
|
|
|
function IsValidPoint(AX, AY: Double): Boolean; inline;
|
|
begin
|
|
Result := not IsNaN(AX) and not IsNaN(AY) and InRange(AX, xmin, xmax);
|
|
end;
|
|
|
|
begin
|
|
FValidFitParams := false;
|
|
|
|
np := ParamCount;
|
|
ns := Source.Count;
|
|
if (np <= 0) or (ns = 0) or (ns < np) then exit;
|
|
CalcXRange(xmin, xmax);
|
|
|
|
n := 0;
|
|
for i := 0 to ns - 1 do
|
|
with Source.Item[i]^ do
|
|
n += Ord(IsValidPoint(X, Y));
|
|
if n < np then exit;
|
|
|
|
// Copy data in fit range to temporary arrays.
|
|
SetLength(xv, n);
|
|
SetLength(yv, n);
|
|
j := 0;
|
|
for i := 0 to ns - 1 do
|
|
with Source.Item[i]^ do
|
|
if IsValidPoint(X, Y) then begin
|
|
Transform(X, Y, xv[j], yv[j]);
|
|
j += 1;
|
|
end;
|
|
|
|
// Execute the polynomial fit; the degree of the polynomial is np - 1.
|
|
SetLength(fp, np);
|
|
term := 0;
|
|
ipfpol(n, np - 1, xv[0], yv[0], fp[0], term);
|
|
if term <> 1 then exit;
|
|
for i := 0 to High(FFitParams) do
|
|
FFitParams[i] := fp[i];
|
|
|
|
// 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.
|
|
if FFitEquation in [feExp, fePower] then
|
|
FFitParams[0] := Exp(FFitParams[0]);
|
|
FValidFitParams := true;
|
|
if Assigned(FOnFitComplete) then
|
|
FOnFitComplete(Self);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
function TFitSeries.GetFitEquationString(ANumFormat: String; AXText: String;
|
|
AYText: String): String;
|
|
begin
|
|
Result := EquationText.NumFormat(ANumFormat).X(AXText).Y(AYText);
|
|
end;
|
|
|
|
procedure TFitSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
var
|
|
t: String;
|
|
begin
|
|
if Legend.Format = '' then
|
|
t := Title
|
|
else
|
|
t := Format(Legend.Format, [Title, Index, EquationText.NumFormat('%f').Get]);
|
|
AItems.Add(TLegendItemLine.Create(Pen, t));
|
|
end;
|
|
|
|
function TFitSeries.GetNearestPoint(
|
|
const AParams: TNearestPointParams; out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
de : TIntervalList;
|
|
begin
|
|
Result := false;
|
|
AResults.FIndex := -1;
|
|
de := PrepareIntervals;
|
|
try
|
|
with TDrawFuncHelper.Create(Self, de, @Calculate, Step) do
|
|
try
|
|
Result := GetNearestPoint(AParams, AResults);
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
de.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFitSeries.GetParam(AIndex: Integer): Double;
|
|
begin
|
|
if not InRange(AIndex, 0, ParamCount - 1) then
|
|
raise EChartError.Create('TFitSeries.GetParam index out of range');
|
|
Result := FFitParams[AIndex]
|
|
end;
|
|
|
|
function TFitSeries.GetParamCount: Integer;
|
|
begin
|
|
Result := Length(FFitParams);
|
|
end;
|
|
|
|
function TFitSeries.PrepareIntervals: TIntervalList;
|
|
var
|
|
xmin, xmax: Double;
|
|
begin
|
|
Result := TIntervalList.Create;
|
|
try
|
|
CalcXRange(xmin, xmax);
|
|
if DrawFitRangeOnly then begin
|
|
Result.AddRange(NegInfinity, xmin);
|
|
Result.AddRange(xmax, SafeInfinity);
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TFitSeries.SetDrawFitRangeOnly(AValue: Boolean);
|
|
begin
|
|
if FDrawFitRangeOnly = AValue then exit;
|
|
FDrawFitRangeOnly := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFitSeries.SetFitEquation(AValue: TFitEquation);
|
|
begin
|
|
if FFitEquation = AValue then exit;
|
|
FFitEquation := AValue;
|
|
SetLength(
|
|
FFitParams, IfThen(FFitEquation = fePolynomial, DEF_FIT_PARAM_COUNT, 2));
|
|
ExecFit;
|
|
end;
|
|
|
|
procedure TFitSeries.SetFitRange(AValue: TChartRange);
|
|
begin
|
|
if FFitRange = AValue then exit;
|
|
FFitRange := AValue;
|
|
ExecFit;
|
|
end;
|
|
|
|
procedure TFitSeries.SetParam(AIndex: Integer; AValue: Double);
|
|
begin
|
|
if not InRange(AIndex, 0, ParamCount - 1) then
|
|
raise EChartError.Create('TFitSeries.SetParam index out of range');
|
|
FFitParams[AIndex] := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFitSeries.SetParamCount(AValue: Integer);
|
|
begin
|
|
if (AValue = ParamCount) or (FFitEquation <> fePolynomial) then exit;
|
|
SetLength(FFitParams, AValue);
|
|
ExecFit;
|
|
end;
|
|
|
|
procedure TFitSeries.SetPen(AValue: TChartPen);
|
|
begin
|
|
if FPen = AValue then exit;
|
|
FPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFitSeries.SetStep(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStep = AValue then exit;
|
|
FStep := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFitSeries.SourceChanged(ASender: TObject);
|
|
begin
|
|
inherited;
|
|
ExecFit;
|
|
end;
|
|
|
|
procedure TFitSeries.Transform(AX, AY: Double; out ANewX, ANewY: Extended);
|
|
begin
|
|
// The exponential and power fitting equations can be transformed to a
|
|
// polynomial by taking the logarithm:
|
|
// feExp: y = a exp(b*x) ==> ln(y) = ln(a) + b*x
|
|
// fePower: y = a*x^b ==> ln(y) = ln(a) + b*ln(x)
|
|
// In each case, the first parameter (a) needs to be transformed back
|
|
// after the fitting -- see "ExecFit".
|
|
if FitEquation in [fePower] then
|
|
ANewX := Ln(AX)
|
|
else
|
|
ANewX := AX;
|
|
if FitEquation in [feExp, fePower] then
|
|
ANewY := Ln(AY)
|
|
else
|
|
ANewY := AY;
|
|
end;
|
|
|
|
{ TColorMapSeries }
|
|
|
|
procedure TColorMapSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TColorMapSeries then
|
|
with TColorMapSeries(ASource) do begin
|
|
Self.Brush := FBrush;
|
|
Self.ColorSource := FColorSource;
|
|
Self.FInterpolate := FInterpolate;
|
|
Self.FOnCalculate := FOnCalculate;
|
|
Self.FStepX := FStepX;
|
|
Self.FStepY := FStepY;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
function TColorMapSeries.ColorByValue(AValue: Double): TColor;
|
|
var
|
|
lb, ub: Integer;
|
|
c1, c2: TColor;
|
|
v1, v2: Double;
|
|
begin
|
|
if ColorSource = nil then exit(clTAColor);
|
|
ColorSource.FindBounds(AValue, SafeInfinity, lb, ub);
|
|
if Interpolate and InRange(lb, 1, ColorSource.Count - 1) then begin
|
|
with ColorSource[lb - 1]^ do begin
|
|
v1 := X;
|
|
c1 := Color;
|
|
end;
|
|
with ColorSource[lb]^ do begin
|
|
v2 := X;
|
|
c2 := Color;
|
|
end;
|
|
if v2 <= v1 then
|
|
Result := c1
|
|
else
|
|
Result := InterpolateRGB(c1, c2, (AValue - v1) / (v2 - v1));
|
|
end
|
|
else
|
|
Result := ColorSource[EnsureRange(lb, 0, ColorSource.Count - 1)]^.Color;
|
|
end;
|
|
|
|
constructor TColorMapSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FColorSourceListener := TListener.Create(@FColorSource, @StyleChanged);
|
|
FBrush := TBrush.Create;
|
|
FBrush.OnChange := @StyleChanged;
|
|
FStepX := DEF_COLORMAP_STEP;
|
|
FStepY := DEF_COLORMAP_STEP;
|
|
end;
|
|
|
|
destructor TColorMapSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FColorSourceListener);
|
|
FreeAndNil(FBrush);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TColorMapSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
ext: TDoubleRect;
|
|
bounds: TDoubleRect;
|
|
r: TRect;
|
|
pt, next, offset: TPoint;
|
|
gp: TDoublePoint;
|
|
v: Double;
|
|
begin
|
|
if not (csDesigning in ComponentState) and IsEmpty then exit;
|
|
|
|
ext := ParentChart.CurrentExtent;
|
|
bounds := EmptyExtent;
|
|
GetBounds(bounds);
|
|
bounds.a := AxisToGraph(bounds.a);
|
|
bounds.b := AxisToGraph(bounds.b);
|
|
if not RectIntersectsRect(ext, bounds) then exit;
|
|
|
|
r.TopLeft := ParentChart.GraphToImage(ext.a);
|
|
r.BottomRight := ParentChart.GraphToImage(ext.b);
|
|
NormalizeRect(r);
|
|
offset := ParentChart.GraphToImage(ZeroDoublePoint);
|
|
|
|
ADrawer.Brush := Brush;
|
|
ADrawer.SetPenParams(psClear, clTAColor);
|
|
pt.Y := (r.Top div StepY - 1) * StepY + offset.Y mod StepY;
|
|
while pt.Y <= r.Bottom do begin
|
|
next.Y := pt.Y + StepY;
|
|
if next.Y <= r.Top then begin
|
|
pt.Y := next.Y;
|
|
continue;
|
|
end;
|
|
pt.X := (r.Left div StepX - 1) * StepX + offset.X mod StepX;
|
|
while pt.X <= r.Right do begin
|
|
next.X := pt.X + StepX;
|
|
if next.X <= r.Left then begin
|
|
pt.X := next.X;
|
|
continue;
|
|
end;
|
|
gp := GraphToAxis(ParentChart.ImageToGraph((pt + next) div 2));
|
|
if not (csDesigning in ComponentState) then
|
|
OnCalculate(gp.X, gp.Y, v);
|
|
if ColorSource <> nil then
|
|
ADrawer.BrushColor := ColorByValue(v);
|
|
ADrawer.Rectangle(
|
|
Max(pt.X, r.Left), Max(pt.Y, r.Top),
|
|
Min(next.X, r.Right) + 1, Min(next.Y, r.Bottom) + 1);
|
|
pt.X := next.X;
|
|
end;
|
|
pt.Y := next.Y;
|
|
end;
|
|
end;
|
|
|
|
procedure TColorMapSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
var
|
|
i: Integer;
|
|
prev: Double;
|
|
|
|
function ItemTitle(const AText: String; AX: Double): String;
|
|
const
|
|
FORMATS: array [1..3] of String = ('z ≤ %1:g', '%g < z ≤ %g', '%g < z');
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
if AText <> '' then exit(AText);
|
|
if ColorSource.Count = 1 then exit('');
|
|
if i = 0 then idx := 1
|
|
else if i = ColorSource.Count - 1 then idx := 3
|
|
else idx := 2;
|
|
Result := Format(FORMATS[idx], [prev, AX]);
|
|
end;
|
|
|
|
var
|
|
li: TLegendItemBrushRect;
|
|
begin
|
|
case Legend.Multiplicity of
|
|
lmSingle: AItems.Add(TLegendItemBrushRect.Create(Brush, LegendTextSingle));
|
|
lmPoint:
|
|
if ColorSource <> nil then begin
|
|
prev := 0.0;
|
|
for i := 0 to ColorSource.Count - 1 do
|
|
with ColorSource[i]^ do begin
|
|
li := TLegendItemBrushRect.Create(Brush, ItemTitle(Text, X));
|
|
li.Color := Color;
|
|
AItems.Add(li);
|
|
prev := X;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TColorMapSeries.IsEmpty: Boolean;
|
|
begin
|
|
Result := not Assigned(OnCalculate);
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetBrush(AValue: TBrush);
|
|
begin
|
|
if FBrush = AValue then exit;
|
|
FBrush := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetColorSource(AValue: TCustomChartSource);
|
|
begin
|
|
if FColorSource = AValue then exit;
|
|
if FColorSourceListener.IsListening then
|
|
ColorSource.Broadcaster.Unsubscribe(FColorSourceListener);
|
|
FColorSource := AValue;
|
|
if ColorSource <> nil then
|
|
ColorSource.Broadcaster.Subscribe(FColorSourceListener);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetInterpolate(AValue: Boolean);
|
|
begin
|
|
if FInterpolate = AValue then exit;
|
|
FInterpolate := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetOnCalculate(AValue: TFuncCalculate3DEvent);
|
|
begin
|
|
if TMethod(FOnCalculate) = TMethod(AValue) then exit;
|
|
FOnCalculate := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetStepX(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStepX = AValue then exit;
|
|
FStepX := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TColorMapSeries.SetStepY(AValue: TFuncSeriesStep);
|
|
begin
|
|
if FStepY = AValue then exit;
|
|
FStepY := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
initialization
|
|
RegisterSeriesClass(TFuncSeries, 'Function series');
|
|
RegisterSeriesClass(TBSplineSeries, 'B-Spline series');
|
|
RegisterSeriesClass(TCubicSplineSeries, 'Cubic spline series');
|
|
RegisterSeriesClass(TFitSeries, 'Least-squares fit series');
|
|
RegisterSeriesClass(TColorMapSeries, 'Color map series');
|
|
|
|
end.
|
|
|