ghc/utils/parallel/stats.pl

   1 #!/usr/local/bin/perl
   2 ##############################################################################
   3 # Time-stamp: <Sat Oct 28 1995 23:15:13 Stardate: [-31]6509.63 hwloidl>
   4 #
   5 # Usage: do ....
   6 #
   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:
  10 #  - corr
  11 #  - mean_std_dev
  12 #  - cov
  13 #  - list_sum
  14 #  - list_max
  15 #  - list_min
  16 #
  17 ##############################################################################
  18
  19 # ----------------------------------------------------------------------------
  20 # Compute correlation of 2 vectors, having their sums precomputed.
  21 # Usage:  do corr(($n, $sum_1, @rest);
  22 #
  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 # ----------------------------------------------------------------------------
  31
  32 sub corr {
  33     local ($n, $sum_1, @rest) = @_;
  34     local (@list_1) = splice(@rest,0,$n);
  35     local ($sum_2, @list_2) = @rest;
  36
  37     local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
  38
  39     if ( $opt_D ) {
  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";
  44     }
  45
  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);
  48
  49     if ( $opt_D ) {
  50       print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
  51     }
  52
  53     return ( ($std_dev_1 * $std_dev_2) == 0  ?
  54                0 :
  55                &cov($n, $mean_1, @list_1, $mean_2, @list_2) /
  56                ( $std_dev_1 * $std_dev_2 ) );
  57 }
  58
  59 # ----------------------------------------------------------------------------
  60
  61 sub mean_std_dev {
  62     local ($sum,@list) = @_;
  63     local ($n, $s, $s_);
  64
  65     #print "\nmean_std_dev: sum is $sum ; list has length $#list";
  66
  67     $n = $#list+1;
  68     $mean_value = $sum/$n;
  69
  70     $s_ = 0;
  71     foreach $x (@list) {
  72         $s_ += $x;
  73         $s += ($mean_value - $x) ** 2;
  74     }
  75     if ( $sum != $s_ ) {
  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";
  79       exit (2);
  80     }
  81
  82     return ( ($mean_value, sqrt($s / ($n - 1)) ) );
  83 }
  84
  85 # ----------------------------------------------------------------------------
  86
  87 sub _mean_std_dev {
  88     return ( &mean_std_dev(&list_sum(@_), @_) );
  89 }
  90
  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 # ----------------------------------------------------------------------------
 101
 102 sub cov {
 103     local ($n, $mean_1, @rest) = @_;
 104     local (@list_1) = splice(@rest,0,$n);
 105     local ($mean_2, @list_2) = @rest;
 106
 107     local ($i,$s,$s_1,$s_2);
 108
 109     for ($i=0; $i<$n; $i++) {
 110         $s_1 += $list_1[$i];
 111         $s_2 += $list_2[$i];
 112         $s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
 113     }
 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";
 117       exit (2);
 118     }
 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";
 122       exit (2);
 123     }
 124     return ( $s / ($n - 1) ) ;
 125 }
 126
 127 # ---------------------------------------------------------------------------
 128
 129 sub list_sum {
 130     local (@list) = @_;
 131     local ($sum) = (0);
 132
 133     foreach $x (@list) {
 134         $sum += $x;
 135     }
 136
 137     return ($sum);
 138 }
 139
 140 # ----------------------------------------------------------------------------
 141
 142 sub list_max {
 143     local (@list) = @_;
 144     local ($max) = shift;
 145
 146     foreach $x (@list) {
 147         $max = $x  if $x > $max;
 148     }
 149
 150     return ($max);
 151 }
 152
 153 # ----------------------------------------------------------------------------
 154
 155 sub list_min {
 156     local (@list) = @_;
 157     local ($min) = shift;
 158
 159     foreach $x (@list) {
 160         $min = $x  if $x < $min;
 161     }
 162
 163     return ($min);
 164 }
 165
 166 # ----------------------------------------------------------------------------
 167
 168 1;