1*abb0f93cSkardel;# 2*abb0f93cSkardel;# lr.pl,v 3.1 1993/07/06 01:09:08 jbj Exp 3*abb0f93cSkardel;# 4*abb0f93cSkardel;# 5*abb0f93cSkardel;# Linear Regression Package for perl 6*abb0f93cSkardel;# to be 'required' from perl 7*abb0f93cSkardel;# 8*abb0f93cSkardel;# Copyright (c) 1992 9*abb0f93cSkardel;# Frank Kardel, Rainer Pruy 10*abb0f93cSkardel;# Friedrich-Alexander Universitaet Erlangen-Nuernberg 11*abb0f93cSkardel;# 12*abb0f93cSkardel;# Copyright (c) 1997 by 13*abb0f93cSkardel;# Ulrich Windl <Ulrich.Windl@rz.uni-regensburg.de> 14*abb0f93cSkardel;# (Converted to a PERL 5.004 package) 15*abb0f93cSkardel;# 16*abb0f93cSkardel;############################################################# 17*abb0f93cSkardel 18*abb0f93cSkardelpackage lr; 19*abb0f93cSkardel 20*abb0f93cSkardel## 21*abb0f93cSkardel## y = A + Bx 22*abb0f93cSkardel## 23*abb0f93cSkardel## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2) 24*abb0f93cSkardel## 25*abb0f93cSkardel## A = (Sum(y) - B * Sum(x)) / n 26*abb0f93cSkardel## 27*abb0f93cSkardel 28*abb0f93cSkardel## 29*abb0f93cSkardel## interface 30*abb0f93cSkardel## 31*abb0f93cSkardel;# init(tag); initialize data set for tag 32*abb0f93cSkardel;# sample(x, y, tag); enter sample 33*abb0f93cSkardel;# Y(x, tag); compute y for given x 34*abb0f93cSkardel;# X(y, tag); compute x for given y 35*abb0f93cSkardel;# r(tag); regression coefficient 36*abb0f93cSkardel;# cov(tag); covariance 37*abb0f93cSkardel;# A(tag); 38*abb0f93cSkardel;# B(tag); 39*abb0f93cSkardel;# sigma(tag); standard deviation 40*abb0f93cSkardel;# mean(tag); 41*abb0f93cSkardel######################### 42*abb0f93cSkardel 43*abb0f93cSkardelsub init 44*abb0f93cSkardel{ 45*abb0f93cSkardel my $self = shift; 46*abb0f93cSkardel 47*abb0f93cSkardel $self->{n} = 0; 48*abb0f93cSkardel $self->{sx} = 0.0; 49*abb0f93cSkardel $self->{sx2} = 0.0; 50*abb0f93cSkardel $self->{sxy} = 0.0; 51*abb0f93cSkardel $self->{sy} = 0.0; 52*abb0f93cSkardel $self->{sy2} = 0.0; 53*abb0f93cSkardel} 54*abb0f93cSkardel 55*abb0f93cSkardelsub sample($$) 56*abb0f93cSkardel{ 57*abb0f93cSkardel my $self = shift; 58*abb0f93cSkardel my($_x, $_y) = @_; 59*abb0f93cSkardel 60*abb0f93cSkardel ++($self->{n}); 61*abb0f93cSkardel $self->{sx} += $_x; 62*abb0f93cSkardel $self->{sy} += $_y; 63*abb0f93cSkardel $self->{sxy} += $_x * $_y; 64*abb0f93cSkardel $self->{sx2} += $_x**2; 65*abb0f93cSkardel $self->{sy2} += $_y**2; 66*abb0f93cSkardel} 67*abb0f93cSkardel 68*abb0f93cSkardelsub B() 69*abb0f93cSkardel{ 70*abb0f93cSkardel my $self = shift; 71*abb0f93cSkardel 72*abb0f93cSkardel return 1 unless ($self->{n} * $self->{sx2} - $self->{sx}**2); 73*abb0f93cSkardel return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy}) 74*abb0f93cSkardel / ($self->{n} * $self->{sx2} - $self->{sx}**2); 75*abb0f93cSkardel} 76*abb0f93cSkardel 77*abb0f93cSkardelsub A() 78*abb0f93cSkardel{ 79*abb0f93cSkardel my $self = shift; 80*abb0f93cSkardel 81*abb0f93cSkardel return ($self->{sy} - B() * $self->{sx}) / $self->{n}; 82*abb0f93cSkardel} 83*abb0f93cSkardel 84*abb0f93cSkardelsub Y() 85*abb0f93cSkardel{ 86*abb0f93cSkardel my $self = shift; 87*abb0f93cSkardel 88*abb0f93cSkardel return A() + B() * $_[$[]; 89*abb0f93cSkardel} 90*abb0f93cSkardel 91*abb0f93cSkardelsub X() 92*abb0f93cSkardel{ 93*abb0f93cSkardel my $self = shift; 94*abb0f93cSkardel 95*abb0f93cSkardel return ($_[$[] - A()) / B(); 96*abb0f93cSkardel} 97*abb0f93cSkardel 98*abb0f93cSkardelsub r() 99*abb0f93cSkardel{ 100*abb0f93cSkardel my $self = shift; 101*abb0f93cSkardel 102*abb0f93cSkardel my $s = ($self->{n} * $self->{sx2} - $self->{sx}**2) 103*abb0f93cSkardel * ($self->{n} * $self->{sy2} - $self->{sy}**2); 104*abb0f93cSkardel 105*abb0f93cSkardel return 1 unless $s; 106*abb0f93cSkardel 107*abb0f93cSkardel return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy}) / sqrt($s); 108*abb0f93cSkardel} 109*abb0f93cSkardel 110*abb0f93cSkardelsub cov() 111*abb0f93cSkardel{ 112*abb0f93cSkardel my $self = shift; 113*abb0f93cSkardel 114*abb0f93cSkardel return ($self->{sxy} - $self->{sx} * $self->{sy} / $self->{n}) 115*abb0f93cSkardel / ($self->{n} - 1); 116*abb0f93cSkardel} 117*abb0f93cSkardel 118*abb0f93cSkardelsub sigma() 119*abb0f93cSkardel{ 120*abb0f93cSkardel my $self = shift; 121*abb0f93cSkardel 122*abb0f93cSkardel return 0 if $self->{n} <= 1; 123*abb0f93cSkardel return sqrt(($self->{sy2} - ($self->{sy} * $self->{sy}) / $self->{n}) 124*abb0f93cSkardel / ($self->{n})); 125*abb0f93cSkardel} 126*abb0f93cSkardel 127*abb0f93cSkardelsub mean() 128*abb0f93cSkardel{ 129*abb0f93cSkardel my $self = shift; 130*abb0f93cSkardel 131*abb0f93cSkardel return 0 if $self->{n} <= 0; 132*abb0f93cSkardel return $self->{sy} / $self->{n}; 133*abb0f93cSkardel} 134*abb0f93cSkardel 135*abb0f93cSkardelsub new 136*abb0f93cSkardel{ 137*abb0f93cSkardel my $class = shift; 138*abb0f93cSkardel my $self = { 139*abb0f93cSkardel (n => undef, 140*abb0f93cSkardel sx => undef, 141*abb0f93cSkardel sx2 => undef, 142*abb0f93cSkardel sxy => undef, 143*abb0f93cSkardel sy => undef, 144*abb0f93cSkardel sy2 => undef) 145*abb0f93cSkardel }; 146*abb0f93cSkardel bless $self, $class; 147*abb0f93cSkardel init($self); 148*abb0f93cSkardel return $self; 149*abb0f93cSkardel} 150*abb0f93cSkardel 151*abb0f93cSkardel1; 152