models.pas

Delphi 的数学控件

{ **********************************************************************
  *                          Unit MODELS.PAS                           *
  *                            Version 1.8                             *
  *                    (c) J. Debord, January 2004                     *
  **********************************************************************
                Library of regression and variance models
  ********************************************************************** }

unit Models;

interface

uses
  FMath,
  Matrices,
  Regress,
  FitLin,
  FitMult,
  FitPoly,
  FitFrac,
  FitExpo,
  FitIExpo,
  FitExLin,
  FitPower,
  FitMich,
  FitMint,
  FitHill,
  FitLogis,
  FitPka;

{ ---------------------------------------------------------------------
  Highest index of regression models
  --------------------------------------------------------------------- }
const
  MAXMODEL = 12;

{ ---------------------------------------------------------------------
  Highest index of variance models
  --------------------------------------------------------------------- }
const
  MAXVARMODEL = 5;

{ ---------------------------------------------------------------------
  Definition of regression models
  --------------------------------------------------------------------- }
const
  REG_LIN   = 0;   { Linear }
  REG_MULT  = 1;   { Multiple linear }
  REG_POL   = 2;   { Polynomial }
  REG_FRAC  = 3;   { Rational fraction }
  REG_EXPO  = 4;   { Sum of exponentials }
  REG_IEXPO = 5;   { Increasing exponential }
  REG_EXLIN = 6;   { Exponential + linear }
  REG_POWER = 7;   { Power }
  REG_MICH  = 8;   { Michaelis }
  REG_MINT  = 9;   { Integrated Michaelis }
  REG_HILL  = 10;  { Hill }
  REG_LOGIS = 11;  { Logistic }
  REG_PKA   = 12;  { Acid/Base titration curve }

{ ---------------------------------------------------------------------
  Definition of variance models
  --------------------------------------------------------------------- }
const
  VAR_CONST = 0;  { Constant }
  VAR_LIN   = 1;  { Linear }
  VAR_POL2  = 2;  { 2nd degree polynomial }
  VAR_POL3  = 3;  { 3rd degree polynomial }
  VAR_EXPO  = 4;  { Exponential }
  VAR_POWER = 5;  { Power }

{ ---------------------------------------------------------------------
  Names of regression models
  --------------------------------------------------------------------- }

const
  MODELNAME : array[0..MAXMODEL] of String =
{$IFDEF FRENCH}
  ('Lineaire',
   'Lineaire multiple',
   'Polynomial',
   'Fraction rationnelle',
   'Somme d''exponentielles',
   'Exponentielle croissante',
   'Exponentielle + lineaire',
   'Puissance',
   'Michaelis',
   'Michaelis integree',
   'Hill',
   'Logistique',
   'Titrage acide/base');
{$ELSE}
  ('Linear',
   'Multiple linear',
   'Polynomial',
   'Rational fraction',
   'Sum of exponentials',
   'Increasing exponential',
   'Exponential + linear',
   'Power',
   'Michaelis',
   'Integrated Michaelis',
   'Hill',
   'Logistic',
   'Acid/Base titration curve');
{$ENDIF}

{ ---------------------------------------------------------------------
  Names of variance models
  --------------------------------------------------------------------- }

const
  VARMODELNAME : array[0..MAXVARMODEL] of String =
{$IFDEF FRENCH}
  ('Constante',
   'Lineaire',
   'Polynome de degre 2',
   'Polynome de degre 3',
   'Exponentielle',
   'Puissance');
{$ELSE}
  ('Constant',
   'Linear',
   '2nd degree polynomial',
   '3rd degree polynomial',
   'Exponential',
   'Power');
{$ENDIF}

function FuncName : String;
{ --------------------------------------------------------------------
  Returns the name of the regression function
  -------------------------------------------------------------------- }

function FirstParam : Integer;
{ --------------------------------------------------------------------
  Returns the index of the first fitted parameter
  -------------------------------------------------------------------- }

function LastParam : Integer;
{ --------------------------------------------------------------------
  Returns the index of the last fitted parameter
  -------------------------------------------------------------------- }

function ParamName(I : Integer) : String;
{ --------------------------------------------------------------------
  Returns the name of the I-th fitted parameter
  -------------------------------------------------------------------- }

function RegFunc(X : Float; B : TVector) : Float;
{ --------------------------------------------------------------------
  Computes the regression function for one independent variable
  B is the vector of parameters
  -------------------------------------------------------------------- }

function RegFuncNVar(X, B : TVector) : Float;
{ --------------------------------------------------------------------
  Computes the regression function for several independent variables
  B is the vector of parameters
  -------------------------------------------------------------------- }

