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;# 13;############################################################# 14 15## 16## y = A + Bx 17## 18## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2) 19## 20## A = (Sum(y) - B * Sum(x)) / n 21## 22 23## 24## interface 25## 26*lr_init = *lr'lr_init; #';# &lr_init(tag); initialize data set for tag 27*lr_sample = *lr'lr_sample; #';# &lr_sample(x,y,tag); enter sample 28*lr_Y = *lr'lr_Y; #';# &lr_Y(x,tag); compute y for given x 29*lr_X = *lr'lr_X; #';# &lr_X(y,tag); compute x for given y 30*lr_r = *lr'lr_r; #';# &lr_r(tag); regression coeffizient 31*lr_cov = *lr'lr_cov; #';# &lr_cov(tag); covariance 32*lr_A = *lr'lr_A; #';# &lr_A(tag); 33*lr_B = *lr'lr_B; #';# &lr_B(tag); 34*lr_sigma = *lr'lr_sigma; #';# &lr_sigma(tag); standard deviation 35*lr_mean = *lr'lr_mean; #';# &lr_mean(tag); 36######################### 37 38package lr; 39 40sub tagify 41{ 42 local($tag) = @_; 43 if (defined($tag)) 44 { 45 *lr_n = eval "*${tag}_n"; 46 *lr_sx = eval "*${tag}_sx"; 47 *lr_sx2 = eval "*${tag}_sx2"; 48 *lr_sxy = eval "*${tag}_sxy"; 49 *lr_sy = eval "*${tag}_sy"; 50 *lr_sy2 = eval "*${tag}_sy2"; 51 } 52} 53 54sub lr_init 55{ 56 &tagify($_[$[]) if defined($_[$[]); 57 58 $lr_n = 0; 59 $lr_sx = 0.0; 60 $lr_sx2 = 0.0; 61 $lr_sxy = 0.0; 62 $lr_sy = 0.0; 63 $lr_sy2 = 0.0; 64} 65 66sub lr_sample 67{ 68 local($_x, $_y) = @_; 69 70 &tagify($_[$[+2]) if defined($_[$[+2]); 71 72 $lr_n++; 73 $lr_sx += $_x; 74 $lr_sy += $_y; 75 $lr_sxy += $_x * $_y; 76 $lr_sx2 += $_x**2; 77 $lr_sy2 += $_y**2; 78} 79 80sub lr_B 81{ 82 &tagify($_[$[]) if defined($_[$[]); 83 84 return 1 unless ($lr_n * $lr_sx2 - $lr_sx**2); 85 return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / ($lr_n * $lr_sx2 - $lr_sx**2); 86} 87 88sub lr_A 89{ 90 &tagify($_[$[]) if defined($_[$[]); 91 92 return ($lr_sy - &lr_B * $lr_sx) / $lr_n; 93} 94 95sub lr_Y 96{ 97 &tagify($_[$[]) if defined($_[$[]); 98 99 return &lr_A + &lr_B * $_[$[]; 100} 101 102sub lr_X 103{ 104 &tagify($_[$[]) if defined($_[$[]); 105 106 return ($_[$[] - &lr_A) / &lr_B; 107} 108 109sub lr_r 110{ 111 &tagify($_[$[]) if defined($_[$[]); 112 113 local($s) = ($lr_n * $lr_sx2 - $lr_sx**2) * ($lr_n * $lr_sy2 - $lr_sy**2); 114 115 return 1 unless $s; 116 117 return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / sqrt($s); 118} 119 120sub lr_cov 121{ 122 &tagify($_[$[]) if defined($_[$[]); 123 124 return ($lr_sxy - $lr_sx * $lr_sy / $lr_n) / ($lr_n - 1); 125} 126 127sub lr_sigma 128{ 129 &tagify($_[$[]) if defined($_[$[]); 130 131 return 0 if $lr_n <= 1; 132 return sqrt(($lr_sy2 - ($lr_sy * $lr_sy) / $lr_n) / ($lr_n)); 133} 134 135sub lr_mean 136{ 137 &tagify($_[$[]) if defined($_[$[]); 138 139 return 0 if $lr_n <= 0; 140 return $lr_sy / $lr_n; 141} 142 143&lr_init(); 144 1451; 146