home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / x / xntp3.zip / monitoring / lr.pl < prev    next >
Perl Script  |  1992-07-09  |  2KB  |  115 lines
  1. ##
  2. ## Linear Regression Package for perl
  3. ## intended to be 'required'
  4. ##
  5.  
  6. ##
  7. ## y = A + Bx
  8. ##
  9. ## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2)
  10. ##
  11. ## A = (Sum(y) - B * Sum(x)) / n
  12. ##
  13.  
  14. *lr_init   = *lr'lr_init;
  15. *lr_sample = *lr'lr_sample;
  16. *lr_Y      = *lr'lr_Y;
  17. *lr_X      = *lr'lr_X;
  18. *lr_r      = *lr'lr_r;
  19. *lr_cov    = *lr'lr_cov;
  20. *lr_A      = *lr'lr_A;
  21. *lr_B      = *lr'lr_B;
  22.  
  23. package lr;
  24.  
  25. sub tagify
  26. {
  27.     local($tag) = @_;
  28.     if (defined($tag))
  29.     {
  30.       *lr_n   = eval "*${tag}_n";
  31.       *lr_sx  = eval "*${tag}_sx";
  32.       *lr_sx2 = eval "*${tag}_sx2";
  33.       *lr_sxy = eval "*${tag}_sxy";
  34.       *lr_sy  = eval "*${tag}_sy";
  35.       *lr_sy2 = eval "*${tag}_sy2";
  36.     }
  37. }
  38.  
  39. sub lr_init
  40. {
  41.     &tagify($_[$[]) if defined($_[$[]);
  42.  
  43.     $lr_n   = 0;
  44.     $lr_sx  = 0.0;
  45.     $lr_sx2 = 0.0;
  46.     $lr_sxy = 0.0;
  47.     $lr_sy  = 0.0;
  48.     $lr_sy2 = 0.0;
  49. }
  50.  
  51. sub lr_sample
  52. {
  53.     local($_x, $_y) = @_;
  54.  
  55.     &tagify($_[$[+2]) if defined($_[$[+2]);
  56.  
  57.     $lr_n++;
  58.     $lr_sx  += $_x;
  59.     $lr_sy  += $_y;
  60.     $lr_sxy += $_x * $_y;
  61.     $lr_sx2 += $_x**2;
  62.     $lr_sy2 += $_y**2;
  63. }
  64.  
  65. sub lr_B
  66. {
  67.     &tagify($_[$[]) if defined($_[$[]);
  68.  
  69.     return 1 unless ($lr_n * $lr_sx2 - $lr_sx**2);
  70.     return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / ($lr_n * $lr_sx2 - $lr_sx**2);
  71. }
  72.  
  73. sub lr_A
  74. {
  75.     &tagify($_[$[]) if defined($_[$[]);
  76.  
  77.     return ($lr_sy - &lr_B * $lr_sx) / $lr_n;
  78. }
  79.  
  80. sub lr_Y
  81. {
  82.     &tagify($_[$[]) if defined($_[$[]);
  83.  
  84.     return &lr_A + &lr_B * $_[$[];
  85. }
  86.  
  87. sub lr_X
  88. {
  89.     &tagify($_[$[]) if defined($_[$[]);
  90.  
  91.     return ($_[$[] - &lr_A) / &lr_B;
  92. }
  93.  
  94. sub lr_r
  95. {
  96.     &tagify($_[$[]) if defined($_[$[]);
  97.  
  98.     local($s) = ($lr_n * $lr_sx2 - $lr_sx**2) * ($lr_n * $lr_sy2 - $lr_sy**2);
  99.  
  100.     return 1 unless $s;
  101.     
  102.     return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / sqrt($s);
  103. }
  104.  
  105. sub lr_cov
  106. {
  107.     &tagify($_[$[]) if defined($_[$[]);
  108.  
  109.     return ($lr_sxy - $lr_sx * $lr_sy / $lr_n) / ($lr_n - 1);
  110. }
  111.  
  112. &lr_init();
  113.  
  114. 1;
  115.