[Shootout-list] update to Tcl statistics test
Randy Melton
rmelton@atmel.com
Mon, 21 Mar 2005 18:09:00 -0500
--------------Boundary-00=_0N5QZDAOHUH069CX46IL
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: 8bit
Looking at the Tcl code, it depends on the fact that the list is integers.
(The description says they are doubles) If in fact they are integers
I have a couple of enhancements that result in a slight speedup...
So as much as I regret it I must submit a fix that deals with doubles.
(Note that I did move the lsort near the top to force list conversion
to a list of doubles as early as possible.)
randy melton
--------------Boundary-00=_0N5QZDAOHUH069CX46IL
Content-Type: text/plain;
charset="iso-8859-1";
name="statistics.tcl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment; filename="statistics.tcl"
#!/usr/bin/tclsh
# $Id: moments-tcl.code,v 1.4 2004/11/13 07:42:20 bfulgham Exp $
# http://www.bagley.org/~doug/shootout/
proc main {} {
set sum 0.0
set nums [lsort -real [read stdin]]
foreach num $nums {
=09set sum [expr {$sum + $num}]
}
set n [llength $nums]
set mean [expr {$sum / $n}]
set average_deviation 0.0
set standard_deviation 0.0
set variance 0.0
set skew 0.0
set kurtosis 0.0
foreach num $nums {
set deviation [expr {$num - $mean}]
set average_deviation [expr {$average_deviation + abs($deviation)=
}]
set variance [expr {$variance + pow($deviation, 2)}]
set skew [expr {$skew + pow($deviation, 3)}]
set kurtosis [expr {$kurtosis + pow($deviation, 4)}]
}
set average_deviation [expr {$average_deviation / $n}]
set variance [expr {$variance / ($n - 1)}]
set standard_deviation [expr {sqrt($variance)}]
if {$variance} {
set skew [expr {$skew / ($n * $variance * $standard_deviation)}]
set kurtosis [expr {($kurtosis / ($n * $variance * $variance)) - =
3.0}]
}
set mid [expr {int($n / 2)}]
if [expr {$n % 2}] {
set median [lindex $nums $mid]
} else {
set a [lindex $nums $mid]
set b [lindex $nums [expr {$mid - 1}]]
set median [expr {($a + $b) / 2.0}]
}
puts [format "n: %d" $n]
puts [format "median: %f" $median]
puts [format "mean: %f" $mean]
puts [format "average_deviation: %f" $average_deviation]
puts [format "standard_deviation: %f" $standard_deviation]
puts [format "variance: %f" $variance]
puts [format "skew: %f" $skew]
puts [format "kurtosis: %f" $kurtosis]
}
main
--------------Boundary-00=_0N5QZDAOHUH069CX46IL--