double qcauchy(double p, double location, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(location) || ISNAN(scale)) return p + location + scale; #endif R_Q_P01_check(p); if (scale <= 0 || !R_FINITE(scale)) { if (scale == 0) return location; /* else */ ML_ERR_return_NAN; } if (log_p) { if (p > -1) { /* when ep := exp(p), * tan(pi*ep)= -tan(pi*(-ep))= -tan(pi*(-ep)+pi) = -tan(pi*(1-ep)) = * = -tan(pi*(-expm1(p)) * for p ~ 0, exp(p) ~ 1, tan(~0) may be better than tan(~pi). */ if (p == 0.) /* needed, since 1/tan(-0) = -Inf for some arch. */ return location + (lower_tail ? scale : -scale) * ML_POSINF; lower_tail = !lower_tail; p = -expm1(p); } else p = exp(p); } return location + (lower_tail ? -scale : scale) / tan(M_PI * p); /* -1/tan(pi * p) = -cot(pi * p) = tan(pi * (p - 1/2)) */ }
double qpois(double p, double lambda, int lower_tail, int log_p) { double mu, sigma, gamma, z, y; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(lambda)) return p + lambda; #endif if(!R_FINITE(lambda)) ML_ERR_return_NAN; if(lambda < 0) ML_ERR_return_NAN; R_Q_P01_check(p); if(lambda == 0) return 0; if(p == R_DT_0) return 0; if(p == R_DT_1) return ML_POSINF; mu = lambda; sigma = sqrt(lambda); /* gamma = sigma; PR#8058 should be kurtosis which is mu^-0.5 */ gamma = 1.0/sigma; /* Note : "same" code in qpois.c, qbinom.c, qnbinom.c -- * FIXME: This is far from optimal [cancellation for p ~= 1, etc]: */ if(!lower_tail || log_p) { p = R_DT_qIv(p); /* need check again (cancellation!): */ if (p == 0.) return 0; if (p == 1.) return ML_POSINF; } /* temporary hack --- FIXME --- */ if (p + 1.01*DBL_EPSILON >= 1.) return ML_POSINF; /* y := approx.value (Cornish-Fisher expansion) : */ z = qnorm(p, 0., 1., /*lower_tail*/TRUE, /*log_p*/FALSE); #ifdef HAVE_NEARBYINT y = nearbyint(mu + sigma * (z + gamma * (z*z - 1) / 6)); #else y = round(mu + sigma * (z + gamma * (z*z - 1) / 6)); #endif z = ppois(y, lambda, /*lower_tail*/TRUE, /*log_p*/FALSE); /* fuzz to ensure left continuity; 1 - 1e-7 may lose too much : */ p *= 1 - 64*DBL_EPSILON; /* If the mean is not too large a simple search is OK */ if(lambda < 1e5) return do_search(y, &z, p, lambda, 1); /* Otherwise be a bit cleverer in the search */ { double incr = floor(y * 0.001), oldincr; do { oldincr = incr; y = do_search(y, &z, p, lambda, incr); incr = fmax2(1, floor(incr/100)); } while(oldincr > 1 && incr > lambda*1e-15); return y; } }
double qunif(double p, double a, double b, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(a) || ISNAN(b)) return p + a + b; #endif R_Q_P01_check(p); if (b <= a ) ML_ERR_return_NAN; return a + R_DT_qIv(p) * (b - a); }
double qwilcox(double x, double m, double n, int lower_tail, int log_p) { double c, p; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(m) || ISNAN(n)) return(x + m + n); #endif if(!R_FINITE(x) || !R_FINITE(m) || !R_FINITE(n)) ML_ERR_return_NAN; R_Q_P01_check(x); m = R_forceint(m); n = R_forceint(n); if (m <= 0 || n <= 0) ML_ERR_return_NAN; if (x == R_DT_0) return(0); if (x == R_DT_1) return(m * n); if(log_p || !lower_tail) x = R_DT_qIv(x); /* lower_tail,non-log "p" */ int mm = (int) m, nn = (int) n; w_init_maybe(mm, nn); c = choose(m + n, n); p = 0; int q = 0; if (x <= 0.5) { x = x - 10 * DBL_EPSILON; for (;;) { p += cwilcox(q, mm, nn) / c; if (p >= x) break; q++; } } else { x = 1 - x + 10 * DBL_EPSILON; for (;;) { p += cwilcox(q, mm, nn) / c; if (p > x) { q = (int) (m * n - q); break; } q++; } } return(q); }
double qsignrank(double x, double n, int lower_tail, int log_p) { double f, p; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(n)) return(x + n); #endif if (!R_FINITE(x) || !R_FINITE(n)) ML_ERR_return_NAN; R_Q_P01_check(x); n = floor(n + 0.5); if (n <= 0) ML_ERR_return_NAN; if (x == R_DT_0) return(0); if (x == R_DT_1) return(n * (n + 1) / 2); if(log_p || !lower_tail) x = R_DT_qIv(x); /* lower_tail,non-log "p" */ int nn = (int) n; w_init_maybe(nn); f = exp(- n * M_LN2); p = 0; int q = 0; if (x <= 0.5) { x = x - 10 * DBL_EPSILON; for (;;) { p += csignrank(q, nn) * f; if (p >= x) break; q++; } } else { x = 1 - x + 10 * DBL_EPSILON; for (;;) { p += csignrank(q, nn) * f; if (p > x) { q = (int)(n * (n + 1) / 2 - q); break; } q++; } } return(q); }
double qcauchy(double p, double location, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(location) || ISNAN(scale)) return p + location + scale; #endif if(!R_FINITE(p) || !R_FINITE(location) || !R_FINITE(scale)) ML_ERR_return_NAN; R_Q_P01_check(p); if (scale <= 0) ML_ERR_return_NAN; return location + scale * tan(M_PI * (R_DT_qIv(p) - 0.5)); }
double qnchisq(double p, double n, double lambda, int lower_tail, int log_p) { const double acu = 1e-12; const double Eps = 1e-6; /* must be > acu */ double ux, lx, nx; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(n) || ISNAN(lambda)) return p + n + lambda; #endif if (!R_FINITE(n)) ML_ERR_return_NAN; n = FLOOR(n + 0.5); if (n < 1 || lambda < 0) ML_ERR_return_NAN; R_Q_P01_check(p); if (p == R_DT_0) return 0; /* Invert pnchisq(.) finding an upper and lower bound; then interval halfing : */ p = R_D_qIv(p); if(lower_tail) { for(ux = 1.; pnchisq_raw(ux, n, lambda, Eps, 128) < p * (1 + Eps); ux *= 2){} for(lx = ux; pnchisq_raw(lx, n, lambda, Eps, 128) > p * (1 - Eps); lx *= 0.5){} } else { for(ux = 1.; pnchisq_raw(ux, n, lambda, Eps, 128) + p < 1 + Eps; ux *= 2){} for(lx = ux; pnchisq_raw(lx, n, lambda, Eps, 128) + p > 1 - Eps; lx *= 0.5){} } p = R_D_Lval(p); do { nx = 0.5 * (lx + ux); if (pnchisq_raw(nx, n, lambda, acu, 1000) > p) ux = nx; else lx = nx; } while ((ux - lx) / nx > acu); return 0.5 * (ux + lx); }
gnm_float qcauchy (gnm_float p, gnm_float location, gnm_float scale, gboolean lower_tail, gboolean log_p) { if (gnm_isnan(p) || gnm_isnan(location) || gnm_isnan(scale)) return p + location + scale; R_Q_P01_check(p); if (scale < 0 || !gnm_finite(scale)) ML_ERR_return_NAN; if (log_p) { if (p > -1) /* The "0" here is important for the p=0 case: */ lower_tail = !lower_tail, p = 0 - gnm_expm1 (p); else p = gnm_exp (p); } if (lower_tail) scale = -scale; return location + scale / gnm_tan(M_PIgnum * p); }
double igraph_qnorm5(double p, double mu, double sigma, int lower_tail, int log_p) { double p_, q, r, val; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(mu) || ISNAN(sigma)) return p + mu + sigma; #endif if (p == R_DT_0) return ML_NEGINF; if (p == R_DT_1) return ML_POSINF; R_Q_P01_check(p); if(sigma < 0) ML_ERR_return_NAN; if(sigma == 0) return mu; p_ = R_DT_qIv(p);/* real lower_tail prob. p */ q = p_ - 0.5; /*-- use AS 241 --- */ /* double ppnd16_(double *p, long *ifault)*/ /* ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3 Produces the normal deviate Z corresponding to a given lower tail area of P; Z is accurate to about 1 part in 10**16. (original fortran code used PARAMETER(..) for the coefficients and provided hash codes for checking them...) */ if (fabs(q) <= .425) {/* 0.075 <= p <= 0.925 */ r = .180625 - q * q; val = q * (((((((r * 2509.0809287301226727 + 33430.575583588128105) * r + 67265.770927008700853) * r + 45921.953931549871457) * r + 13731.693765509461125) * r + 1971.5909503065514427) * r + 133.14166789178437745) * r + 3.387132872796366608) / (((((((r * 5226.495278852854561 + 28729.085735721942674) * r + 39307.89580009271061) * r + 21213.794301586595867) * r + 5394.1960214247511077) * r + 687.1870074920579083) * r + 42.313330701600911252) * r + 1.); } else { /* closer than 0.075 from {0,1} boundary */ /* r = min(p, 1-p) < 0.075 */ if (q > 0) r = R_DT_CIv(p);/* 1-p */ else r = p_;/* = R_DT_Iv(p) ^= p */ r = sqrt(- ((log_p && ((lower_tail && q <= 0) || (!lower_tail && q > 0))) ? p : /* else */ log(r))); /* r = sqrt(-log(r)) <==> min(p, 1-p) = exp( - r^2 ) */ if (r <= 5.) { /* <==> min(p,1-p) >= exp(-25) ~= 1.3888e-11 */ r += -1.6; val = (((((((r * 7.7454501427834140764e-4 + .0227238449892691845833) * r + .24178072517745061177) * r + 1.27045825245236838258) * r + 3.64784832476320460504) * r + 5.7694972214606914055) * r + 4.6303378461565452959) * r + 1.42343711074968357734) / (((((((r * 1.05075007164441684324e-9 + 5.475938084995344946e-4) * r + .0151986665636164571966) * r + .14810397642748007459) * r + .68976733498510000455) * r + 1.6763848301838038494) * r + 2.05319162663775882187) * r + 1.); } else { /* very close to 0 or 1 */ r += -5.; val = (((((((r * 2.01033439929228813265e-7 + 2.71155556874348757815e-5) * r + .0012426609473880784386) * r + .026532189526576123093) * r + .29656057182850489123) * r + 1.7848265399172913358) * r + 5.4637849111641143699) * r + 6.6579046435011037772) / (((((((r * 2.04426310338993978564e-15 + 1.4215117583164458887e-7)* r + 1.8463183175100546818e-5) * r + 7.868691311456132591e-4) * r + .0148753612908506148525) * r + .13692988092273580531) * r + .59983220655588793769) * r + 1.); } if(q < 0.0) val = -val; /* return (q >= 0.)? r : -r ;*/ } return mu + sigma * val; }
double qgamma(double p, double alpha, double scale, int lower_tail, int log_p) /* shape = alpha */ { #define C7 4.67 #define C8 6.66 #define C9 6.73 #define C10 13.32 #define EPS1 1e-2 #define EPS2 5e-7/* final precision */ #define MAXIT 1000/* was 20 */ #define pMIN 1e-100 /* was 0.000002 = 2e-6 */ #define pMAX (1-1e-12)/* was 0.999998 = 1 - 2e-6 */ const double i420 = 1./ 420., i2520 = 1./ 2520., i5040 = 1./ 5040; double p_, a, b, c, ch, g, p1, v; double p2, q, s1, s2, s3, s4, s5, s6, t, x; int i; /* test arguments and initialise */ #ifdef IEEE_754 if (ISNAN(p) || ISNAN(alpha) || ISNAN(scale)) return p + alpha + scale; #endif R_Q_P01_check(p); if (alpha <= 0) ML_ERR_return_NAN; /* FIXME: This (cutoff to {0, +Inf}) is far from optimal when log_p: */ p_ = R_DT_qIv(p);/* lower_tail prob (in any case) */ if (/* 0 <= */ p_ < pMIN) return 0; if (/* 1 >= */ p_ > pMAX) return BOOM::infinity(); v = 2*alpha; c = alpha-1; g = lgammafn(alpha);/* log Gamma(v/2) */ /*----- Phase I : Starting Approximation */ #ifdef DEBUG_qgamma REprintf("qgamma(p=%7g, alpha=%7g, scale=%7g, l.t.=%2d, log_p=%2d): ", p,alpha,scale, lower_tail, log_p); #endif if(v < (-1.24)*R_DT_log(p)) { /* for small chi-squared */ #ifdef DEBUG_qgamma REprintf(" small chi-sq.\n"); #endif /* FIXME: Improve this "if (log_p)" : * (A*exp(b)) ^ 1/al */ ch = pow(p_* alpha*exp(g+alpha*M_LN2), 1/alpha); if(ch < EPS2) {/* Corrected according to AS 91; MM, May 25, 1999 */ goto END; } } else if(v > 0.32) { /* using Wilson and Hilferty estimate */ x = qnorm(p, 0, 1, lower_tail, log_p); p1 = 0.222222/v; ch = v*pow(x*sqrt(p1)+1-p1, 3); #ifdef DEBUG_qgamma REprintf(" v > .32: Wilson-Hilferty; x = %7g\n", x); #endif /* starting approximation for p tending to 1 */ if( ch > 2.2*v + 6 ) ch = -2*(R_DT_Clog(p) - c*log(0.5*ch) + g); } else { /* for v <= 0.32 */ ch = 0.4; a = R_DT_Clog(p) + g + c*M_LN2; #ifdef DEBUG_qgamma REprintf(" v <= .32: a = %7g\n", a); #endif do { q = ch; p1 = 1. / (1+ch*(C7+ch)); p2 = ch*(C9+ch*(C8+ch)); t = -0.5 +(C7+2*ch)*p1 - (C9+ch*(C10+3*ch))/p2; ch -= (1- exp(a+0.5*ch)*p2*p1)/t; } while(fabs(q - ch) > EPS1*fabs(ch)); } #ifdef DEBUG_qgamma REprintf("\t==> ch = %10g:", ch); #endif /*----- Phase II: Iteration * Call pgamma() [AS 239] and calculate seven term taylor series */ for( i=1 ; i <= MAXIT ; i++ ) { q = ch; p1 = 0.5*ch; p2 = p_ - pgamma(p1, alpha, 1, /*lower_tail*/true, /*log_p*/false); #ifdef IEEE_754 if(!R_FINITE(p2)) #else if(errno != 0) #endif return numeric_limits<double>::quiet_NaN(); t = p2*exp(alpha*M_LN2+g+p1-c*log(ch)); b = t/ch; a = 0.5*t - b*c; s1 = (210+a*(140+a*(105+a*(84+a*(70+60*a))))) * i420; s2 = (420+a*(735+a*(966+a*(1141+1278*a)))) * i2520; s3 = (210+a*(462+a*(707+932*a))) * i2520; s4 = (252+a*(672+1182*a)+c*(294+a*(889+1740*a))) * i5040; s5 = (84+2264*a+c*(1175+606*a)) * i2520; s6 = (120+c*(346+127*c)) * i5040; ch += t*(1+0.5*t*s1-b*c*(s1-b*(s2-b*(s3-b*(s4-b*(s5-b*s6)))))); if(fabs(q - ch) < EPS2*ch) goto END; } ML_ERROR(ME_PRECISION);/* no convergence in MAXIT iterations */ END: return 0.5*scale*ch; }
double qbinom(double p, double n, double pr, int lower_tail, int log_p) { double q, mu, sigma, gamma, z, y; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(n) || ISNAN(pr)) return p + n + pr; #endif if(!R_FINITE(p) || !R_FINITE(n) || !R_FINITE(pr)) ML_ERR_return_NAN; R_Q_P01_check(p); if(n != floor(n + 0.5)) ML_ERR_return_NAN; if (pr < 0 || pr > 1 || n < 0) ML_ERR_return_NAN; if (pr == 0. || n == 0) return 0.; if (p == R_DT_0) return 0.; if (p == R_DT_1) return n; q = 1 - pr; if(q == 0.) return n; /* covers the full range of the distribution */ mu = n * pr; sigma = sqrt(n * pr * q); gamma = (q - pr) / sigma; #ifdef DEBUG_qbinom REprintf("qbinom(p=%7g, n=%g, pr=%7g, l.t.=%d, log=%d): sigm=%g, gam=%g\n", p,n,pr, lower_tail, log_p, sigma, gamma); #endif /* Note : "same" code in qpois.c, qbinom.c, qnbinom.c -- * FIXME: This is far from optimal [cancellation for p ~= 1, etc]: */ if(!lower_tail || log_p) { p = R_DT_qIv(p); /* need check again (cancellation!): */ if (p == 0.) return 0.; if (p == 1.) return n; } /* temporary hack --- FIXME --- */ if (p + 1.01*DBL_EPSILON >= 1.) return n; /* y := approx.value (Cornish-Fisher expansion) : */ z = qnorm(p, 0., 1., /*lower_tail*/TRUE, /*log_p*/FALSE); y = floor(mu + sigma * (z + gamma * (z*z - 1) / 6) + 0.5); if(y > n) /* way off */ y = n; #ifdef DEBUG_qbinom REprintf(" new (p,1-p)=(%7g,%7g), z=qnorm(..)=%7g, y=%5g\n", p, 1-p, z, y); #endif z = pbinom(y, n, pr, /*lower_tail*/TRUE, /*log_p*/FALSE); /* fuzz to ensure left continuity: */ p *= 1 - 64*DBL_EPSILON; /*-- Fixme, here y can be way off -- should use interval search instead of primitive stepping down or up */ #ifdef maybe_future if((lower_tail && z >= p) || (!lower_tail && z <= p)) { #else if(z >= p) { #endif /* search to the left */ #ifdef DEBUG_qbinom REprintf("\tnew z=%7g >= p = %7g --> search to left (y--) ..\n", z,p); #endif for(;;) { if(y == 0 || (z = pbinom(y - 1, n, pr, /*l._t.*/TRUE, /*log_p*/FALSE)) < p) return y; y = y - 1; } } else { /* search to the right */ #ifdef DEBUG_qbinom REprintf("\tnew z=%7g < p = %7g --> search to right (y++) ..\n", z,p); #endif for(;;) { y = y + 1; if(y == n || (z = pbinom(y, n, pr, /*l._t.*/TRUE, /*log_p*/FALSE)) >= p) return y; } } }
double qtukey(double p, double rr, double cc, double df, int lower_tail, int log_p) { const double eps = 0.0001; const int maxiter = 50; double ans = 0.0, valx0, valx1, x0, x1, xabs; int iter; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(rr) || ISNAN(cc) || ISNAN(df)) { ML_ERROR(ME_DOMAIN); return p + rr + cc + df; } #endif R_Q_P01_check(p); if (p == 1) ML_ERR_return_NAN; /* df must be > 1 */ /* there must be at least two values */ if (df < 2 || rr < 1 || cc < 2) ML_ERR_return_NAN; if (p == R_DT_0) return 0; p = R_DT_qIv(p); /* lower_tail,non-log "p" */ /* Initial value */ x0 = qinv(p, cc, df); /* Find prob(value < x0) */ valx0 = ptukey(x0, rr, cc, df, /*LOWER*/true, /*LOG_P*/false) - p; /* Find the second iterate and prob(value < x1). */ /* If the first iterate has probability value */ /* exceeding p then second iterate is 1 less than */ /* first iterate; otherwise it is 1 greater. */ if (valx0 > 0.0) x1 = std::max(0.0, x0 - 1.0); else x1 = x0 + 1.0; valx1 = ptukey(x1, rr, cc, df, /*LOWER*/true, /*LOG_P*/false) - p; /* Find new iterate */ for(iter=1 ; iter < maxiter ; iter++) { ans = x1 - ((valx1 * (x1 - x0)) / (valx1 - valx0)); valx0 = valx1; /* New iterate must be >= 0 */ x0 = x1; if (ans < 0.0) { ans = 0.0; valx1 = -p; } /* Find prob(value < new iterate) */ valx1 = ptukey(ans, rr, cc, df, /*LOWER*/true, /*LOG_P*/false) - p; x1 = ans; /* If the difference between two successive */ /* iterates is less than eps, stop */ xabs = fabs(x1 - x0); if (xabs < eps) return ans; } /* The process did not converge in 'maxiter' iterations */ ML_ERROR(ME_NOCONV); return ans; }
// MM_R attribute_hidden double qchisq_appr(double p, double nu, double g /* = log Gamma(nu/2) */, logical lower_tail, logical log_p, double tol /* EPS1 */) { #define C7 4.67 #define C8 6.66 #define C9 6.73 #define C10 13.32 double alpha, a, c, ch, p1; double p2, q, t, x; /* test arguments and initialise */ #ifdef IEEE_754 if (ISNAN(p) || ISNAN(nu)) return p + nu; #endif R_Q_P01_check(p); if (nu <= 0) ML_ERR_return_NAN; alpha = 0.5 * nu;/* = [pq]gamma() shape */ c = alpha-1; if(nu < (-1.24)*(p1 = R_DT_log(p))) { /* for small chi-squared */ /* log(alpha) + g = log(alpha) + log(gamma(alpha)) = * = log(alpha*gamma(alpha)) = lgamma(alpha+1) suffers from * catastrophic cancellation when alpha << 1 */ double lgam1pa = (alpha < 0.5) ? lgamma1p(alpha) : (log(alpha) + g); ch = exp((lgam1pa + p1)/alpha + M_LN2); #ifdef DEBUG_qgamma REprintf(" small chi-sq., ch0 = %g\n", ch); #endif } else if(nu > 0.32) { /* using Wilson and Hilferty estimate */ x = qnorm(p, 0, 1, lower_tail, log_p); p1 = 2./(9*nu); ch = nu*pow(x*sqrt(p1) + 1-p1, 3); #ifdef DEBUG_qgamma REprintf(" nu > .32: Wilson-Hilferty; x = %7g\n", x); #endif /* approximation for p tending to 1: */ if( ch > 2.2*nu + 6 ) ch = -2*(R_DT_Clog(p) - c*log(0.5*ch) + g); } else { /* "small nu" : 1.24*(-log(p)) <= nu <= 0.32 */ ch = 0.4; a = R_DT_Clog(p) + g + c*M_LN2; #ifdef DEBUG_qgamma REprintf(" nu <= .32: a = %7g\n", a); #endif do { q = ch; p1 = 1. / (1+ch*(C7+ch)); p2 = ch*(C9+ch*(C8+ch)); t = -0.5 +(C7+2*ch)*p1 - (C9+ch*(C10+3*ch))/p2; ch -= (1- exp(a+0.5*ch)*p2*p1)/t; } while(fabs(q - ch) > tol * fabs(ch)); } return ch; }
double qnbinom(double p, double n, double pr, int lower_tail, int log_p) { double P, Q, mu, sigma, gamma, z, y; #ifdef IEEE_754 if (ISNAN(p) || ISNAN(n) || ISNAN(pr)) return p + n + pr; #endif R_Q_P01_check(p); if (pr <= 0 || pr >= 1 || n <= 0) ML_ERR_return_NAN; if (p == R_DT_0) return 0; if (p == R_DT_1) return ML_POSINF; Q = 1.0 / pr; P = (1.0 - pr) * Q; mu = n * P; sigma = sqrt(n * P * Q); gamma = (Q + P)/sigma; /* Note : "same" code in qpois.c, qbinom.c, qnbinom.c -- * FIXME: This is far from optimal [cancellation for p ~= 1, etc]: */ if(!lower_tail || log_p) { p = R_DT_qIv(p); /* need check again (cancellation!): */ if (p == R_DT_0) return 0; if (p == R_DT_1) return ML_POSINF; } /* temporary hack --- FIXME --- */ if (p + 1.01*DBL_EPSILON >= 1.) return ML_POSINF; /* y := approx.value (Cornish-Fisher expansion) : */ z = qnorm(p, 0., 1., /*lower_tail*/TRUE, /*log_p*/FALSE); y = floor(mu + sigma * (z + gamma * (z*z - 1) / 6) + 0.5); z = pnbinom(y, n, pr, /*lower_tail*/TRUE, /*log_p*/FALSE); /* fuzz to ensure left continuity: */ p *= 1 - 64*DBL_EPSILON; /*-- Fixme, here y can be way off -- should use interval search instead of primitive stepping down or up */ #ifdef maybe_future if((lower_tail && z >= p) || (!lower_tail && z <= p)) { #else if(z >= p) { #endif /* search to the left */ for(;;) { if(y == 0 || (z = pnbinom(y - 1, n, pr, /*l._t.*/TRUE, /*log_p*/FALSE)) < p) return y; y = y - 1; } } else { /* search to the right */ for(;;) { y = y + 1; if((z = pnbinom(y, n, pr, /*l._t.*/TRUE, /*log_p*/FALSE)) >= p) return y; } } }