curvfitt.pas

BCB第三方组件

{**************************************************}
{   TCurveFittingFunction                          }
{   TTrendFunction                                 }
{   Copyright (c) 1995-2007 by David Berneda       }
{**************************************************}
unit CurvFitt;
{$I TeeDefs.inc}

interface

{ TCustomFittingFunction derives from standard TTeeFunction.

  TCurveFittingFunction and TTrendFunction both derive from
  TCustomFittingFunction.

  Based on a Polynomial degree value (# of polynomy items), a curve
  fitting is calculated for each X,Y pair value to determine the new
  Y position for each source X value.
}

Uses
  Classes,
  TeePoly, StatChar, TeEngine;

Type
  TTypeFitting=( cfPolynomial );

  TCustomFittingFunction=class(TTeeFunction)
  private
    FFactor         : Integer;
    FFirstPoint     : Integer;
    FFirstCalcPoint : Integer;
    FLastPoint      : Integer;
    FLastCalcPoint  : Integer;
    FPolyDegree     : Integer; { <-- between 1 and 20 }
    FTypeFitting    : TTypeFitting;

    { internal }
    IAnswerVector   : TDegreeVector;
    IMinYValue      : Double;

    Procedure SetFactor(const Value:Integer);
    Procedure SetFirstCalcPoint(Value:Integer);
    Procedure SetFirstPoint(Value:Integer);
    Procedure SetIntegerProperty(Var Variable:Integer; Value:Integer);
    Procedure SetLastCalcPoint(Value:Integer);
    Procedure SetLastPoint(Value:Integer);
    Procedure SetPolyDegree(Value:Integer);
    Procedure SetTypeFitting(Value:TTypeFitting);
  protected
    Function GetAnswerVector(Index:Integer):Double;
    procedure AddFittedPoints(Source:TChartSeries); virtual;
    property Factor:Integer read FFactor write SetFactor;
  public
    Constructor Create(AOwner: TComponent); override;

    procedure AddPoints(Source:TChartSeries); override;
    Function GetCurveYValue(Source:TChartSeries; Const X:Double):Double;

    // properties
    property AnswerVector[Index:Integer]:Double read GetAnswerVector;
    property FirstCalcPoint:Integer read FFirstCalcPoint write SetFirstCalcPoint default -1;
    property FirstPoint:Integer read FFirstPoint write SetFirstPoint default -1;
    property LastCalcPoint:Integer read FLastCalcPoint write SetLastCalcPoint default -1;
    property LastPoint:Integer read FLastPoint write SetLastPoint default -1;
    property PolyDegree:Integer read FPolyDegree write SetPolyDegree default 5;
    property TypeFitting:TTypeFitting read FTypeFitting write SetTypeFitting default cfPolynomial;
  end;

  TCurveFittingFunction=class(TCustomFittingFunction)
  protected
    class function GetEditorClass: String; override;
  published
    property Factor default 1;
    property FirstCalcPoint;
    property FirstPoint;
    property LastCalcPoint;
    property LastPoint;
    property PolyDegree;
    property TypeFitting;
  end;

  TTrendStyle=(tsNormal,tsLogarithmic,tsExponential);

  TCustomTrendFunction=class(TTeeFunction)
  private
    IStyle : TTrendStyle;
    ICount : Integer;
    SumX   : Double;
    SumXY  : Double;
    SumY   : Double;
    SumX2  : Double;
    SumY2  : Double;

    function CalculateValues(Source:TChartSeries; FirstIndex,LastIndex:Integer):Boolean;
  protected
    Procedure CalculatePeriod( Source:TChartSeries;
                               Const tmpX:Double;
                               FirstIndex,LastIndex:Integer); override;
    Procedure CalculateAllPoints( Source:TChartSeries;
                                  NotMandatorySource:TChartValueList); override;
  public
    Constructor Create(AOwner: TComponent); override;

    Function Calculate(SourceSeries:TChartSeries; First,Last:Integer):Double; override;
    Function CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;  override;
    Function CalculateTrend( Var m,b:Double; Source:TChartSeries;
                             FirstIndex,LastIndex:Integer):Boolean; // 6.02
    Function Coefficient(Source:TChartSeries; FirstIndex,LastIndex:Integer):Double;
  end;

  TTrendFunction=class(TCustomTrendFunction);

  TExpTrendFunction=class(TCustomTrendFunction)
  public
    Constructor Create(AOwner: TComponent); override;
  end;

