source: trunk/third/xntp/scripts/monitoring/lr.pl @ 10832

Revision 10832, 2.8 KB checked in by brlewis, 27 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r10831, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1;#
2;# lr.pl,v 3.1 1993/07/06 01:09:08 jbj Exp
3;#
4;#
5;# Linear Regression Package for perl
6;# to be 'required' from perl
7;#
8;#  Copyright (c) 1992
9;#  Frank Kardel, Rainer Pruy
10;#  Friedrich-Alexander Universitaet Erlangen-Nuernberg
11;#
12;#
13;#############################################################
14
15##
16## y = A + Bx
17##
18## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2)
19##
20## A = (Sum(y) - B * Sum(x)) / n
21##
22
23##
24## interface
25##
26*lr_init   = *lr'lr_init;       #';# &lr_init(tag); initialize data set for tag
27*lr_sample = *lr'lr_sample;     #';# &lr_sample(x,y,tag); enter sample
28*lr_Y      = *lr'lr_Y;          #';# &lr_Y(x,tag); compute y for given x
29*lr_X      = *lr'lr_X;          #';# &lr_X(y,tag); compute x for given y
30*lr_r      = *lr'lr_r;          #';# &lr_r(tag);   regression coeffizient
31*lr_cov    = *lr'lr_cov;        #';# &lr_cov(tag); covariance
32*lr_A      = *lr'lr_A;          #';# &lr_A(tag);   
33*lr_B      = *lr'lr_B;          #';# &lr_B(tag);
34*lr_sigma  = *lr'lr_sigma;      #';# &lr_sigma(tag); standard deviation
35*lr_mean   = *lr'lr_mean;       #';# &lr_mean(tag);
36#########################
37
38package lr;
39
40sub tagify
41{
42    local($tag) = @_;
43    if (defined($tag))
44    {
45      *lr_n   = eval "*${tag}_n";
46      *lr_sx  = eval "*${tag}_sx";
47      *lr_sx2 = eval "*${tag}_sx2";
48      *lr_sxy = eval "*${tag}_sxy";
49      *lr_sy  = eval "*${tag}_sy";
50      *lr_sy2 = eval "*${tag}_sy2";
51    }
52}
53
54sub lr_init
55{
56    &tagify($_[$[]) if defined($_[$[]);
57
58    $lr_n   = 0;
59    $lr_sx  = 0.0;
60    $lr_sx2 = 0.0;
61    $lr_sxy = 0.0;
62    $lr_sy  = 0.0;
63    $lr_sy2 = 0.0;
64}
65
66sub lr_sample
67{
68    local($_x, $_y) = @_;
69
70    &tagify($_[$[+2]) if defined($_[$[+2]);
71
72    $lr_n++;
73    $lr_sx  += $_x;
74    $lr_sy  += $_y;
75    $lr_sxy += $_x * $_y;
76    $lr_sx2 += $_x**2;
77    $lr_sy2 += $_y**2;
78}
79
80sub lr_B
81{
82    &tagify($_[$[]) if defined($_[$[]);
83
84    return 1 unless ($lr_n * $lr_sx2 - $lr_sx**2);
85    return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / ($lr_n * $lr_sx2 - $lr_sx**2);
86}
87
88sub lr_A
89{
90    &tagify($_[$[]) if defined($_[$[]);
91
92    return ($lr_sy - &lr_B * $lr_sx) / $lr_n;
93}
94
95sub lr_Y
96{
97    &tagify($_[$[]) if defined($_[$[]);
98
99    return &lr_A + &lr_B * $_[$[];
100}
101
102sub lr_X
103{
104    &tagify($_[$[]) if defined($_[$[]);
105
106    return ($_[$[] - &lr_A) / &lr_B;
107}
108
109sub lr_r
110{
111    &tagify($_[$[]) if defined($_[$[]);
112
113    local($s) = ($lr_n * $lr_sx2 - $lr_sx**2) * ($lr_n * $lr_sy2 - $lr_sy**2);
114
115    return 1 unless $s;
116   
117    return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / sqrt($s);
118}
119
120sub lr_cov
121{
122    &tagify($_[$[]) if defined($_[$[]);
123
124    return ($lr_sxy - $lr_sx * $lr_sy / $lr_n) / ($lr_n - 1);
125}
126
127sub lr_sigma
128{
129    &tagify($_[$[]) if defined($_[$[]);
130
131    return 0 if $lr_n <= 1;
132    return sqrt(($lr_sy2 - ($lr_sy * $lr_sy) / $lr_n) / ($lr_n));
133}
134
135sub lr_mean
136{
137    &tagify($_[$[]) if defined($_[$[]);
138
139    return 0 if $lr_n <= 0;
140    return $lr_sy / $lr_n;
141}
142
143&lr_init();
144
1451;
Note: See TracBrowser for help on using the repository browser.