/contrib/ntp/scripts/monitoring/lr.pl

  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->{sx}) / $self->{n};
 82}
 83
 84sub Y()
 85{
 86    my $self = shift;
 87
 88    return A() + B() * $_[$[];
 89}
 90
 91sub X()
 92{
 93    my $self = shift;
 94
 95    return ($_[$[] - A()) / B();
 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;