  TCorrelationFunction=class(TCustomTrendFunction)
  protected
    Procedure CalculatePeriod( Source:TChartSeries;
                               Const tmpX:Double;
                               FirstIndex,LastIndex:Integer); override;
  public
    Function Calculate(SourceSeries:TChartSeries; First,Last:Integer):Double; override;
    Function CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;  override;
  end;

implementation

Uses
  Math, SysUtils, TeeProCo, Chart, TeeProcs, TeeConst, TeCanvas;

{ TCurveFittingFunction }
Constructor TCustomFittingFunction.Create(AOwner: TComponent);
Begin
  inherited;
  CanUsePeriod:=False;
  InternalSetPeriod(1);

  SingleSource:=True;

  FPolyDegree:=5;
  FTypeFitting:=cfPolynomial;
  FFirstPoint:=-1;
  FLastPoint:=-1;
  FFirstCalcPoint:=-1;
  FLastCalcPoint:=-1;
  FFactor:=1;
end;

Procedure TCustomFittingFunction.SetIntegerProperty(Var Variable:Integer; Value:Integer);
Begin
  if Variable<>Value then
  Begin
    Variable:=Value;
    Recalculate;
  end;
end;

Procedure TCustomFittingFunction.SetFirstPoint(Value:Integer);
Begin
  SetIntegerProperty(FFirstPoint,Value);
End;

Procedure TCustomFittingFunction.SetLastPoint(Value:Integer);
Begin
  SetIntegerProperty(FLastPoint,Value);
End;

Procedure TCustomFittingFunction.SetFactor(const Value:Integer);
begin
  SetIntegerProperty(FFactor,Math.Max(1,Value));
end;

Procedure TCustomFittingFunction.SetFirstCalcPoint(Value:Integer);
Begin
  SetIntegerProperty(FFirstCalcPoint,Value);
End;

Procedure TCustomFittingFunction.SetLastCalcPoint(Value:Integer);
Begin
  SetIntegerProperty(FLastCalcPoint,Value);
End;

Procedure TCustomFittingFunction.SetTypeFitting(Value:TTypeFitting);
Begin
  if FTypeFitting<>Value then
  Begin
    FTypeFitting:=Value;
    Recalculate;
  end;
end;

Procedure TCustomFittingFunction.SetPolyDegree(Value:Integer);
Begin
  if FPolyDegree<>Value then
  begin
    if (Value<1) or (Value>20) then
       Raise Exception.Create(TeeMsg_PolyDegreeRange);

    FPolyDegree:=Value;
    Recalculate;
  end;
end;

Function TCustomFittingFunction.GetAnswerVector(Index:Integer):Double;
Begin
  if (Index<1) or (Index>FPolyDegree) then
     Raise Exception.CreateFmt(TeeMsg_AnswerVectorIndex,[FPolyDegree]);

  result:=IAnswerVector[Index];
End;

procedure TCustomFittingFunction.AddFittedPoints(Source:TChartSeries);
var
  tmpMinXValue : Double;

  procedure AddPoint(const X:Double);
  var tmpValue : Double;
  begin
    tmpValue:=CalcFitting(FPolyDegree,IAnswerVector,X-tmpMinXValue)+IMinYValue;

    if ParentSeries.YMandatory then
       ParentSeries.AddXY(X,tmpValue)
    else
       ParentSeries.AddXY(tmpValue,X);
  end;

var tmpX      : Double;
    tmpStep   : Double;
    t         : Integer;
    tt        : Integer;
    tmpStart  : Integer;
    tmpEnd    : Integer;
    tmpFactor : Double;
begin
  IMinYValue:=ValueList(Source).MinValue;

  With Source do
  begin
    tmpMinXValue:=NotMandatoryValueList.MinValue;

    if FFirstPoint=-1 then tmpStart:=0
                      else tmpStart:=FFirstPoint;
    if FLastPoint=-1 then tmpEnd:=Count-1
                     else tmpEnd:=FLastPoint;

    FFactor:=Math.Max(1,Factor);
    tmpFactor:=1.0/FFactor;

    // 1 to 1 relationship between Source and Self
    for t:=tmpStart to tmpEnd-1 do
    begin
      tmpX:=NotMandatoryValueList.Value[t];
      AddPoint(tmpX);

      if FFactor>1 then
      begin
        tmpStep:=(NotMandatoryValueList.Value[t+1]-tmpX)*tmpFactor;

        for tt:=1 to FFactor-1 do
            AddPoint(tmpX+tmpStep*tt);
      end;
    end;

    AddPoint(NotMandatoryValueList.Value[tmpEnd]);
  end;
end;

procedure TCustomFittingFunction.AddPoints(Source:TChartSeries);
var t            : Integer;
    tmpStart     : Integer;
    tmpEnd       : Integer;
    tmpCount     : Integer;
    tmpPos       : Integer;
    IXVector     : TVector;
    IYVector     : TVector;
    tmpMinXValue : Double;
    AList        : TChartValueList;
Begin