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     ! 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;