;# ;# lr.pl,v 3.1 1993/07/06 01:09:08 jbj Exp ;# ;# ;# Linear Regression Package for perl ;# to be 'required' from perl ;# ;# Copyright (c) 1992 ;# Frank Kardel, Rainer Pruy ;# Friedrich-Alexander Universitaet Erlangen-Nuernberg ;# ;# ;############################################################# ## ## y = A + Bx ## ## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2) ## ## A = (Sum(y) - B * Sum(x)) / n ## ## ## interface ## *lr_init = *lr'lr_init; #';# &lr_init(tag); initialize data set for tag *lr_sample = *lr'lr_sample; #';# &lr_sample(x,y,tag); enter sample *lr_Y = *lr'lr_Y; #';# &lr_Y(x,tag); compute y for given x *lr_X = *lr'lr_X; #';# &lr_X(y,tag); compute x for given y *lr_r = *lr'lr_r; #';# &lr_r(tag); regression coeffizient *lr_cov = *lr'lr_cov; #';# &lr_cov(tag); covariance *lr_A = *lr'lr_A; #';# &lr_A(tag); *lr_B = *lr'lr_B; #';# &lr_B(tag); *lr_sigma = *lr'lr_sigma; #';# &lr_sigma(tag); standard deviation *lr_mean = *lr'lr_mean; #';# &lr_mean(tag); ######################### package lr; sub tagify { local($tag) = @_; if (defined($tag)) { *lr_n = eval "*${tag}_n"; *lr_sx = eval "*${tag}_sx"; *lr_sx2 = eval "*${tag}_sx2"; *lr_sxy = eval "*${tag}_sxy"; *lr_sy = eval "*${tag}_sy"; *lr_sy2 = eval "*${tag}_sy2"; } } sub lr_init { &tagify($_[$[]) if defined($_[$[]); $lr_n = 0; $lr_sx = 0.0; $lr_sx2 = 0.0; $lr_sxy = 0.0; $lr_sy = 0.0; $lr_sy2 = 0.0; } sub lr_sample { local($_x, $_y) = @_; &tagify($_[$[+2]) if defined($_[$[+2]); $lr_n++; $lr_sx += $_x; $lr_sy += $_y; $lr_sxy += $_x * $_y; $lr_sx2 += $_x**2; $lr_sy2 += $_y**2; } sub lr_B { &tagify($_[$[]) if defined($_[$[]); return 1 unless ($lr_n * $lr_sx2 - $lr_sx**2); return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / ($lr_n * $lr_sx2 - $lr_sx**2); } sub lr_A { &tagify($_[$[]) if defined($_[$[]); return ($lr_sy - &lr_B * $lr_sx) / $lr_n; } sub lr_Y { &tagify($_[$[]) if defined($_[$[]); return &lr_A + &lr_B * $_[$[]; } sub lr_X { &tagify($_[$[]) if defined($_[$[]); return ($_[$[] - &lr_A) / &lr_B; } sub lr_r { &tagify($_[$[]) if defined($_[$[]); local($s) = ($lr_n * $lr_sx2 - $lr_sx**2) * ($lr_n * $lr_sy2 - $lr_sy**2); return 1 unless $s; return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / sqrt($s); } sub lr_cov { &tagify($_[$[]) if defined($_[$[]); return ($lr_sxy - $lr_sx * $lr_sy / $lr_n) / ($lr_n - 1); } sub lr_sigma { &tagify($_[$[]) if defined($_[$[]); return 0 if $lr_n <= 1; return sqrt(($lr_sy2 - ($lr_sy * $lr_sy) / $lr_n) / ($lr_n)); } sub lr_mean { &tagify($_[$[]) if defined($_[$[]); return 0 if $lr_n <= 0; return $lr_sy / $lr_n; } &lr_init(); 1;