Home | History | Annotate | Line # | Download | only in monitoring 
      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 (at] 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;
    152