xref: /freebsd/contrib/ntp/scripts/monitoring/lr.pl (revision 1e413cf93298b5b97441a21d9a50fdcd0ee9945e) 
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;#  Copyright (c) 1997 by
13;#  Ulrich Windl <Ulrich.Windl@rz.uni-regensburg.de>
14;#  (Converted to a PERL 5.004 package)
15;#
16;#############################################################
17
18package lr;
19
20##
21## y = A + Bx
22##
23## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2)
24##
25## A = (Sum(y) - B * Sum(x)) / n
26##
27
28##
29## interface
30##
31;# init(tag);		initialize data set for tag
32;# sample(x, y, tag);	enter sample
33;# Y(x, tag);		compute y for given x
34;# X(y, tag);		compute x for given y
35;# r(tag);		regression coefficient
36;# cov(tag);		covariance
37;# A(tag);
38;# B(tag);
39;# sigma(tag);		standard deviation
40;# mean(tag);
41#########################
42
43sub init
44{
45    my $self = shift;
46
47    $self->{n}   = 0;
48    $self->{sx}  = 0.0;
49    $self->{sx2} = 0.0;
50    $self->{sxy} = 0.0;
51    $self->{sy}  = 0.0;
52    $self->{sy2} = 0.0;
53}
54
55sub sample($$$)
56{
57    my $self = shift;
58    my($_x, $_y) = @_;
59
60    ++($self->{n});
61    $self->{sx}  += $_x;
62    $self->{sy}  += $_y;
63    $self->{sxy} += $_x * $_y;
64    $self->{sx2} += $_x**2;
65    $self->{sy2} += $_y**2;
66}
67
68sub B($)
69{
70    my $self = shift;
71
72    return 1 unless ($self->{n} * $self->{sx2} - $self->{sx}**2);
73    return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy})
74	/ ($self->{n} * $self->{sx2} - $self->{sx}**2);
75}
76
77sub A($)
78{
79    my $self = shift;
80
81    return ($self->{sy} - B($self) * $self->{sx}) / $self->{n};
82}
83
84sub Y($$)
85{
86    my $self = shift;
87
88    return A($self) + B($self) * $_[$[];
89}
90
91sub X($$)
92{
93    my $self = shift;
94
95    return ($_[$[] - A($self)) / B($self);
96}
97
98sub r($)
99{
100    my $self = shift;
101
102    my $s = ($self->{n} * $self->{sx2} - $self->{sx}**2)
103	  * ($self->{n} * $self->{sy2} - $self->{sy}**2);
104
105    return 1 unless $s;
106
107    return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy}) / sqrt($s);
108}
109
110sub cov($)
111{
112    my $self = shift;
113
114    return ($self->{sxy} - $self->{sx} * $self->{sy} / $self->{n})
115	/ ($self->{n} - 1);
116}
117
118sub sigma($)
119{
120    my $self = shift;
121
122    return 0 if $self->{n} <= 1;
123    return sqrt(($self->{sy2} - ($self->{sy} * $self->{sy}) / $self->{n})
124		/ ($self->{n}));
125}
126
127sub mean($)
128{
129    my $self = shift;
130
131    return 0 if $self->{n} <= 0;
132    return $self->{sy} / $self->{n};
133}
134
135sub new
136{
137    my $class = shift;
138    my $self = {
139	(n => undef,
140	 sx => undef,
141	 sx2 => undef,
142	 sxy => undef,
143	 sy => undef,
144	 sy2 => undef)
145    };
146    bless $self, $class;
147    init($self);
148    return $self;
149}
150
1511;
152