const
{$IFDEF PAIDVERS}
SDLVersionInfo = 'math2_r900_full';
IsLightEd = false;
{$ELSE}
SDLVersionInfo = 'math2_r900_lighted';
IsLightEd = true;
{$ENDIF}
Release = 900;
ME_STACKSIZE = 100; { maximum size of function parser stacks }
MAXPOLYFITORDER = 8; { 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 }
TCalcDistFunc = function (ix: integer): double;
TClusterMethod = (cmSingleLink, cmCompleteLink, cmWard, cmAvgLink,
cmFlexLink, cmUpgma);
TKnnWMode = (kwmGauss, kwmAverage, kwmMedian, kwmLinear);
TOperator = (opNone, opNumber, opAdd, opSubtract, opMultiply, opDivide,
opMod, opPower, opGT, opGE, opLT, opLE, opEQ, opNE,
opOpenParanth, opClosedParanth, opMinusSign, opPlusSign,
opSine, opCosine, opTangens, opArcSin, opArcCos, opArcTan,
opAbs, opSqrt, opSqr, opRound, opPi, opTrue, opFalse,
opExp, opLn, opLg, opGauss, opRand, opFrac, opInt,
opAnd, opNot, opOr, opXor);
TCurveFitError = (cfeXLE0, cfeYLE0, cfeXEQ0, cfeYEQ0);
TImgCompareMode = (icmRed, icmBlue, icmGreen, icmHue, icmLightness,
icmSaturation, icmGrayValues);
const
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
TCurveFit =
class (TComponent)
private
sumx, sumy : double;
sumxq, sumyq : double;
sumDiff, SumDiffq : double;
sumxy : double;
sumx2y : double;
sumxy2 : double;
sumx3 : double;
sumy3 : double;
sumx4 : double;
sum1byy : double;
sum1byxy : double;
sum1byyq : double;
sumxbyy : double;
sumybyx : double;
sum1byx : double;
sum1byxq : double;
sumlnx : double;
sumlnxlny : double;
sumlnxq : double;
sumylnx : double;
sumxlnx : double;
sumlnxbyy : double;
sumlny : double;
sumlnyq : double;
sumxlny : double;
sumxqlny : double;
FNumData : longint;
FMinX, FMaxX : double;
FMinY, FMaxY : double;
FNatural1 : boolean;
FNaturalN : boolean;
FY1Dash : double;
FYNDash : double;
FVNState : TQuotedStrState;
FVNName : string;
FErrIndic : set of TCurveFitError;
Spl2Deriv : TVector;
SplSortedX : TVector;
SplSortedY : TVector;
FData : TMatrix;
FSplineValid : boolean;
FPSplineSmooth : double;
FPSplineFQ : double;
FPenSplineValid : boolean;
FKendallValid : boolean;
FKendallConcord : integer;
FKendallDiscord : integer;
FKendallTies : 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;
function GetMeanX: double;
function GetMeanXDegrees: double;
function GetMeanY: double;
function GetMeanYDegrees: double;
function GetStdDevX: double;
function GetStdDevY: double;
function GetMeanDiff: double;
function GetStdDevDiff: double;
function GetRxy: double;
function GetKendallsTau: double;
function GetKruskalGamma: double;
function GetSpearman: double;
function GetDataX(ix: integer): double;
function GetDataY(ix: integer): 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;
procedure EnterStatValue (x,y: double);
procedure RemoveStatValue (ix: integer);
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 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: byte; var kArray: array of double;
var FitQual: double): boolean;
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);
property CorrCoeff: double read GetRxy;
function CubicSpline (x: double): double;
property DataX[ix: integer]: double read GetDataX;
property DataY[ix: integer]: double read GetDataY;
procedure ExportAsASC (FName, Comment: string; Precision: integer);
function ImportASC (FName: string): integer;
property KendallsTau: double read GetKendallsTau;
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 NumData: longint read FNumData;
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 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) of object;
TMathExpression =
class(TComponent)
private
FExpression : string;
FOpStack : array[1..ME_STACKSIZE] of TOperator;
FOpStackPoi : integer;
FVarStack : array[1..ME_STACKSIZE] of Variant;
FVarStackPoi : integer;
FOnVarRequest : TOnVarRequestEvent;
procedure SetExpression (value: string);
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
function Evaluate: Variant;
published
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;
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
FVars : TAssocArray; // auxiliary variables
procedure VarRequestHandler (Sender: TObject; VarName: string;
var Value: Variant);
procedure SetSource (value: string);
procedure SetExtCommands (value: string);
public
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 OnEmit: TOnEmitEvent read FOnEmit write FOnEmit;
property DebugFileName: string read FDebugFName write FDebugFName;
end;
{$ENDIF}
{$ENDIF}
var
AbortMathProc : boolean;
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 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 Convex2DHull
(InData : TPDblArray)
: TPDblArray;
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 }
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 GetEigenResult
(EigVecNum : integer; { number of eigenvector }
VecElem : integer) { vector element }
: double; { matrix element }
function GetEigenSize
: integer; { size of eigenvectors }
procedure 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); { vector of assigned cluster numbers }
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 }
function MultiLinReg
(InData : TMatrix; { params of equations }
OutData : TVector; { bias of equations }
Coeff : TVector; { fitted parameters }
DeltaCoeff : TVector) { errors in fitted params }
: boolean; { TRUE if result valid }
function PolygonArea
(InData : TPDblArray) { polygon corners }
: double; { area }
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 }
procedure RemoveEigenMatrix;
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 }
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 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 }
|