/contrib/ntp/scripts/monitoring/lr.pl

https://bitbucket.org/freebsd/freebsd-head/ · Perl · 151 lines · 113 code · 27 blank · 11 comment · 2 complexity · 6dacf496e49ef68e1577385ec0a3b8be MD5 · raw file

  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. ;# Copyright (c) 1997 by
  13. ;# Ulrich Windl <Ulrich.Windl@rz.uni-regensburg.de>
  14. ;# (Converted to a PERL 5.004 package)
  15. ;#
  16. ;#############################################################
  17. package lr;
  18. ##
  19. ## y = A + Bx
  20. ##
  21. ## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2)
  22. ##
  23. ## A = (Sum(y) - B * Sum(x)) / n
  24. ##
  25. ##
  26. ## interface
  27. ##
  28. ;# init(tag); initialize data set for tag
  29. ;# sample(x, y, tag); enter sample
  30. ;# Y(x, tag); compute y for given x
  31. ;# X(y, tag); compute x for given y
  32. ;# r(tag); regression coefficient
  33. ;# cov(tag); covariance
  34. ;# A(tag);
  35. ;# B(tag);
  36. ;# sigma(tag); standard deviation
  37. ;# mean(tag);
  38. #########################
  39. sub init
  40. {
  41. my $self = shift;
  42. $self->{n} = 0;
  43. $self->{sx} = 0.0;
  44. $self->{sx2} = 0.0;
  45. $self->{sxy} = 0.0;
  46. $self->{sy} = 0.0;
  47. $self->{sy2} = 0.0;
  48. }
  49. sub sample($$)
  50. {
  51. my $self = shift;
  52. my($_x, $_y) = @_;
  53. ++($self->{n});
  54. $self->{sx} += $_x;
  55. $self->{sy} += $_y;
  56. $self->{sxy} += $_x * $_y;
  57. $self->{sx2} += $_x**2;
  58. $self->{sy2} += $_y**2;
  59. }
  60. sub B()
  61. {
  62. my $self = shift;
  63. return 1 unless ($self->{n} * $self->{sx2} - $self->{sx}**2);
  64. return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy})
  65. / ($self->{n} * $self->{sx2} - $self->{sx}**2);
  66. }
  67. sub A()
  68. {
  69. my $self = shift;
  70. return ($self->{sy} - B() * $self->{sx}) / $self->{n};
  71. }
  72. sub Y()
  73. {
  74. my $self = shift;
  75. return A() + B() * $_[$[];
  76. }
  77. sub X()
  78. {
  79. my $self = shift;
  80. return ($_[$[] - A()) / B();
  81. }
  82. sub r()
  83. {
  84. my $self = shift;
  85. my $s = ($self->{n} * $self->{sx2} - $self->{sx}**2)
  86. * ($self->{n} * $self->{sy2} - $self->{sy}**2);
  87. return 1 unless $s;
  88. return ($self->{n} * $self->{sxy} - $self->{sx} * $self->{sy}) / sqrt($s);
  89. }
  90. sub cov()
  91. {
  92. my $self = shift;
  93. return ($self->{sxy} - $self->{sx} * $self->{sy} / $self->{n})
  94. / ($self->{n} - 1);
  95. }
  96. sub sigma()
  97. {
  98. my $self = shift;
  99. return 0 if $self->{n} <= 1;
  100. return sqrt(($self->{sy2} - ($self->{sy} * $self->{sy}) / $self->{n})
  101. / ($self->{n}));
  102. }
  103. sub mean()
  104. {
  105. my $self = shift;
  106. return 0 if $self->{n} <= 0;
  107. return $self->{sy} / $self->{n};
  108. }
  109. sub new
  110. {
  111. my $class = shift;
  112. my $self = {
  113. (n => undef,
  114. sx => undef,
  115. sx2 => undef,
  116. sxy => undef,
  117. sy => undef,
  118. sy2 => undef)
  119. };
  120. bless $self, $class;
  121. init($self);
  122. return $self;
  123. }
  124. 1;