/usr/share/perl5/Statistics/Basic/Covariance.pm is in libstatistics-basic-perl 1.6607-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | package Statistics::Basic::Covariance;
use strict;
use warnings;
use Carp;
use base 'Statistics::Basic::_TwoVectorBase';
# new {{{
sub new {
my $class = shift;
my @var1 = (shift || ());
my @var2 = (shift || ());
my $v1 = eval { Statistics::Basic::Vector->new( @var1 ) } or croak $@;
my $v2 = eval { Statistics::Basic::Vector->new( @var2 ) } or croak $@;
my $c = $v1->_get_linked_computer( covariance => $v2 );
return $c if $c;
my $this = bless({'v1'=>$v1, 'v2'=>$v2}, $class);
warn "[new " . ref($this) . " v1:$this->{v1} v2:$this->{v2}]\n" if $Statistics::Basic::DEBUG >= 2;
$this->{_vectors} = [ $v1, $v2 ];
$this->{m1} = eval { Statistics::Basic::Mean->new($v1) } or croak $@;
$this->{m2} = eval { Statistics::Basic::Mean->new($v2) } or croak $@;
$v1->_set_linked_computer( covariance => $this, $v2 );
$v2->_set_linked_computer( covariance => $this, $v1 );
return $this;
}
# }}}
# _recalc {{{
sub _recalc {
my $this = shift;
my $sum = 0;
my $v1 = $this->{v1};
my $v2 = $this->{v2};
my $c1 = $v1->query_size;
my $c2 = $v2->query_size;
warn "[recalc " . ref($this) . "] (\$c1, \$c2) = ($c1, $c2)\n" if $Statistics::Basic::DEBUG;
confess "the two vectors in a " . ref($this) . " object must be the same length ($c2!=$c1)" unless $c2 == $c1;
my $cardinality = $c1;
$cardinality -- if $Statistics::Basic::UNBIAS;
delete $this->{recalc_necessary};
delete $this->{_value};
return unless $cardinality > 0;
return unless $v1->query_filled;
return unless $v2->query_filled;
$v1 = $v1->query;
$v2 = $v2->query;
my $m1 = $this->{m1}->query;
my $m2 = $this->{m2}->query;
if( $Statistics::Basic::DEBUG >= 2 ) {
for my $i (0 .. $#$v1) {
warn "[recalc " . ref($this) . "] ( $v1->[$i] - $m1 ) * ( $v2->[$i] - $m2 )\n";
}
}
for my $i (0 .. $#$v1) {
no warnings 'uninitialized'; ## no critic
$sum += ( $v1->[$i] - $m1 ) * ( $v2->[$i] - $m2 );
}
$this->{_value} = ($sum / $cardinality);
warn "[recalc " . ref($this) . "] ($sum/$cardinality) = $this->{_value}\n" if $Statistics::Basic::DEBUG;
return;
}
# }}}
# query_vector1 {{{
sub query_vector1 {
my $this = shift;
return $this->{v1};
}
# }}}
# query_vector2 {{{
sub query_vector2 {
my $this = shift;
return $this->{v2};
}
# }}}
# query_mean1 {{{
sub query_mean1 {
my $this = shift;
return $this->{m1};
}
# }}}
# query_mean2 {{{
sub query_mean2 {
my $this = shift;
return $this->{m2};
}
# }}}
1;
|