Return to lr.pl CVS log

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

ntp 4.2.6p5

    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;