Return to lr.pl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / ntp / scripts / monitoring

Annotation of embedaddon/ntp/scripts/monitoring/lr.pl, revision 1.1.1.1

1.1       misho       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: 
                     18: package 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: 
                     43: sub 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: 
                     55: sub 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: 
                     68: sub 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: 
                     77: sub A()
                     78: {
                     79:     my $self = shift;
                     80: 
                     81:     return ($self->{sy} - B() * $self->{sx}) / $self->{n};
                     82: }
                     83: 
                     84: sub Y()
                     85: {
                     86:     my $self = shift;
                     87: 
                     88:     return A() + B() * $_[$[];
                     89: }
                     90: 
                     91: sub X()
                     92: {
                     93:     my $self = shift;
                     94: 
                     95:     return ($_[$[] - A()) / B();
                     96: }
                     97: 
                     98: sub 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: 
                    110: sub cov()
                    111: {
                    112:     my $self = shift;
                    113: 
                    114:     return ($self->{sxy} - $self->{sx} * $self->{sy} / $self->{n})
                    115:        / ($self->{n} - 1);
                    116: }
                    117: 
                    118: sub 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: 
                    127: sub mean()
                    128: {
                    129:     my $self = shift;
                    130: 
                    131:     return 0 if $self->{n} <= 0;
                    132:     return $self->{sy} / $self->{n};
                    133: }
                    134: 
                    135: sub 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: 
                    151: 1;