Tcl Library Source Code

Check-in [99ccba5f9f]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Take care of the exceptional situation that the dependent variable is constant in the multivariate regression procedure (ticket 51c03aac1a45161ab6cc59afb69d1768175e054c)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 99ccba5f9fa7ae961032e3012273c6542dc6f50692547e96af22a8c9bb375762
User & Date: arjenmarkus 2017-10-06 21:07:04
Context
2018-01-08
20:39
Add a new package math::PCA for principal components analysis check-in: 2c24d9d9c1 user: arjenmarkus tags: trunk
2017-10-16
10:45
Update Tool to 0.7. Added a new package amalgamation feature for tool that condenses all of the source code into a single tcl file. Added a new module tool-ui which is useful for tracking datatypes and used by taolib to split out html forms from tk forms and still retain business logic in common between them check-in: f7e6f30d93 user: hypnotoad tags: trunk
2017-10-06
21:07
Take care of the exceptional situation that the dependent variable is constant in the multivariate regression procedure (ticket 51c03aac1a45161ab6cc59afb69d1768175e054c) check-in: 99ccba5f9f user: arjenmarkus tags: trunk
2017-09-20
15:36
Better fix for ticket d74e418e84, [coroutine::util read] closes channel, and 104809e450, [coroutine::util read] swallows data. check-in: 5f6f135b2f user: pooryorick tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/math/ChangeLog.







1
2
3
4
5
6
7






2017-08-10  Arjen Markus <[email protected]>
	* geometry.test: Add tests for areaPolygon
	* geometry.tcl: Correct implementation of areaPolygon (ticket cb043ecc70e0e90bff93535d1d371a78b94f5d44)
2017-05-29  Arjen Markus <[email protected]>
	* geometry.test: Require at least Tcl 8.5
	* numtheory.man: Add description of Jacobi symbol
	* primes.tcl: Add Jacobi symbol
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2017-10-06  Arjen Markus <[email protected]>
	* mvlinreg.tcl: Special case for zero variation - then the correlation coefficient should be 1.0
	* statistics.test: Test that mv-ols is well behaved if the variation in the dependent variable is zero (ticket 51c03aac1a45161ab6cc59afb69d1768175e054c)
	* statistics.tcl: Bumped the version to 1.1.1
	* pkgIndex.tcl: Bumped the version of math::statistics to 1.1.1

2017-08-10  Arjen Markus <[email protected]>
	* geometry.test: Add tests for areaPolygon
	* geometry.tcl: Correct implementation of areaPolygon (ticket cb043ecc70e0e90bff93535d1d371a78b94f5d44)
2017-05-29  Arjen Markus <[email protected]>
	* geometry.test: Require at least Tcl 8.5
	* numtheory.man: Add description of Jacobi symbol
	* primes.tcl: Add Jacobi symbol

Changes to modules/math/mvlinreg.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# mvreglin.tcl --
#     Addition to the statistics package
#     Copyright 2007 Eric Kemp-Benedict
#     Released under the BSD license under any terms
#     that allow it to be compatible with tcllib

package require math::linearalgebra 1.0

# ::math::statistics --
#     This file adds:
#     mvlinreg = Multivariate Linear Regression
#
namespace eval ::math::statistics {
    variable epsilon 1.0e-7






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# mvreglin.tcl --
#     Addition to the statistics package
#     Copyright 2007 Eric Kemp-Benedict
#     Released under the BSD license under any terms
#     that allow it to be compatible with tcllib

package require math::linearalgebra 1.1.1

# ::math::statistics --
#     This file adds:
#     mvlinreg = Multivariate Linear Regression
#
namespace eval ::math::statistics {
    variable epsilon 1.0e-7
211
212
213
214
215
216
217

218



219
220
221
222
223
224
225
    set sstot 0.0
    set ssreg 0.0
    # Note: Relying on representation of Vector as a list for y, yhat
    foreach yval $y wt $w yhatval $yhat {
        set sstot [expr {$sstot + $wt * ($yval - $ymean) * ($yval - $ymean)}]
        set ssreg [expr {$ssreg + $wt * ($yhatval - $ymean) * ($yhatval - $ymean)}]
    }

