dist/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
  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;