diff options
author | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
commit | 0065d5ab628975892cea1ec7303f968c3338cbe1 (patch) | |
tree | 8e2afe0ab48ee33cf95009809d67c9649573ef92 /utils/parallel/stats.pl | |
parent | 28a464a75e14cece5db40f2765a29348273ff2d2 (diff) | |
download | haskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz |
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.
The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level. The build system now makes no
pretense at being multi-project, it is just the GHC build system.
No doubt this will break many things, and there will be a period of
instability while we fix the dependencies. A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.
Diffstat (limited to 'utils/parallel/stats.pl')
-rw-r--r-- | utils/parallel/stats.pl | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/utils/parallel/stats.pl b/utils/parallel/stats.pl new file mode 100644 index 0000000000..6cf826b5cd --- /dev/null +++ b/utils/parallel/stats.pl @@ -0,0 +1,168 @@ +#!/usr/local/bin/perl +############################################################################## +# Time-stamp: <Sat Oct 28 1995 23:15:13 Stardate: [-31]6509.63 hwloidl> +# +# Usage: do .... +# +# Statistics package that is used in gran-extr, RTS2gran and friends. +# Most of the routines assume a list of integers as input. +# This package contains: +# - corr +# - mean_std_dev +# - cov +# - list_sum +# - list_max +# - list_min +# +############################################################################## + +# ---------------------------------------------------------------------------- +# Compute correlation of 2 vectors, having their sums precomputed. +# Usage: do corr(($n, $sum_1, @rest); +# +# Input: $n ... number of all elements in @list_1 as well as in @list_2 +# (i.e. $n = $#list_1+1 = $#list_2+1). +# $sum_1 ... sum of all elements in @list_1 +# @list_1 ... list of integers; first vector +# $sum_2 ... sum of all elements in @list_2 +# @list_2 ... list of integers; first vector +# Output: correlation of @list_1 and @list_2 +# ---------------------------------------------------------------------------- + +sub corr { + local ($n, $sum_1, @rest) = @_; + local (@list_1) = splice(@rest,0,$n); + local ($sum_2, @list_2) = @rest; + + local ($mean_1,$mean_2,$std_dev_1,$std_dev_2); + + if ( $opt_D ) { + print "\ncorr: n=$n sum_1=$sum_1 sum_2=$sum_2\n"; + print " list_sum of list_1=" . &list_sum(@list_1) . + " list_sum of list_2=" . &list_sum(@list_2) . "\n"; + print " len of list_1=$#list_1 len of list_2=$#list_2\n"; + } + + ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1); + ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2); + + if ( $opt_D ) { + print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n"; + } + + return ( ($std_dev_1 * $std_dev_2) == 0 ? + 0 : + &cov($n, $mean_1, @list_1, $mean_2, @list_2) / + ( $std_dev_1 * $std_dev_2 ) ); +} + +# ---------------------------------------------------------------------------- + +sub mean_std_dev { + local ($sum,@list) = @_; + local ($n, $s, $s_); + + #print "\nmean_std_dev: sum is $sum ; list has length $#list"; + + $n = $#list+1; + $mean_value = $sum/$n; + + $s_ = 0; + foreach $x (@list) { + $s_ += $x; + $s += ($mean_value - $x) ** 2; + } + if ( $sum != $s_ ) { + print "stat.pl: ERROR in mean_std_dev: provided sum is wrong " . + "(provided: $sum; computed: $s_ " . + ";list_sum: " . &list_sum(@list) . "\n"; + exit (2); + } + + return ( ($mean_value, sqrt($s / ($n - 1)) ) ); +} + +# ---------------------------------------------------------------------------- + +sub _mean_std_dev { + return ( &mean_std_dev(&list_sum(@_), @_) ); +} + +# ---------------------------------------------------------------------------- +# Compute covariance of 2 vectors, having their sums precomputed. +# Input: $n ... number of all elements in @list_1 as well as in @list_2 +# (i.e. $n = $#list_1+1 = $#list_2+1). +# $mean_1 ... mean value of all elements in @list_1 +# @list_1 ... list of integers; first vector +# $mean_2 ... mean value of all elements in @list_2 +# @list_2 ... list of integers; first vector +# Output: covariance of @list_1 and @list_2 +# ---------------------------------------------------------------------------- + +sub cov { + local ($n, $mean_1, @rest) = @_; + local (@list_1) = splice(@rest,0,$n); + local ($mean_2, @list_2) = @rest; + + local ($i,$s,$s_1,$s_2); + + for ($i=0; $i<$n; $i++) { + $s_1 += $list_1[$i]; + $s_2 += $list_2[$i]; + $s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]); + } + if ( $mean_1 != ($s_1/$n) ) { + print "stat.pl: ERROR in cov: provided mean value is wrong " . + "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n"; + exit (2); + } + if ( $mean_2 != ($s_2/$n) ) { + print "stat.pl: ERROR in cov: provided mean value is wrong " . + "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n"; + exit (2); + } + return ( $s / ($n - 1) ) ; +} + +# --------------------------------------------------------------------------- + +sub list_sum { + local (@list) = @_; + local ($sum) = (0); + + foreach $x (@list) { + $sum += $x; + } + + return ($sum); +} + +# ---------------------------------------------------------------------------- + +sub list_max { + local (@list) = @_; + local ($max) = shift; + + foreach $x (@list) { + $max = $x if $x > $max; + } + + return ($max); +} + +# ---------------------------------------------------------------------------- + +sub list_min { + local (@list) = @_; + local ($min) = shift; + + foreach $x (@list) { + $min = $x if $x < $min; + } + + return ($min); +} + +# ---------------------------------------------------------------------------- + +1; |