Tk Library Source Code

Artifact [f21b03ee85]
Login

Artifact f21b03ee855a306d22b27f3b2ca841a83b22538d:

Attachment "pnorm_ekb.tcl" to ticket [1847125fff] added by erickb 2007-12-09 11:33:33.
# pnorm_ekb --
#     Calculate the cumulative distribution function (cdf)
#     for the standard normal distribution like in the statistical
#     software 'R' (mean=0 and sd=1)
#
# Arguments:
#     x               Value for which the cdf should be calculated
#
# Result:
#     Value of the statistic D
#
## The "_ekb" version includes edits by Eric Kemp-Benedict, who
## had to evaluate values at large x. This now switches between
## the power series (there already) and a continued fraction expansion.
##
## Continued fraction is from Abramowitz & Stegun, eqn 26.2.14
##
## Also some minor changes for clarity
proc pnorm_ekb {x {tol 1.0e-20}} {
    set overflow 1.0e37
    #
    # cumulative distribution function (cdf)
    # for the standard normal distribution like in the statistical software 'R'
    # (mean=0 and sd=1)
    #
    # x -> value for which the cdf should be calculated
    #
    
    # Calculate Z(x), the pdf at x. The constant is ln(sqrt(2 * pi))
    set Z [expr {exp(-0.5 * $x*$x - 0.91893853320467274178)}]
    
    # Somewhat arbitrary cutoff: value here is 1 within 1e-5
    if {abs($x) < 4.0} {
        # Power series
        set sum [expr {double($x)}]
        set oldSum 0.0
        set i 1
        set denom 1.0
        while {abs($sum - $oldSum) > $tol} {
                set oldSum $sum
                incr i 2
                set denom [expr {$denom*$i}]
                set sum [expr {$oldSum + pow($x,$i)/$denom}]
        }
        return [expr {0.5 + $sum *$Z}]
    } else {
        # Continued fraction
        set t [expr {abs($x)}]
        set a 1
        set first true
        set A0 1.0
        set B0 0.0
        set A1 0.0
        set B1 1.0
        set exp [expr {1.0 * $A1/$B1}]
        while {1} {
            set A2 [expr {$t * $A1 + $a * $A0}]
            set B2 [expr {$t * $B1 + $a * $B0}]
            if {$first} {
                set first false
            } else {
                incr a
            }
            set newexp [expr {1.0 * $A2/$B2}]
            if {abs($newexp - $exp) < $tol} {
                break
            }
            set exp $newexp
            set A0 $A1
            set B0 $B1
            set A1 $A2
            set B1 $B2
            # Too big? Rescale
            if {abs($A2) >= $overflow} {
                set A0 [expr {$A0 / $overflow}]
                set A1 [expr {$A1 / $overflow}]
                set B0 [expr {$B0 / $overflow}]
                set B1 [expr {$B1 / $overflow}]
            }
        }
        if {$x > 0} {
            return [expr {1.0 - $Z * $exp}]
        } else {
            return [expr {$Z * $exp}]
        }
    }
}

####################################################################################
##
## TEST
##
## Run for a large range of values and print result
##
###################################################################################
console show
for {set x -10} {$x <= 10} {set x [expr {$x + 0.2}]} {puts [pnorm_ekb $x]}

