The R Project SVN R

Rev

Rev 24139 | Rev 36820 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 24139 Rev 24175
Line 62... Line 62...
62 
double pnorm5(double x, double mu, double sigma, int lower_tail, int log_p)
 62 
double pnorm5(double x, double mu, double sigma, int lower_tail, int log_p)
63 
{
 63 
{
64 
    double p, cp;
 64 
    double p, cp;
65 
 
 65 
 
66 
    /* Note: The structure of these checks has been carefully thought through.
 66 
    /* Note: The structure of these checks has been carefully thought through.
67 
     * For example, if x == mu and sigma == 0, we get the `correct' answer 1.
 67 
     * For example, if x == mu and sigma == 0, we get the correct answer 1.
68 
     */
 68 
     */
69 
#ifdef IEEE_754
 69 
#ifdef IEEE_754
70 
    if(ISNAN(x) || ISNAN(mu) || ISNAN(sigma))
 70 
    if(ISNAN(x) || ISNAN(mu) || ISNAN(sigma))
71 
	return x + mu + sigma;
 71 
	return x + mu + sigma;
72 
#endif
 72 
#endif
73 
#ifdef R_17x_and_earlier
 - 
 
74 
    if (sigma < 0) ML_ERR_return_NAN;
 - 
 
75 
#else
 - 
 
76 
    if(!R_FINITE(x) && mu == x) return ML_NAN;/* x-mu is NaN */
 73 
    if(!R_FINITE(x) && mu == x) return ML_NAN;/* x-mu is NaN */
77 
    if (sigma <= 0) {
 74 
    if (sigma <= 0) {
78 
	if(sigma < 0) ML_ERR_return_NAN;
 75 
	if(sigma < 0) ML_ERR_return_NAN;
79 
	/* sigma = 0 : */
 76 
	/* sigma = 0 : */
80 
	return (x < mu) ? R_DT_0 : R_DT_1;
 77 
	return (x < mu) ? R_DT_0 : R_DT_1;
81 
    }
 78 
    }
82 
#endif
 - 
 
83 
    x = (x - mu) / sigma;
 79 
    p = (x - mu) / sigma;
84 
    if(!R_FINITE(x)) {
 80 
    if(!R_FINITE(p))
85 
#ifdef R_17x_and_earlier
 - 
 
86 
	if(ISNAN(x)) /* e.g. x=mu=Inf */ return ML_NAN;
 - 
 
87 
#endif
 - 
 
88 
	return (x < 0) ? R_DT_0 : R_DT_1;
 81 
	return (x < mu) ? R_DT_0 : R_DT_1;
89 
    }
 82 
    x = p;
90 
 
 83 
 
91 
    pnorm_both(x, &p, &cp, (lower_tail ? 0 : 1), log_p);
 84 
    pnorm_both(x, &p, &cp, (lower_tail ? 0 : 1), log_p);
92 
 
 85 
 
93 
    return(lower_tail ? p : cp);
 86 
    return(lower_tail ? p : cp);
94 
}
 87 
}