← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mricron/utopic-proposed

« back to all changes in this revision

Viewing changes to npm_precl/dmath/fitmult.pas

  • Committer: Package Import Robot
  • Author(s): Michael Hanke
  • Date: 2013-09-21 09:36:20 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20130921093620-yqujzdbyysrwyj91
Tags: 0.20130828.1~dfsg.1-1
http://bugs.debian.org/713514
* New upstream release.
* Add lazarus-src to the build-dependencies to address a FTBFS post-wheezy
  (Closes: #713514).
* Bumped Standards-version to 3.9.4, no changes necessary.
* Update repackaging to pick up proper date.
* Remove obsolete DM-upload flag from debian/control.
* Use absolute paths for menu icons.
* Remove unnecessary execute permissions from examples files.

Show diffs side-by-side

added added

removed removed

Lines of Context:
npm_precl/dmath/fitmult.pas
 
1
{ **********************************************************************
 
2
  *                          Unit FITMULT.PAS                          *
 
3
  *                            Version 1.1                             *
 
4
  *                    (c) J. Debord, October 1998                     *
 
5
  **********************************************************************
 
6
  This unit fits the multiple linear equation:
 
7
 
 
8
                       y = b0 + b1.x1 + b2.x2 + ...
 
9
 
 
10
  ********************************************************************** }
 
11
 
 
12
unit FitMult;
 
13
 
 
14
{$F+}
 
15
 
 
16
interface
 
17
 
 
18
uses
 
19
  FMath, Matrices, Regress;
 
20
 
 
21
function FuncName : String;
 
22
 
 
23
function FirstParam : Integer;
 
24
 
 
25
function LastParam : Integer;
 
26
 
 
27
function ParamName(I : Integer) : String;
 
28
 
 
29
function RegFunc(X, B : PVector) : Float;
 
30
 
 
31
function FitModel(Method : Integer; X : PMatrix; Y, W : PVector;
 
32
                  N : Integer; B : PVector; V : PMatrix) : Integer;
 
33
 
 
34
procedure InitModel(CstPar : PVector);
 
35
 
 
36
 
 
37
implementation
 
38
 
 
39
const
 
40
  Nvar : Integer = 2;         { Number of independent variables }
 
41
  ConsTerm : Boolean = True;  { Flags the presence of a constant term b0 }
 
42
 
 
43
  function FuncName : String;
 
44
  { --------------------------------------------------------------------
 
45
    Returns the name of the regression function
 
46
    -------------------------------------------------------------------- }
 
47
  var
 
48
    Name, S : String;
 
49
    I : Integer;
 
50
  begin
 
51
    Name := 'y = ';
 
52
    if ConsTerm then
 
53
      Name := Name + 'b0 + ';
 
54
    Name := Name + 'b1.x1';
 
55
    for I := 2 to Nvar do
 
56
      begin
 
57
        Str(I, S);
 
58
        Name := Name + ' + b' + S + '.x' + S;
 
59
      end;
 
60
    FuncName := Name;
 
61
  end;
 
62
 
 
63
  function FirstParam : Integer;
 
64
  { --------------------------------------------------------------------
 
65
    Returns the index of the first parameter to be fitted
 
66
    -------------------------------------------------------------------- }
 
67
  begin
 
68
    if ConsTerm then
 
69
      FirstParam := 0
 
70
    else
 
71
      FirstParam := 1;
 
72
  end;
 
73
 
 
74
  function LastParam : Integer;
 
75
  { --------------------------------------------------------------------
 
76
    Returns the index of the last parameter to be fitted
 
77
    -------------------------------------------------------------------- }
 
78
  begin
 
79
    LastParam := Nvar;
 
80
  end;
 
81
 
 
82
  function ParamName(I : Integer) : String;
 
83
  { --------------------------------------------------------------------
 
84
    Returns the name of the I-th parameter
 
85
    -------------------------------------------------------------------- }
 
86
  var
 
87
    S : String;
 
88
  begin
 
89
    Str(I, S);
 
90
    ParamName := 'b' + S;
 
91
  end;
 
92
 
 
93
  function RegFunc(X, B : PVector) : Float;
 
94
  { --------------------------------------------------------------------
 
95
    Computes the regression function at observation X
 
96
    B is the vector of parameters.
 
97
    -------------------------------------------------------------------- }
 
98
  var
 
99
    I : Integer;
 
100
    Y : Float;
 
101
  begin
 
102
    if ConsTerm then Y := B^[0] else Y := 0.0;
 
103
    for I := 1 to Nvar do
 
104
      Y := Y + B^[I] * X^[I];
 
105
    RegFunc := Y;
 
106
  end;
 
107
 
 
108
  function FitModel(Method : Integer; X : PMatrix; Y, W : PVector;
 
109
                    N : Integer; B : PVector; V : PMatrix) : Integer;
 
110
  { --------------------------------------------------------------------
 
111
    Multiple linear regression
 
112
    --------------------------------------------------------------------
 
113
    Input :  Method = 0 for unweighted regression, 1 for weighted
 
114
             X      = matrix of independent variables
 
115
             Y      = vector of dependent variable
 
116
             W      = vector of weights
 
117
             N      = number of observations
 
118
    Output : B      = estimated regression parameters
 
119
             V      = variance-covariance matrix of parameters
 
120
    -------------------------------------------------------------------- }
 
121
  begin
 
122
    case Method of
 
123
      0 : FitModel := MulFit(X, Y, N, Nvar, ConsTerm, B, V);
 
124
      1 : FitModel := WMulFit(X, Y, W, N, Nvar, ConsTerm, B, V);
 
125
    end;
 
126
  end;
 
127
 
 
128
  procedure InitModel(CstPar : PVector);
 
129
  { --------------------------------------------------------------------
 
130
    Initializes the global variables of the unit
 
131
    --------------------------------------------------------------------
 
132
    CstPar^[0] = number of independent variables
 
133
    CstPar^[1] = 1 to include a constant term (b0)
 
134
    -------------------------------------------------------------------- }
 
135
  begin
 
136
    Nvar := Round(CstPar^[0]);
 
137
    ConsTerm := (CstPar^[1] = 1);
 
138
  end;
 
139
 
 
140
end.