procedure DerivProc(RegFunc : TRegFunc; X, Y : Float; B, D : TVector);
{ --------------------------------------------------------------------
  Computes the derivatives of the regression function at point (X,Y)
  with respect to the parameters B. The results are returned in D.
  D^[I] contains the derivative with respect to the I-th parameter.
  -------------------------------------------------------------------- }

procedure InitModel(Reg_Model, Var_Model : Integer; CstPar : TVector);
{ --------------------------------------------------------------------
  Initializes the regression and variance models. Constant parameters
  (e.g. degree of polynomial) are passed in vector CstPar.
  -------------------------------------------------------------------- }

function WLSFit(X            : TVector;
                U            : TMatrix;
                Y            : TVector;
                N            : Integer;
                Init         : Boolean;
                MaxIter      : Integer;
                Tol          : Float;
                Theta, B     : TVector;
                B_min, B_max : TVector;
                V            : TMatrix;
                Ycalc, S     : TVector;
                var Test     : TRegTest) : Integer;
{ ----------------------------------------------------------------------
  Fits the regression function and computes the regression tests
  ----------------------------------------------------------------------
  Input :  X, U         = vector or matrix of independent variable(s)
           Y            = vector of dependent variable
           N            = number of observations
           Init         = TRUE to compute initial parameter estimates
                          FALSE to use the current values
           MaxIter      = maximum number of iterations
                          (if 0 the parameters will not be refined)
           Tol          = required parameter precision
           Theta        = variance parameters
           B            = initial parameters values
           B_min, B_max = parameter bounds
  --------------------------------------------------------------------
  Output : Theta = updated variance parameters
                   (residual variance stored in Theta^[0])
           B     = regression parameters
           V     = variance-covariance matrix
           Ycalc = estimated Y values
           S     = standard deviations of Y
           Test  = regression tests
  --------------------------------------------------------------------
  Possible results = OPT_OK         : no error
                     OPT_SING       : singular matrix
                     OPT_BIG_LAMBDA : too high Marquardt's parameter
                     OPT_NON_CONV   : non-convergence
  -------------------------------------------------------------------- }

function VarFuncName : String;
{ --------------------------------------------------------------------
  Returns the name of the variance function
  -------------------------------------------------------------------- }

function LastVarParam : Integer;
{ ----------------------------------------------------------------------
  Returns the index of the last variance parameter (upper bound of Theta)
  ---------------------------------------------------------------------- }

function VarFunc(Y : Float; Theta : TVector) : Float;
{ --------------------------------------------------------------------
  Computes the variance of an observation Y. The parameters are
  Theta^[1], Theta^[2],... The true variance is Theta^[0] * VarFunc,
  where Theta^[0] (equal to the residual variance Vr) is estimated by
  the regression program.
  -------------------------------------------------------------------- }

implementation

var
  RegModel : Integer;  { Index of regression model }
  VarModel : Integer;  { Index of variance model }

  function FuncName : String;
  begin
    case RegModel of
      REG_LIN   : FuncName := fitlin.FuncName;
      REG_MULT  : FuncName := fitmult.FuncName;
      REG_POL   : FuncName := fitpoly.FuncName;
      REG_FRAC  : FuncName := fitfrac.FuncName;
      REG_EXPO  : FuncName := fitexpo.FuncName;
      REG_IEXPO : FuncName := fitiexpo.FuncName;
      REG_EXLIN : FuncName := fitexlin.FuncName;
      REG_POWER : FuncName := fitpower.FuncName;
      REG_MICH  : FuncName := fitmich.FuncName;
      REG_MINT  : FuncName := fitmint.FuncName;
      REG_HILL  : FuncName := fithill.FuncName;
      REG_LOGIS : FuncName := fitlogis.FuncName;
      REG_PKA   : FuncName := fitpka.FuncName;
    end;
  end;

  function FirstParam : Integer;
  begin
    case RegModel of
      REG_LIN   : FirstParam := fitlin.FirstParam;
      REG_MULT  : FirstParam := fitmult.FirstParam;
      REG_POL   : FirstParam := fitpoly.FirstParam;
      REG_FRAC  : FirstParam := fitfrac.FirstParam;
      REG_EXPO  : FirstParam := fitexpo.FirstParam;
      REG_IEXPO : FirstParam := fitiexpo.FirstParam;
      REG_EXLIN : FirstParam := fitexlin.FirstParam;
      REG_POWER : FirstParam := fitpower.FirstParam;
      REG_MICH  : FirstParam := fitmich.FirstParam;