2 ##############################################################################
3 # Time-stamp: <Sat Oct 28 1995 23:15:13 Stardate: [-31]6509.63 hwloidl>
7 # Statistics package that is used in gran-extr, RTS2gran and friends.
8 # Most of the routines assume a list of integers as input.
9 # This package contains:
17 ##############################################################################
19 # ----------------------------------------------------------------------------
20 # Compute correlation of 2 vectors, having their sums precomputed.
21 # Usage: do corr(($n, $sum_1, @rest);
23 # Input: $n ... number of all elements in @list_1 as well as in @list_2
24 # (i.e. $n = $#list_1+1 = $#list_2+1).
25 # $sum_1 ... sum of all elements in @list_1
26 # @list_1 ... list of integers; first vector
27 # $sum_2 ... sum of all elements in @list_2
28 # @list_2 ... list of integers; first vector
29 # Output: correlation of @list_1 and @list_2
30 # ----------------------------------------------------------------------------
33 local ($n, $sum_1, @rest) = @_;
34 local (@list_1) = splice(@rest,0,$n);
35 local ($sum_2, @list_2) = @rest;
37 local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
40 print "\ncorr: n=$n sum_1=$sum_1 sum_2=$sum_2\n";
41 print " list_sum of list_1=" . &list_sum(@list_1) .
42 " list_sum of list_2=" . &list_sum(@list_2) . "\n";
43 print " len of list_1=$#list_1 len of list_2=$#list_2\n";
46 ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1);
47 ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2);
50 print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
53 return ( ($std_dev_1 * $std_dev_2) == 0 ?
55 &cov($n, $mean_1, @list_1, $mean_2, @list_2) /
56 ( $std_dev_1 * $std_dev_2 ) );
59 # ----------------------------------------------------------------------------
62 local ($sum,@list) = @_;
65 #print "\nmean_std_dev: sum is $sum ; list has length $#list";
68 $mean_value = $sum/$n;
73 $s += ($mean_value - $x) ** 2;
76 print "stat.pl: ERROR in mean_std_dev: provided sum is wrong " .
77 "(provided: $sum; computed: $s_ " .
78 ";list_sum: " . &list_sum(@list) . "\n";
82 return ( ($mean_value, sqrt($s / ($n - 1)) ) );
85 # ----------------------------------------------------------------------------
88 return ( &mean_std_dev(&list_sum(@_), @_) );
91 # ----------------------------------------------------------------------------
92 # Compute covariance of 2 vectors, having their sums precomputed.
93 # Input: $n ... number of all elements in @list_1 as well as in @list_2
94 # (i.e. $n = $#list_1+1 = $#list_2+1).
95 # $mean_1 ... mean value of all elements in @list_1
96 # @list_1 ... list of integers; first vector
97 # $mean_2 ... mean value of all elements in @list_2
98 # @list_2 ... list of integers; first vector
99 # Output: covariance of @list_1 and @list_2
100 # ----------------------------------------------------------------------------
103 local ($n, $mean_1, @rest) = @_;
104 local (@list_1) = splice(@rest,0,$n);
105 local ($mean_2, @list_2) = @rest;
107 local ($i,$s,$s_1,$s_2);
109 for ($i=0; $i<$n; $i++) {
112 $s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
114 if ( $mean_1 != ($s_1/$n) ) {
115 print "stat.pl: ERROR in cov: provided mean value is wrong " .
116 "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n";
119 if ( $mean_2 != ($s_2/$n) ) {
120 print "stat.pl: ERROR in cov: provided mean value is wrong " .
121 "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n";
124 return ( $s / ($n - 1) ) ;
127 # ---------------------------------------------------------------------------
140 # ----------------------------------------------------------------------------
144 local ($max) = shift;
147 $max = $x if $x > $max;
153 # ----------------------------------------------------------------------------
157 local ($min) = shift;
160 $min = $x if $x < $min;
166 # ----------------------------------------------------------------------------