Tcl Library Source Code

2014-01-19  Arjen Markus <[email protected]>
	* stat_kernel.tcl: Corrected use of bandwidth
	* statistics.test: Added margin per kernel - not quite satisfactory in the case of the uniform kernel

2014-01-18  Arjen Markus <[email protected]>
	* statistics.tcl: Added stat_kernel.tcl
	* stat_kernel.tcl: Implements a straightforward kernel density estimation procedure
	* statistics.man: Describe the kernel denstity estimation procedure, moved the description of several
	                  tests to the general section
	* statistics.test: Added three tests for the kernel density estimation (note: one result is a bit troublesome)
	* pkgIndex.tcl: Bumped version of statistics package to 0.9

        lappend xvalue [expr {$xb + $i * $dx}]
    }

    #
    # Construct the density function
    #
    set density {}
    set scale   [expr {1.0/$opt(-bandwidth)}]
    foreach x $xvalue {
        set sum 0.0
        foreach d $data w $weight {
            if { $d != {} } {
                set kvalue [$opt(-kernel) [expr {$scale * ($x-$d)}]]
                set sum [expr {$sum + $w * $kvalue}]
            }
        }
        lappend density [expr {$sum * $scale}]
    }

    #
    # Return the result
    #
    return [list $xvalue $density [list $xbegin $xend $mean $stdev $opt(-bandwidth)]]
}

# gaussian, uniform, triangular, epanechnikov, biweight, cosine, logistic --
#    The Gaussian kernel
#
# Arguments:
#    x            (Scaled) argument

test "spearman-rank-extended-1.0" "Test extended Spearman rank correlation procedure" -match tolerant -body {
    ::math::statistics::spearman-rank-extended {106  86 100 101  99 103  97 113 112 110} \
                                               {  7   0  27  50  28  29  20  12   6  17}
} -result {-0.175757575758 10 -0.456397284}

#
# Note: for the uniform and the logistic kernel the sum deviates more from 1 than for the others.
# For the logistic kernel this is because the density function is very widespread. For the
# uniform kernel the reason is not quite clear. Hence the margin per kernel.
#
test "kernel-density-1.0" "Test various kernel functions" -body {
    set data {1 2 3 4 5 6 7 8 9 10}

    set roughlyOne {}

    foreach kernel {gaussian uniform triangular epanechnikov biweight cosine logistic} \
            margin {0.01     0.02    0.01       0.01         0.01     0.01   0.05    } {
        set result [::math::statistics::kernel-density $data -kernel $kernel]

        set sum 0.0
        set xbegin [lindex $result 2 0]
        set xend   [lindex $result 2 1]
        set number [llength [lindex $result 0]]
        set dx     [expr {($xend-$xbegin) / $number}]

        #
        # Integral should be roughly one
        #
        set sum 0.0
        foreach v [lindex $result 1] {
            set sum [expr {$sum + $dx * $v}]
        }

        lappend roughlyOne [expr {abs($sum-1.0) < $margin}]
    }

    return $roughlyOne
} -result {1 1 1 1 1 1 1}

test "kernel-density-1.1" "Test various options - just that they have effect" -body {
    set subResults {}

    set data {1 2 3 4 5 6 7 8 9 10}

    set result [::math::statistics::kernel-density $data -number 20]