const
{$IFDEF PAIDVERS}
SDLVersionInfo = 'math2_r1210_full';
IsLightEd = false;
{$ELSE}
SDLVersionInfo = 'math2_r1210_lighted';
IsLightEd = true;
{$ENDIF}
Release = 1210;
ME_STACKSIZE = 2000; { maximum size of function parser stacks }
MAXPOLYFITORDER = 10; { maximum number of polynomial terms in CurveFit,
do not increase it - higher orders yield poor
results due to round-off errors }
type
ESDLMath2Error = class(ESDLError); { exception type to indicate errors }
ESDLMathExp = class(ESDLError); { exception type to indicate errors }
TCalcDistFunc = function (ix: integer): double;
TClusterMethod = (cmSingleLink, cmCompleteLink, cmWard, cmAvgLink,
cmFlexLink, cmUpgma);
TKnnWMode = (kwmGauss, kwmAverage, kwmMedian, kwmLinear, kwmBiQuad);
TOperator = (opNone, opNumber, opListElem, opAdd, opSubtract, opMultiply,
opDivide, opMod, opPower, opGT, opGE, opLT, opLE, opEQ, opNE,
opOpenParanth, opClosedParanth, opMinusSign, opPlusSign,
opSine, opCosine, opTangens, opArcSin, opArcCos, opArcTan,
opAbs, opSign, opSqrt, opSqr, opRound, opNDInt, opNDQuant,
opNDDens, opSum, opMean, opVar, opPi, opTrue, opFalse,
opExp, opLn, opLg, opGauss, opRand, opFrac, opInt, opMax, opMin,
opAnd, opNot, opOr, opXor);
TCurveFitError = (cfeXLE0, cfeYLE0, cfeXEQ0, cfeYEQ0);
TRegModel = (rmNone, rmLinear, rmParabolic, rmGaussian,
rmReciLin, rmHyperbolic, rmReciHyperbolic, rmLog, rmReciLog,
rmPower, rmExpo, rmHoerl, rmCircle, rmPolynomial, rmCenteredPoly,
rmLinearOrigin);
TImgCompareMode = (icmRed, icmBlue, icmGreen, icmHue, icmLightness,
icmSaturation, icmGrayValues);
TGaussPeakParams = array [1..3] of double; // 1st index: position,
// 2nd: std.dev.,
// 3rd: intensity
TPeakParamsList = array of TGaussPeakParams;
const
REG_MINDP : array[TRegModel] of integer = // minimum no. of required data points
(0, // rmNone,
2, // rmLinear
3, // rmParabolic
3, // rmGaussian
3, // rmReciLin
3, // rmHyperbolic
3, // rmReciHyperbolic
3, // rmLog
3, // rmReciLog
3, // rmPower
3, // rmExpo
3, // rmHoerl
3, // rmCircle
-1, // rmPolynomial (depends on order of polynomial)
-1, // rmCenteredPoly (depends on order of polynomial)
2); // rmLinearOrigin
IDS_REGMODEL : array[TRegModel] of string =
('rmNone', 'rmLinear', 'rmParabolic', 'rmGaussian', 'rmReciLin',
'rmHyperbolic', 'rmReciHyperbolic', 'rmLog', 'rmReciLog', 'rmPower',
'rmExpo', 'rmHoerl', 'rmCircle', 'rmPolynomial', 'rmCenteredPoly',
'rmLinearOrigin');
ClusterMethodID : array[TClusterMethod] of string =
('single linkage', 'complete linkage', 'Ward''s method',
'average linkage', 'flexible strategy', 'unweighted pair group');
GolayPoly : array[1..11,-1..12] of integer =
{ Norm 0 1 2 3 4 5 6 7 8 9 10 11 12}
{----------------------------------------------------------------------}
{5} (( 35, 17, 12, -3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
{7} ( 21, 7, 6, 3, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0),
{9} ( 231, 59, 54, 39, 14, -21, 0, 0, 0, 0, 0, 0, 0, 0),
{11} ( 429, 89, 84, 69, 44, 9, -36, 0, 0, 0, 0, 0, 0, 0),
{13} ( 143, 25, 24, 21, 16, 9, 0, -11, 0, 0, 0, 0, 0, 0),
{15} (1105, 167, 162, 147, 122, 87, 42, -13, -78, 0, 0, 0, 0, 0),
{17} ( 323, 43, 42, 39, 34, 27, 18, 7, -6, -21, 0, 0, 0, 0),
{19} (2261, 269, 264, 249, 224, 189, 144, 89, 24, -51,-136, 0, 0, 0),
{21} (3059, 329, 324, 309, 284, 249, 204, 149, 84, 9, -76,-171, 0, 0),
{23} ( 805, 79, 78, 75, 70, 63, 54, 43, 30, 15, -2, -21, -42, 0),
{25} (5175, 467, 462, 447, 422, 387, 343, 287, 222, 147, 62, -33,-138,-253));
Golay2ndDeriv : array[1..11,-1..12] of integer =
{ Norm 0 1 2 3 4 5 6 7 8 9 10 11 12}
{----------------------------------------------------------------------}
{5} (( 7, -2, -1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
{7} ( 42, -4, -3, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0),
{9} ( 462, -20, -17, -8, 7, 28, 0, 0, 0, 0, 0, 0, 0, 0),
{11} ( 429, -10, -9, -6, -1, 6, 15, 0, 0, 0, 0, 0, 0, 0),
{13} ( 1001, -14, -13, -10, -5, 2, 11, 22, 0, 0, 0, 0, 0, 0),
{15} ( 6188, -56, -53, -44, -29, -8, 19, 52, 91, 0, 0, 0, 0, 0),
{17} ( 3876, -24, -23, -20, -15, -8, 1, 12, 25, 40, 0, 0, 0, 0),
{19} ( 6783, -30, -29, -26, -21, -14, -5, 6, 19, 34, 51, 0, 0, 0),
{21} (33649,-110,-107, -98, -83, -62, -35, -2, 37, 82, 133, 190, 0, 0),
{23} (17710, -44, -43, -40, -35, -28, -19, -8, 5, 20, 37, 56, 77, 0),
{25} (26910, -52, -51, -48, -43, -36, -27, -16, -3, 12, 29, 48, 69, 92));
type
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TCurveFit =
class (TComponent)
private
sumx, sumy : extended;
sumxq, sumyq : extended;
sumDiff, SumDiffq : extended;
sumxy : extended;
sumx2y : extended;
sumxy2 : extended;
sumx3 : extended;
sumy3 : extended;
sumx4 : extended;
sumy4 : extended;
sum1byy : extended;
sum1byxy : extended;
sum1byyq : extended;
sumxbyy : extended;
sumybyx : extended;
sum1byx : extended;
sum1byxq : extended;
sumlnx : extended;
sumlnxlny : extended;
sumlnxq : extended;
sumylny : extended;
sumylnx : extended;
sumxlnx : extended;
sumlnxbyy : extended;
sumlnybyx : extended;
sumlny : extended;
sumlnyq : extended;
sumxlny : extended;
sumxqlny : extended;
sumyqlnx : extended;
FNumData : longint;
FMinX, FMaxX : double;
FMinY, FMaxY : double;
FNatural1 : boolean;
FNaturalN : boolean;
FY1Dash : double;
FYNDash : double;
FVNState : TQuotedStrState;
FVNName : string;
FErrIndic : set of TCurveFitError;
// parameters of model calculated at last
// column 1 ... model parameters
// column 2 ... corresponding p values
// (polynomial fits only)
FModPars : array[1..2,0..MAXPOLYFITORDER] of double;
FRegMod : TRegModel; // last calculated model
FPolyOrder : integer; // polynomial order if
// FRegModel = rmPolynomial or rmCenteredPoly
FResids : TDoubleArray; // array of residuals of the last model
FModR2 : double; // r-squared for last calculated model
FXShift : double; // shift of centered polynomial
Spl2Deriv : TVector;
SplSortedX : TVector;
SplSortedY : TVector;
FData : TMatrix;
FSplineValid : boolean;
FPSplineSmooth : double;
FPSplineFQ : double;
FPenSplineValid : boolean;
FKendallValid : boolean;
FKendallConcord : integer;
FKendallDiscord : integer;
FKendallTies1 : integer;
FKendallTies2 : integer;
{$IFDEF PAIDVERS}
PSplA, PSplB,
PSplC, PSplD : array of double; { parameter array of penalized spline }
procedure ExchangeDuringSort (Sender: TObject; ExchgWhat: byte;
index1, index2, first, last: longint);
procedure PrepareSpline;
procedure PrepareSmoothedSpline;
{$ENDIF}
procedure AdjustSums (x,y: double);
function CalcMeanDegrees (col: integer): double;
procedure ClearModelParams;
function EvaluateIntern (RegModel: TRegModel; XVal: double): double;
function GetFitQual: double;
function GetMeanX: double;
function GetMeanXDegrees: double;
function GetMeanY: double;
function GetMeanYDegrees: double;
function GetStdDevX: double;
function GetStdDevY: double;
function GetSkewnessX: double;
function GetSkewnessY: double;
function GetKurtosisX: double;
function GetKurtosisY: double;
function GetMeanDiff: double;
function GetStdDevDiff: double;
function GetRxy: double;
function GetKruskalGamma: double;
function GetModelPar (ix, iy: integer): double;
function GetResidual (ix: integer): double;
function GetRMSDiff: double;
function GetSpearman: double;
function GetStdDevResidual: double;
function GetDataX (ix: integer): double;
function GetDataY (ix: integer): double;
function GetXShift: double;
procedure SetNatural1 (value: boolean);
procedure SetNaturalN (value: boolean);
procedure SetY1Dash (value: double);
procedure SetYNDash (value: double);
procedure SetSplineSmoothing (value: double);
procedure BasicRankCounts;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure Init;
function EnterStatValue (x,y: double): integer;
function Evaluate (XVal: double): double;
procedure FlipXY;
procedure RemoveStatValue (ix: integer);
procedure CalcAnovaReg (NumVars: integer; IncludeConst: boolean;
var dfreg, dfres, dftotal: integer;
var SSE, SSR, SST, MSE, MSR, F: double);
procedure CalcStatistics (var NumData: longint;
var MeanX, MeanY, StdevX, StdevY, MeanDiff,
StdevDiff, rxy: double);
procedure CalcCircleFit (var r, dx, dy: double);
procedure CalcExponentialFit (var k0, k1, FitQual: double);
procedure CalcGaussFit (var k0, k1, k2, FitQual: double);
procedure CalcHoerlFit (var k0, k1, k2, FitQual: double);
procedure CalcLinFit (var k, d, FitQual: double);
procedure CalcLinFitThroughOrigin (var k, FitQual: double);
procedure CalcLogFit (var k0, k1, FitQual: double);
procedure CalcPowerFit (var k0, k1, FitQual: double);
procedure CalcParabolFit (var k0, k1, k2, FitQual: double);
function CalcPolyFit (const nOrder: integer; var kArray: TDoubleArray;
var FitQual: double;
var NearSingular: boolean): boolean; overload;
function CalcPolyFit (const nOrder: integer; var kArray: TDoubleArray;
var Alpha: TDoubleArray; var FitQual: double;
var NearSingular: boolean): boolean; overload;
function CalcCenteredPolyFit (const nOrder: integer;
var kArray: TDoubleArray; var XShift, FitQual: double;
var NearSingular: boolean): boolean; overload;
function CalcCenteredPolyFit (const nOrder: integer;
var kArray: TDoubleArray; var alpha: TDoubleArray;
var XShift, FitQual: double;
var NearSingular: boolean): boolean; overload;
procedure CalcReciLinFit (var k0, k1, FitQual: double);
procedure CalcReciLogFit (var k0, k1, FitQual: double);
procedure CalcHyperbolFit (var k0, k1, FitQual: double);
procedure CalcReciHyperbolFit (var k0, k1, FitQual: double);
function CalcRegModel (RegModel: TRegModel; PolyOrder: integer): integer;
property CorrCoeff: double read GetRxy;
property CPXShift: double read GetXShift;
function CubicSpline (x: double): double;
property DataX[ix: integer]: double read GetDataX;
property DataY[ix: integer]: double read GetDataY;
property FitQual: double read GetFitQual;
function ExportAsASC (FName, Comment: string; Precision: integer): string;
function ImportASC (FName: string): integer;
function KendallsTau (var p: double): double;
property KruskalGamma: double read GetKruskalGamma;
property MinX: double read FMinX;
property MaxX: double read FMaxX;
property MinY: double read FMinY;
property MaxY: double read FMaxY;
property MeanDiff: double read GetMeanDiff;
property MeanX: double read GetMeanX;
property MeanY: double read GetMeanY;
property MeanAngleX: double read GetMeanXDegrees;
property MeanAngleY: double read GetMeanYDegrees;
property ModelPar[ix,iy: integer]: double read GetModelPar;
property NumData: longint read FNumData;
function PercentileX (prob: double): double;
function PercentileY (prob: double): double;
function Predict (RegModel: TRegModel; XVal, p: double;
PolyOrder: integer;
var PredVal, PredIv, ConfIv: double): integer;
property PolyOrder: integer read FPolyOrder;
function QuartilesX (var q1, q2, q3: double): boolean;
function QuartilesY (var q1, q2, q3: double): boolean;
property Residual[ix: integer]: double read GetResidual;
property RMSDiff: double read GetRMSDiff;
function SmoothedSpline (x: double; var FitQual: double;
var valid: boolean): double;
property SpearmanRankCorr: double read GetSpearman;
property SplineSmoothingFactor: double
read FPSplineSmooth write SetSplineSmoothing;
property SplineDerivY1: double read FY1dash write SetY1Dash;
property SplineDerivYN: double read FYNdash write SetYNDash;
property SplineNatural1: boolean read FNatural1 write SetNatural1;
property SplineNaturalN: boolean read FNaturalN write SetNaturalN;
property SkewnessX: double read GetSkewnessX;
property SkewnessY: double read GetSkewnessY;
property StdDevResid: double read GetStdDevResidual;
property KurtosisX: double read GetKurtosisX;
property KurtosisY: double read GetKurtosisY;
property StdDevX: double read GetStdDevX;
property StdDevY: double read GetStdDevY;
property StdDevDiff: double read GetStdDevDiff;
end;
{$IFDEF PAIDVERS}
{$IFDEF GE_LEV6}
TOnVarRequestEvent = procedure (Sender: TObject; VarName: string;
var Value: Variant; TkPos: integer) of object;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TMathExpression =
class(TComponent)
private
FExpression : string;
FOpStack : array[1..ME_STACKSIZE] of TOperator;
FOpStackPoi : integer;
FVarStack : array[1..ME_STACKSIZE] of Variant;
FVarStackPoi : integer;
FListStack : array[1..ME_STACKSIZE] of Variant;
FListStackPoi : integer;
FVExtractMode : boolean;
FOnVarRequest : TOnVarRequestEvent;
FHelperObject : TComponent;
FBlockExceptions : boolean;
FErrorValue : Variant;
procedure SetExpression (value: string);
protected
property VExtractMode: boolean read FVExtractMode write FVExtractMode;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
function Evaluate: Variant;
property HelperObject: TComponent read FHelperObject write FHelperObject;
published
property BlockExceptions: boolean
read FBlockExceptions write FBlockExceptions;
property ErrorValue: Variant read FErrorValue write FErrorValue;
property Expression: string read FExpression write SetExpression;
property OnVarRequest: TOnVarRequestEvent
read FOnVarRequest write FOnVarRequest;
end;
TEmitType = (etDefault, etDouble, etInteger, etBoolean,
etString, etDatetime, etUser1, etUser2);
TOnEmitEvent = procedure (Sender: TObject; VarName: string; var Value: Variant;
TypeOfVar: TEmitType) of object;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TExtractor=
class(TComponent)
private
FSource : string;
FOnEmit : TOnEmitEvent;
FInstPoi : integer; // instruction pointer
FCommandList : TStringList; // extraction command list
FCmds : string;
FSPos : integer; // string processing position
FDebugFName : string; // debug information is written to file
FEmitToAA : boolean; // flag: TRUE = emit to associative array
FVars : TAssocArray; // auxiliary variables
procedure VarRequestHandler (Sender: TObject; VarName: string;
var Value: Variant; TkPos: integer);
procedure SetSource (value: string);
procedure SetExtCommands (value: string);
public
Emission : TAssocArray; // output array
// (filled if EmitToAssocArray = TRUE)
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
function Execute: boolean;
published
property SourceString: string read FSource write SetSource;
property ExtractionCommands: string read FCmds write SetExtCommands;
property EmitToAssocArray: boolean read FEmitToAA write FEmitToAA;
property OnEmit: TOnEmitEvent read FOnEmit write FOnEmit;
property DebugFileName: string read FDebugFName write FDebugFName;
end;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TStringSearch = class(TMathExpression)
procedure MexVarRequestHandler (Sender: TObject; VarName: String;
var Value: Variant; TkPos: integer);
private
FInString : string;
FIgnoreCase : boolean;
FPositions : TIntArray;
FSearchExp : string;
FInternSE : string;
function GetNumFoundItems: integer;
function GetItemPositions(ix: integer): integer;
function GetItemLength(ix: integer): integer;
procedure PrepareSearchExp;
procedure SetIgnoreCase (value: boolean);
procedure SetSearchExp (value: string);
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property InString: string read FInString write FInstring;
property IgnoreCase: boolean read FIgnoreCase write SetIgnoreCase;
property SearchExpression: string read FSearchExp write SetSearchExp;
function DoSearch: boolean;
property NumFoundItems: integer read GetNumFoundItems;
property FoundItemsPos[ix: integer]: integer read GetItemPositions;
property FoundItemsLength[ix: integer]: integer read GetItemLength;
published
end;
TSimAnnCoolMode = (sacmLinear, sacmExponential);
TOnEvalCostSimAnneal = procedure (Sender: TObject; VarSet: TBitFld;
var Cost: double) of object;
TOnFindNbStateVarSel = procedure (Sender: TObject; CurrentVarSet: TBitFld;
var NextVarSet: TBitFld;
var Finished: boolean) of object;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TSimAnnealVarSel = class(TComponent)
private
FInitialT : double;
FFinalT : double;
FAlpha : double;
FCurrentT : double;
FMaxNVars : integer;
FMinimizeCost : boolean;
FCoolMode : TSimAnnCoolMode;
FVarSet : TBitFld;
FIncludeVars : TBitFld;
FExcludeVars : TBitFld;
FOnEvalCost : TOnEvalCostSimAnneal;
FOnFindNbState : TOnFindNbStateVarSel;
FHashList : TStringList;
procedure SetAlpha (value: double);
procedure SetFinalT (value: double);
procedure SetInitialT (value: double);
function GetNVars: integer;
procedure SetNVars (value: integer);
function GetPercentDone: double;
function GetSelectedVars: TIntArray;
function GetMaxNVars: integer;
procedure SetMaxNVars (value: integer);
procedure SetIncludeVar (ix: longint; value: boolean);
function GetIncludeVar (ix: longint): boolean;
procedure SetExcludeVar (ix: longint; value: boolean);
function GetExcludeVar (ix: longint): boolean;
procedure InitializeVarSet;
protected
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
(**) procedure DefaultNextNbStateHandler (Sender: TObject;
CurrentVarSet: TBitFld; var NextVarSet: TBitFld;
var Finished: boolean);
property AlwaysIncludeVar [ix: integer]: boolean
read GetIncludeVar write SetIncludeVar;
property AlwaysExcludeVar [ix: integer]: boolean
read GetExcludeVar write SetExcludeVar;
function Execute: integer;
property PercentDone: double read GetPercentDone;
property SelectedVars: TIntArray
read GetSelectedVars;
published
property Alpha: double read FAlpha write SetAlpha;
property CoolMode: TSimAnnCoolMode read FCoolMode write FCoolMode;
property MinimizeCost: boolean read FMinimizeCost write FMinimizeCost;
property FinalT: double read FFinalT write SetFinalT;
property CurrentT: double read FCurrentT;
property InitialT: double read FInitialT write SetInitialT;
property MaxNVars: integer read GetMaxNVars write SetMaxNVars;
property NVars: integer read GetNVars write SetNVars;
property OnEvalCost: TOnEvalCostSimAnneal
read FOnEvalCost write FOnEvalCost;
property OnFindNbState: TOnFindNbStateVarSel
read FOnFindNbState write FOnFindNbState;
end;
TVarSelMode = (vsmForward, vsmStepwise, vsmBackElim, vsmComplete);
TOnEvalCostVarSel = procedure (Sender: TObject; InVarSet: TIntArray;
TargetVarix: integer; var Cost: TDoubleArray) of object;
TOnProgressVarSel = procedure (Sender: TObject; Level: integer; VarSet: TIntArray;
var Cost: TDoubleArray) of object;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TVarSelEngine = class(TComponent)
private
FSelMode : TVarSelMode;
FSelCrit : integer; // selection criterion (index into FCostParams)
FIniVarSet : TIntArray; // initial variable set
FVarSet : TIntArray; // -1 ... never include the var
// 0 ... unprocessed / not selected
// +1 ... always include the var
// +2 ... currently selected
FTargetVarix : integer; // index of target variable
FOnEvalCost : TOnEvalCostVarSel;
FOnProgress : TOnProgressVarSel;
FOnFindNbState : TOnFindNbStateVarSel;
FOnCheckAbort : TOnCheckAbortEvent;
FHashList : TStringList;
FCostHistory : TDouble2DArray;
FCostMin : TBoolArray;
FCostParams : TDoubleArray;
function GetNVars: integer;
procedure SetNVars (value: integer);
function GetNCostParams: integer;
procedure SetNCostParams (value: integer);
function GetPercentDone: double;
procedure SetCostMin (ix: longint; value: boolean);
function GetCostMin (ix: longint): boolean;
procedure SetIncludeVar (ix: longint; value: boolean);
function GetIncludeVar (ix: longint): boolean;
procedure SetExcludeVar (ix: longint; value: boolean);
function GetExcludeVar (ix: longint): boolean;
function GetTargetVarix: integer;
procedure SetTargetVarix (value: integer);
protected
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property AlwaysIncludeVar [ix: integer]: boolean
read GetIncludeVar write SetIncludeVar;
property AlwaysExcludeVar [ix: integer]: boolean
read GetExcludeVar write SetExcludeVar;
property CostMin [ix: integer]: boolean
read GetCostMin write SetCostMin;
procedure DefaultNextNbStateHandler (Sender: TObject;
CurrentVarSet: TBitFld; var NextVarSet: TBitFld;
var Finished: boolean);
function Execute (CostIx: integer): integer;
property PercentDone: double read GetPercentDone;
published
property VarSelMode: TVarSelMode read FSelMode write FSelMode;
property NCostParams: integer read GetNCostParams write SetNCostParams;
property NVars: integer read GetNVars write SetNVars;
property TargetVarix: integer read GetTargetVarix write SetTargetVarix;
property OnCheckAbort: TOnCheckAbortEvent
read FOnCheckAbort write FOnCheckAbort;
property OnEvalCost: TOnEvalCostVarSel
read FOnEvalCost write FOnEvalCost;
property OnProgress: TOnProgressVarSel
read FOnProgress write FOnProgress;
property OnFindNbState: TOnFindNbStateVarSel
read FOnFindNbState write FOnFindNbState;
end;
{$ENDIF}
{$ENDIF}
function AgglomClustering
(Sender : TObject;
InMat : TMatrix;
DistanceMeasure : TDistMode;
ClusterMethod : TClusterMethod;
alpha : double;
var ClustResult : TIntMatrix;
var ClustDist : TVector;
var DendroCoords : TVector;
Feedback : TFeedbackProc;
OnDistCalc : TOnCalcDistanceEvent)
: integer;
function ApplyCompassKernel
(Kernel : integer; { kernel to be applied }
InData : TDouble2DArray; { input data }
var OutData : TDouble2DArray; { output data }
Feedback : TOnPercentDoneEvent) { feedback event }
: integer; { error codes }
function ApplyKirschKernel
(Kernel : integer; { kernel to be applied }
InData : TDouble2DArray; { input data }
var OutData : TDouble2DArray; { output data }
Feedback : TOnPercentDoneEvent) { feedback event }
: integer; { error codes }
procedure CalcChebFilterCoeffs
(NPoles : integer; { number of poles }
HiLoP : boolean; { high/lowpass }
CutoffFq : double; { cutoff frequency }
Ripple : double; { percent ripple }
var CoeffA0 : double; { filter coefficients }
Coeffs : TMatrix); { filter coefficients }
function CalcCovar
(InData : TMatrix; { input data }
CovarMat : TMatrix; { covariance matrix }
LoC, HiC : integer; { range of columns }
LoR, HiR : integer; { range of rows }
Mode : integer) { 0=scatter, 1=covariance, 2=correlation,
3=squared correlation, 4=sum of squared differences }
: boolean; { TRUE if success }
function CalcEigVec
(InMat : TMatrix) { symmetric input matrix }
: boolean; { TRUE if success }
function CalcFishQ
(m1,m2, { mean values, class 1 & 2 }
s1,s2 : double) { standard deviations }
: double; { Fisher ratio }
function CalcGaussKernel
(Probe : TVector; { probe position }
RefCenter : TVector; { center of kernel }
Width : double) { width of kernel }
: double; { result }
function CalcGaussKernelMat
(Probe : TVector; { probe position }
RefCenterMat : TMatrix; { matrix of kernel centers }
RefCenterIx : integer; { index into the kernel matrix }
Width : double) { width of kernel }
: double; { result }
function CalcImgCorrelation
(const Img1, // images to be compared
Img2 : TBitMap;
Range1,
Range2 : TRect;
CompareMode : TImgCompareMode)
: double;
function CalcPrincComp
(InData : TMatrix; { pointer to data array }
LoC, HiC : integer; { range of columns }
LoR, HiR : integer; { range of rows }
Scaling : integer) { 0=none, 1=mean cent., 2=autoscal. }
: boolean; overload; { TRUE if success }
function CalcPrincComp
(InData : TMatrix; { pointer to data array }
LoC, HiC : integer; { range of columns }
LoR, HiR : integer; { range of rows }
Scaling : integer; { 0=none, 1=mean cent., 2=autoscal. }
NormalizeEV : boolean) { TRUE: normalize Eigenvalues to sum=1 }
: boolean; overload; { TRUE if success }
function CalcRanks
(Data, { data to be ranked }
Ranks : TVector) { rank numbers }
: double; { tie correction value }
procedure CalcSincBPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ1 : double; { lower cutoff frequency: 0..0.5 }
CutOffFQ2 : double; { upper cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TDoubleArray); overload; { kernel parameters for bandpass }
procedure CalcSincBPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ1 : double; { lower cutoff frequency: 0..0.5 }
CutOffFQ2 : double; { upper cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TVector); overload; { kernel parameters for bandpass }
procedure CalcSincBSKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ1 : double; { lower cutoff frequency: 0..0.5 }
CutOffFQ2 : double; { upper cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TDoubleArray); overload; { kernel params for notch filter }
procedure CalcSincBSKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ1 : double; { lower cutoff frequency: 0..0.5 }
CutOffFQ2 : double; { upper cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TVector); overload; { kernel parameters for notch filter }
procedure CalcSincLPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ : double; { cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TDoubleArray); overload; { kernel parameters for lowpass }
procedure CalcSincLPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ : double; { cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
FilterKernel : TVector); overload; { kernel parameters for lowpass }
procedure CalcSincHPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ : double; { cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
var FilterKernel : TDoubleArray); overload; { kernel parameters for highpass }
procedure CalcSincHPKernel
(KLeng : integer; { length of sinc kernel }
CutOffFQ : double; { cutoff frequency: 0..0.5 }
Windowing : integer; { type of windowing }
FilterKernel : TVector); overload; { kernel parameters for highpass }
procedure ChebychevFilter
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
CoeffA0 : double; { filter coefficient a0 }
Coeffs : TMatrix); { rest of filter coefficients }
function CheckParanthInExp
(Expression : string) { math. expression }
: integer; { result of check }
function ClassScatterMatrices
(InData : TDouble2DArray; { data matrix }
ClassVec : TIntArray; { class vector }
var NClasses : integer; { number of found classes }
var ClCnt : TIntArray; { number of members of each class }
var ClMeans, { class means }
ClVars, { class variances }
SBetwCl, { between-class scatter matrix }
SWithinCl : TDouble2DArray) { within-class scatter matrix }
: integer;
function ConvertFromDiffPolygon
(FirstP : TPointDouble; { first point of polygon }
DiffPolyG : TPDblArray; { differential polygon }
var PolyG : TPDblArray) { absolute coordinates of polygon }
: integer; { size of returned polgyon }
function ConvertToDiffPolygon
(PolyG : TPDblArray; { polygon to be converted }
var DiffPolyG : TPDblArray; { resulting differential polygon }
PruneMode : integer) { pruning mode }
: integer; { size of returned differential polygon }
function Convex2DHull
(InData : TPDblArray) { collection of points }
: TPDblArray; { array of polygon establishing a convex hull }
function CreateGaussianPeaks
(PeakParams : TPeakParamsList; { peak parameters }
var Signal : TDoubleArray) { generated signal }
: integer; { error code }
function CreateSigmoidArray
(Data : TDoubleArray; { data array to be filled }
Slope : double; { slope }
YOffset : double; { y offset }
Ampl : double; { amplitude }
XOffset : integer) { x offset }
: integer; { error code }
function DistanceToPolygon
(TestPoint : TPointDouble; { coordinates of test point }
Polygon : TPDblArray; { polygon vertices }
IsClosed : boolean) { TRUE: the polygon is closed }
: double; { shortest distance to the polygon }
procedure EstimateByKNN
(InMat : TMatrix; { matrix containing known data }
TargetVec : TVector; { target training vector }
kn : integer; { number of nearest neighbors }
WeightingMode : TKnnWMode; {weighting mode used for estimation }
SmoothFact : double; { smoothing factor }
EstInVar : TVector; { values to be estimated }
var EstTarget : double; { estimated target value }
var EstMeanDist : double); { mean distance of kn neighbors }
function ExtractVarNames
(Formula : string; { formula to be analyzed }
VNames : TStringList) { list of found variables }
: integer; { number of found variables }
procedure FindCenters
(InMat : TMatrix; { data matrix }
RowLo, RowHi : integer; { first & last object }
NumCent : integer; { number of centers }
var Centers : TMatrix; { matrix of centers }
var MeanDist : double); { mean distance }
procedure FindNearestNeighbors
(k : integer; { number of neighbors }
InMat : TMatrix; { matrix to be searched }
FirstObj : integer; { first object }
LastObj : integer; { last object }
DatVec : TVector; { vector to be searched }
KNNList : TMatrix; { result }
CalcDist : TCalcDistFunc); { calculate distance }
procedure SecondDeriv
(SourceVec : TVector; { vector with the data to be processed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
procedure FirstDeriv
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
function Gauss2D
(PosX : integer; { center column }
PosY : integer; { center row }
KWidth : double; { kernel width }
Ampl : double; { amplitude }
var Data : TDouble2DArray) { matrix to be filled }
: integer; { error code }
function GetEigenResult
(EigVecNum : integer; { number of eigenvector }
VecElem : integer) { vector element }
: double; { matrix element }
function GetEigenSize
: integer; { size of eigenvectors }
function KernelConvolve
(Kernel : TDouble2DArray; { kernel to be applied to }
InData : TDouble2DArray; { input data }
var OutData : TDouble2DArray; { filtered data }
Feedback : TOnPercentDoneEvent) { feedback event }
: integer; { error codes }
function kMeansClustering
(InMat : TMatrix; { data matrix }
RowLo, RowHi : integer; { first & last object }
NumClusters : integer; { number of centers }
var Clusters : TMatrix; { matrix of centers }
var ClassVec : TIntVector) { assigned cluster numbers }
: double; overload; { sum of squared intra-class distances }
function kMeansClustering
(InMat : TMatrix; { data matrix }
RowLo, RowHi : integer; { first & last object }
NumClusters : integer; { number of clusters }
InitSeed : integer; { assignment of initial centers }
var Clusters : TMatrix; { matrix of cluster centers }
var ClassVec : TIntVector; { assigned cluster numbers }
var ClassCnt : TIntVector) { class member counts }
: double; overload; { sum of squared intra-class distances }
function kMeansEstimatedSteps
(NumObjects : integer; { number of objects used for the clustering }
NumClusters : integer; { number of clusters }
NumVars : integer) { number of variables }
: integer; { estimated number of processing steps }
function MahalanobisDistance
(p1, p2 : TVector; { two points in n-dimensional space }
InvCov : TMatrix) { inverse covariance matrix of data space }
: double; { Mahalanobis distance between p1 and p2 }
procedure MeanDistanceKNN
(InMat : TMatrix; { data matrix }
kn : integer; { # of nearest neighbors }
FirstRow : integer; { first object to be used }
LastRow : integer; { last object to be used }
var DistVec: TVector); { result for each obj }
procedure MovingAverageSmooth
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
procedure MovingKernelFilter
(SourceVec : TVector; { ector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
FilterKernel : TVector); { filter kernel }
procedure MovingMedianSmooth
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
function MultiLinReg
(InData : TMatrix; { input data }
OutData : TVector; { target vector }
Coeff : TVector; { fitted parameters }
DeltaCoeff : TVector; { errors in fitted params }
var NearSingular : boolean) { TRUE if near-singular condition met }
: boolean; overload; { TRUE if result valid }
function MultiLinReg
(Data : TMatrix; { input data }
VarList : TIntArray;{ list of column indices of the input variables }
TargetVar : integer; { column index of the target variable }
ForceOrigin : boolean; { TRUE: force model through origin }
var StdDv : double; { standard dev. of the residuals }
var FStatistic : double; { F value of the model }
var SminQ : double; { SSQ }
var Coeff : TVector; { estimated parameters }
var DeltaCoeff : TVector; { errors of estimated parameters }
var NearSingular : boolean) { TRUE if near-singular condition met }
: double; overload; { correlation coefficient y vs. yhat }
procedure OuterRectOfPolygon
(Indata : TPDblArray; { polygon vertices }
var xlow, { left boundary }
ylow, { bottom boundary }
xhigh, { right boundary }
yhigh : double); { top boundary }
procedure PenalizedCubicSpline
(n1, n2 : integer; { indices of data range to be used }
smooth : double; { smoothing parameter }
x, y, { data points, x must be increasing }
dy : array of double; { relative weights of the data points }
var a,b,c,d : array of double); { spline coefficients }
function PointIsInsideConvexHull
(x, y : double; { point to be tested }
ConvexHull : TPDblArray) { array of convex hull }
: boolean; { TRUE if point is within convex hull }
function PointIsInsidePolygon
(x, y : double; { point to be tested }
Polygon : TPDblArray) { polygon }
: boolean; overload; { TRUE if point is within the polygon }
function PolygonArea
(InData : TPDblArray) { polygon vertices }
: double; overload; { area }
function PolygonArea
(InData : TPDblArray; { polygon vertices }
var ISectCount : integer) { number of intersections }
: double; overload; { area }
function PolygonLength
(InData : TPDblArray; { polygon vertices }
Closed : boolean) { TRUE: polygon is closed }
: double; { circumference }
procedure PolynomialSmooth
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
function PseudoInverse
(InMat : TMatrix; { matrix to be inverted }
var PsInv : TMatrix; { pseudoinverse of InMat }
tol : double) { tolerance for singular values }
: boolean; { TRUE if pseudoinverse is valid }
function ReducePolygon
(var Polygon : TPIntArray) { polygon to be reduced }
: integer; overload; { number of vertices }
function ReducePolygon
(var Polygon : TPDblArray) { polygon to be reduced }
: integer; overload; { number of vertices }
procedure RemoveEigenMatrix;
function RidgeRegStd
(InData : TMatrix; { params of equations }
OutData : TVector; { bias of equations }
Lambda : double; { the ridge parameter }
Coeff : TVector; { fitted parameters }
DeltaCoeff : TVector; { errors in fitted params }
Means : TVector; { means before standardisation }
StdDevs : TVector; { standard deviations before standardization }
var NearSingular : boolean) { TRUE if near-singular condition met }
: boolean; { TRUE if result valid }
function RidgeReg
(InData : TMatrix; { params of equations }
OutData : TVector; { bias of equations }
Lambda : double; { the ridge parameter }
Coeff : TVector; { fitted parameters }
DeltaCoeff : TVector; { errors in fitted params }
var NearSingular : boolean) { TRUE if near-singular condition met }
: boolean; { TRUE if result valid }
function SimPLS
(X0, Y0 : TMatrix; { predictor (X0) and response (Y0) variables }
NFact : integer; { number of factors to be used for model }
Standardize : boolean; { TRUE: standardization of predictors }
var ScoreX, ScoreY : TMatrix; { score matrix for X any Y }
var LoadX, LoadY : TMatrix; { loading matrix for X any Y }
var WgtX, OrthoLd : TMatrix; { weights and orthonormal loadings }
var varX, varY : TVector; { explained variance proportions }
var RegCoeffs : TMatrix) { regression coefficients }
: integer; { error code }
function SingValDecomp
(MatAU : TMatrix; { input/output NxP }
MatV : TMatrix; { output matrix PxP }
VecW : TVector) { diag. output matrix PxP }
: boolean; { TRUE if result valid }
function SingValEquSolve
(MatAU : TMatrix; { decomposed matrix NxP }
MatV : TMatrix; { decomposed matrix PxP }
VecW : TVector; { singular values PxP }
VecB : TVector; { bias vector, size N }
VecX : TVector; { solution, size P }
VecdX : TVector) { stddev. of solut, size P }
: boolean; { TRUE if result valid }
function SphereGreatCircleDist
(radius : double; { radius of the sphere }
Lat1, Long1 : double; { position 1 - latitude/longitude in degrees }
Lat2, Long2 : double) { position 2 - latitude/longitude in degrees }
: double; { geodesic distance }
function VarInflatFactor
(Data : TMatrix;
VarList : TIntArray;
var VIFs : TDoubleArray;
Feedback : TOnPercentDoneEvent)
: integer;
function VertexCompAnalysis
(Data : TMatrix; { pixel data }
NEndMembers : integer; { number of expected endmembers }
UsePCA : boolean; { TRUE: use PCA for projection, FALSE: use SVD }
var EndMEstim : TMatrix; { estimated end members }
var EndMIx : TIntVector; { indices of most pure end members }
var DProj : TMatrix) { projected data }
: boolean; { TRUE if result valid }
procedure WeightedAverageSmooth
(SourceVec : TVector; { vector with the data to be smoothed }
FirstElem, { start index into SourceVec }
LastElem : integer; { stop index into SourceVec }
DestVec : TVector; { result vector }
WindowSize : integer); { length of polynomial }
|