[Shootout-list] update to Tcl statistics test (resend)

Randy Melton rmelton@atmel.com
Tue, 22 Mar 2005 13:50:35 -0500


--------------Boundary-00=_BCORS9SNPRW3Y6KULQ75
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=_BCORS9SNPRW3Y6KULQ75
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=_BCORS9SNPRW3Y6KULQ75--