## The output from the test compared to Excel's NORMSDIST() function, with
##    selected values from R:
 # x    pnorm_ekb       Excel   Selected R values
 # -10.0 7.6198530E-24	0.0000000E+00  From R: 7.619853e-24
 # -9.8	5.6292823E-23	0.0000000E+00
 # -9.6	3.9972212E-22	0.0000000E+00
 # -9.4	2.7281536E-21	0.0000000E+00
 # -9.2	1.7897488E-20	0.0000000E+00
 # -9.0	1.1285884E-19	0.0000000E+00
 # -8.8	6.8408077E-19	0.0000000E+00
 # -8.6	3.9858050E-18	0.0000000E+00
 # -8.4	2.2323932E-17	0.0000000E+00
 # -8.2	1.2019352E-16	1.1102230E-16
 # -8.0	6.2209606E-16	6.6613381E-16
 # -7.8	3.0953588E-15	3.1086245E-15
 # -7.6	1.4806537E-14	1.4988011E-14
 # -7.4	6.8092249E-14	6.8611783E-14
 # -7.2	3.0106280E-13	3.0320191E-13
 # -7.0	1.2798125E-12	1.2880808E-12  From R: 1.279813e-12
 # -6.8	5.2309575E-12	5.2615690E-12
 # -6.6	2.0557889E-11	2.0665247E-11
 # -6.4	7.7688476E-11	7.8049012E-11
 # -6.2	2.8231580E-10	2.8347136E-10
 # -6.0	9.8658765E-10	9.9012187E-10
 # -5.8	3.3157460E-09	3.3260517E-09
 # -5.6	1.0717590E-08	1.0746217E-08
 # -5.4	3.3320448E-08	3.3396123E-08
 # -5.2	9.9644263E-08	9.9834400E-08
 # -5.0	2.8665157E-07	2.8710500E-07   From R: 2.866516e-07
 # -4.8	7.9332815E-07	7.9435267E-07
 # -4.6	2.1124547E-06	2.1146434E-06
 # -4.4	5.4125439E-06	5.4169531E-06
 # -4.2	1.3345749E-05	1.3354097E-05
 # -4.0	3.1671242E-05	3.1686035E-05
 # -3.8	7.2348044E-05	7.2372434E-05
 # -3.6	1.5910859E-04	1.5914571E-04
 # -3.4	3.3692927E-04	3.3698082E-04
 # -3.2	6.8713794E-04	6.8720208E-04
 # -3.0	1.3498980E-03	1.3499672E-03
 # -2.8	2.5551303E-03	2.5551906E-03
 # -2.6	4.6611880E-03	4.6612218E-03
 # -2.4	8.1975359E-03	8.1975289E-03
 # -2.2	1.3903448E-02	1.3903399E-02
 # -2.0	2.2750132E-02	2.2750062E-02
 # -1.8	3.5930319E-02	3.5930266E-02
 # -1.6	5.4799292E-02	5.4799289E-02
 # -1.4	8.0756659E-02	8.0756711E-02
 # -1.2	1.1506967E-01	1.1506973E-01
 # -1.0	1.5865525E-01	1.5865526E-01
 # -0.8	2.1185540E-01	2.1185533E-01
 # -0.6	2.7425312E-01	2.7425306E-01
 # -0.4	3.4457826E-01	3.4457830E-01
 # -0.2	4.2074029E-01	4.2074031E-01
 # 0.0	5.0000000E-01	5.0000000E-01
 # 0.2	5.7925971E-01	5.7925969E-01
 # 0.4	6.5542174E-01	6.5542170E-01
 # 0.6	7.2574688E-01	7.2574694E-01
 # 0.8	7.8814460E-01	7.8814467E-01
 # 1.0	8.4134475E-01	8.4134474E-01
 # 1.2	8.8493033E-01	8.8493027E-01
 # 1.4	9.1924334E-01	9.1924329E-01
 # 1.6	9.4520071E-01	9.4520071E-01
 # 1.8	9.6406968E-01	9.6406973E-01
 # 2.0	9.7724987E-01	9.7724994E-01
 # 2.2	9.8609655E-01	9.8609660E-01
 # 2.4	9.9180246E-01	9.9180247E-01
 # 2.6	9.9533881E-01	9.9533878E-01
 # 2.8	9.9744487E-01	9.9744481E-01
 # 3.0	9.9865010E-01	9.9865003E-01
 # 3.2	9.9931286E-01	9.9931280E-01
 # 3.4	9.9966307E-01	9.9966302E-01
 # 3.6	9.9984089E-01	9.9984085E-01
 # 3.8	9.9992765E-01	9.9992763E-01
 # 4.0	9.9996833E-01	9.9996831E-01
 # 4.2	9.9998665E-01	9.9998665E-01
 # 4.4	9.9999459E-01	9.9999458E-01
 # 4.6	9.9999789E-01	9.9999789E-01
 # 4.8	9.9999921E-01	9.9999921E-01
 # 5.0	9.9999971E-01	9.9999971E-01
 # 5.2	9.9999990E-01	9.9999990E-01
 # 5.4	9.9999997E-01	9.9999997E-01
 # 5.6	9.9999999E-01	9.9999999E-01
 # 5.8	1.0000000E+00	1.0000000E+00
 # 6.0	1.0000000E+00	1.0000000E+00
 # 6.2	1.0000000E+00	1.0000000E+00
 # 6.4	1.0000000E+00	1.0000000E+00
 # 6.6	1.0000000E+00	1.0000000E+00
 # 6.8	1.0000000E+00	1.0000000E+00
 # 7.0	1.0000000E+00	1.0000000E+00
 # 7.2	1.0000000E+00	1.0000000E+00
 # 7.4	1.0000000E+00	1.0000000E+00
 # 7.6	1.0000000E+00	1.0000000E+00
 # 7.8	1.0000000E+00	1.0000000E+00
 # 8.0	1.0000000E+00	1.0000000E+00
 # 8.2	1.0000000E+00	1.0000000E+00
 # 8.4	1.0000000E+00	1.0000000E+00
 # 8.6	1.0000000E+00	1.0000000E+00
 # 8.8	1.0000000E+00	1.0000000E+00
 # 9.0	1.0000000E+00	1.0000000E+00
 # 9.2	1.0000000E+00	1.0000000E+00
 # 9.4	1.0000000E+00	1.0000000E+00
 # 9.6	1.0000000E+00	1.0000000E+00
 # 9.8	1.0000000E+00	1.0000000E+00
 # 10.0	1.0000000E+00	1.0000000E+00
 ##