The SDL Component Suite is an industry leading collection of components supporting scientific and engineering computing. Please visit the SDL Web site for more information....



Interface of SDL_Math2


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 }





Last Update: 2006-Jän-30