146 lines
2.8 KiB
Perl
146 lines
2.8 KiB
Perl
|
;#
|
||
|
|
;# 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;
|