    set r2 [expr {double($ssreg)/$sstot}]



    set adjr2 [expr {1.0 - (1.0 - $r2) * ($n - 1)/($n - $k)}]
    set sumsqresid [dotproduct $R $R]
    set s2 [expr {double($sumsqresid) / double($n - $k)}]

    ### -- Confidence intervals for coefficients
    set tvalue [tstat [expr {$n - $k}]]
    for {set i 0} {$i < $k} {incr i} {







>
|
>
>
>







211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    set sstot 0.0
    set ssreg 0.0
    # Note: Relying on representation of Vector as a list for y, yhat
    foreach yval $y wt $w yhatval $yhat {
        set sstot [expr {$sstot + $wt * ($yval - $ymean) * ($yval - $ymean)}]
        set ssreg [expr {$ssreg + $wt * ($yhatval - $ymean) * ($yhatval - $ymean)}]
    }
    if { $sstot != 0.0 } {
        set r2 [expr {double($ssreg)/$sstot}]
    } else {
        set r2 1.0
    }
    set adjr2 [expr {1.0 - (1.0 - $r2) * ($n - 1)/($n - $k)}]
    set sumsqresid [dotproduct $R $R]
    set s2 [expr {double($sumsqresid) / double($n - $k)}]

    ### -- Confidence intervals for coefficients
    set tvalue [tstat [expr {$n - $k}]]
    for {set i 0} {$i < $k} {incr i} {

Changes to modules/math/pkgIndex.tcl.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
package ifneeded math::fourier           1.0.2 [list source [file join $dir fourier.tcl]]

if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded math::roman             1.0   [list source [file join $dir romannumerals.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
# statistics depends on linearalgebra (for multi-variate linear regression).
package ifneeded math::statistics        1.1.0 [list source [file join $dir statistics.tcl]]
package ifneeded math::optimize          1.0.1 [list source [file join $dir optimize.tcl]]
package ifneeded math::calculus          0.8.1 [list source [file join $dir calculus.tcl]]
package ifneeded math::interpolate       1.1.1 [list source [file join $dir interpolate.tcl]]
package ifneeded math::linearalgebra     1.1.6 [list source [file join $dir linalg.tcl]]
package ifneeded math::bignum            3.1.1 [list source [file join $dir bignum.tcl]]
package ifneeded math::bigfloat          1.2.2 [list source [file join $dir bigfloat.tcl]]
package ifneeded math::machineparameters 0.1   [list source [file join $dir machineparameters.tcl]]







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
package ifneeded math::fourier           1.0.2 [list source [file join $dir fourier.tcl]]

if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded math::roman             1.0   [list source [file join $dir romannumerals.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
# statistics depends on linearalgebra (for multi-variate linear regression).
package ifneeded math::statistics        1.1.1 [list source [file join $dir statistics.tcl]]
package ifneeded math::optimize          1.0.1 [list source [file join $dir optimize.tcl]]
package ifneeded math::calculus          0.8.1 [list source [file join $dir calculus.tcl]]
package ifneeded math::interpolate       1.1.1 [list source [file join $dir interpolate.tcl]]
package ifneeded math::linearalgebra     1.1.6 [list source [file join $dir linalg.tcl]]
package ifneeded math::bignum            3.1.1 [list source [file join $dir bignum.tcl]]
package ifneeded math::bigfloat          1.2.2 [list source [file join $dir bigfloat.tcl]]
package ifneeded math::machineparameters 0.1   [list source [file join $dir machineparameters.tcl]]

Changes to modules/math/statistics.tcl.

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
# version 0.9:   added kernel density estimation
# version 0.9.3: added histogram-alt, corrected test-normal
# version 1.0:   added test-anova-F
# version 1.0.1: correction in pdf-lognormal and cdf-lognormal
# version 1.1:   added test-Tukey-range and test-Dunnett

package require Tcl 8.4
package provide math::statistics 1.1.0
package require math

if {![llength [info commands ::lrepeat]]} {
    # Forward portability, emulate lrepeat
    proc ::lrepeat {n args} {
	if {$n < 1} {
	    return -code error "must have a count of at least 1"







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
# version 0.9:   added kernel density estimation
# version 0.9.3: added histogram-alt, corrected test-normal
# version 1.0:   added test-anova-F
# version 1.0.1: correction in pdf-lognormal and cdf-lognormal
# version 1.1:   added test-Tukey-range and test-Dunnett

package require Tcl 8.4
package provide math::statistics 1.1.1
package require math

if {![llength [info commands ::lrepeat]]} {
    # Forward portability, emulate lrepeat
    proc ::lrepeat {n args} {
	if {$n < 1} {
	    return -code error "must have a count of at least 1"

Changes to modules/math/statistics.test.

509
510
511
512
513
514
515























516
517
518
519
520
521
522
} -result {0.887239767929 0.830859651893
3.33854942057 -1.58346976987 0.0362328113288 32.571621244
1.03305463908 0.237943867401 0.234143883673 19.4700016828
0.810755783819 5.86634305732
-2.16569743834 -1.00124210139 -0.536696631937 0.609162254594
-15.0697565684 80.2129990564}
























#
# pdf/cdf tests - transformed from the contributions by Eric K. Benedict
#                 Cf. the examples.
#
# Note: cases with integer numbers test if divisions are done in floating-point or not
#








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
} -result {0.887239767929 0.830859651893
3.33854942057 -1.58346976987 0.0362328113288 32.571621244
1.03305463908 0.237943867401 0.234143883673 19.4700016828
0.810755783819 5.86634305732
-2.16569743834 -1.00124210139 -0.536696631937 0.609162254594
-15.0697565684 80.2129990564}


test "Testmultivar-1.1" "Ordinary multivariate regression - zero variation" -body {
    set results [::math::statistics::mv-ols {{0 25125 128} {0 23224 64} {0 37903 512} {0 21263 32}
                                             {0 22053 64} {0 25745 256} {0 25745 256} {0 21557 32}
                                             {0 24935 128} {0 22904 64} {0 21422 32} {0 21947 32}
                                             {0 33244 512} {0 33244 512} {0 30060 512} {0 29691 256}
                                             {0 30439 256} {0 23724 128} {0 22541 64} {0 23640 128}
                                             {0 21422 32} {0 23640 128} {0 22249 64} {0 28247 512}
                                             {0 23333 32} {0 29841 256} {0 23959 128} {0 30819 512}
                                             {0 26333 256} {0 22145 32} {0 23863 128} {0 20772 32}
                                             {0 28511 512} {0 22425 64} {0 21598 32} {0 26335 256}
                                             {0 23816 128} {0 21157 32} {0 20973 32} {0 20973 32}
                                             {0 35125 512} {0 20679 32} {0 21241 64} {0 25297 256}
                                             {0 22301 32} {0 22007 32} {0 33351 512} {0 24115 128}
                                             {0 24115 128} {0 22301 32} {0 22797 64} {0 22593 64}
                                             {0 26439 256} {0 21255 32} {0 22645 32} {0 23447 128}
                                             {0 24205 64} {0 25051 128} {0 21007 32} {0 28237 256}
                                             {0 25546 128} {0 25669 256} {0 25669 256} {0 25669 256}
                                             {0 21977 64} {0 21977 64} {0 26187 128} {0 38360 512}
                                             {0 31846 256} {0 28349 256} {0 26450 128}}]
    set r2 [lindex $results 0]
} -result 1.0

#
# pdf/cdf tests - transformed from the contributions by Eric K. Benedict
#                 Cf. the examples.
#
# Note: cases with integer numbers test if divisions are done in floating-point or not
#