public static double qnbeta( double p, double a, double b, double ncp, boolean lower_tail, boolean log_p) { final double accu = 1e-15; final double Eps = 1e-14; /* must be > accu */ double ux, lx, nx, pp; if (DoubleVector.isNaN(p) || DoubleVector.isNaN(a) || DoubleVector.isNaN(b) || DoubleVector.isNaN(ncp)) { return p + a + b + ncp; } if (!DoubleVector.isFinite(a)) { return DoubleVector.NaN; } if (ncp < 0. || a <= 0. || b <= 0.) { return DoubleVector.NaN; } // R_Q_P01_boundaries(p, 0, 1); if ((log_p && p > 0) || (!log_p && (p < 0 || p > 1))) { return DoubleVector.NaN; } if (p == SignRank.R_DT_0(lower_tail, log_p)) { return 0.0; } if (p == SignRank.R_DT_1(lower_tail, log_p)) { return 1.0; } // end of R_Q_P01_boundaries p = Normal.R_DT_qIv(p, log_p ? 1.0 : 0.0, lower_tail ? 1.0 : 0.0); /* Invert pnbeta(.) : * 1. finding an upper and lower bound */ if (p > 1 - SignRank.DBL_EPSILON) { return 1.0; } pp = Math.min(1 - SignRank.DBL_EPSILON, p * (1 + Eps)); for (ux = 0.5; ux < 1 - SignRank.DBL_EPSILON && pnbeta(ux, a, b, ncp, true, false) < pp; ux = 0.5 * (1 + ux)) ; pp = p * (1 - Eps); for (lx = 0.5; lx > Double.MIN_VALUE && pnbeta(lx, a, b, ncp, true, false) > pp; lx *= 0.5) ; /* 2. interval (lx,ux) halving : */ do { nx = 0.5 * (lx + ux); if (pnbeta(nx, a, b, ncp, true, false) > p) { ux = nx; } else { lx = nx; } } while ((ux - lx) / nx > accu); return 0.5 * (ux + lx); }
public static double pnbeta( double x, double a, double b, double ncp, boolean lower_tail, boolean log_p) { if (DoubleVector.isNaN(x) || DoubleVector.isNaN(a) || DoubleVector.isNaN(b) || DoubleVector.isNaN(ncp)) { return x + a + b + ncp; } // R_P_bounds_01(x, 0., 1.); if (x <= 0.0) { return SignRank.R_DT_0(lower_tail, log_p); } if (x >= 1.0) { return SignRank.R_DT_1(lower_tail, log_p); } return pnbeta2(x, 1 - x, a, b, ncp, lower_tail, log_p); }
public static double pnbinom_mu( double x, double size, double mu, boolean lower_tail, boolean log_p) { if (DoubleVector.isNaN(x) || DoubleVector.isNaN(size) || DoubleVector.isNaN(mu)) { return x + size + mu; } if (!DoubleVector.isFinite(size) || !DoubleVector.isFinite(mu)) { return DoubleVector.NaN; } if (size <= 0 || mu < 0) { return DoubleVector.NaN; } if (x < 0) { SignRank.R_DT_0(lower_tail, log_p); } if (!DoubleVector.isFinite(x)) { return SignRank.R_DT_1(lower_tail, log_p); } x = Math.floor(x + 1e-7); /* return * pbeta(pr, size, x + 1, lower_tail, log_p); pr = size/(size + mu), 1-pr = mu/(size+mu) * *= pbeta_raw(pr, size, x + 1, lower_tail, log_p) * x. pin qin *= bratio (pin, qin, x., 1-x., &w, &wc, &ierr, log_p), and return w or wc .. *= bratio (size, x+1, pr, 1-pr, &w, &wc, &ierr, log_p) */ { int[] ierr = new int[1]; double[] w = new double[1]; double[] wc = new double[1]; Utils.bratio(size, x + 1, size / (size + mu), mu / (size + mu), w, wc, ierr, log_p); return lower_tail ? w[0] : wc[0]; } }
public static double qnbinom( double p, double size, double prob, boolean lower_tail, boolean log_p) { double P, Q, mu, sigma, gamma, y; double[] z = new double[1]; if (DoubleVector.isNaN(p) || DoubleVector.isNaN(size) || DoubleVector.isNaN(prob)) { return p + size + prob; } if (prob <= 0 || prob > 1 || size <= 0) { return DoubleVector.NaN; } /* FIXME: size = 0 is well defined ! */ if (prob == 1) { return 0; } // R_Q_P01_boundaries(p, 0, ML_POSINF); // #define R_Q_P01_boundaries(p, _LEFT_, _RIGHT_) // This macro is defined in /src/nmath/dpq.h if (log_p) { if (p > 0) { return DoubleVector.NaN; } if (p == 0) { /* upper bound*/ return lower_tail ? Double.POSITIVE_INFINITY : 0; } if (p == Double.NEGATIVE_INFINITY) { return lower_tail ? 0 : Double.POSITIVE_INFINITY; } } else { /* !log_p */ if (p < 0 || p > 1) { return DoubleVector.NaN; } if (p == 0) { return lower_tail ? 0 : Double.POSITIVE_INFINITY; } if (p == 1) { return lower_tail ? Double.POSITIVE_INFINITY : 0; } } Q = 1.0 / prob; P = (1.0 - prob) * Q; mu = size * P; sigma = Math.sqrt(size * 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!): */ p = Normal.R_DT_qIv(p, lower_tail ? 1.0 : 0.0, log_p ? 1.0 : 0.0); if (p == SignRank.R_DT_0(lower_tail, log_p)) { return 0; } if (p == SignRank.R_DT_1(lower_tail, log_p)) { return Double.POSITIVE_INFINITY; } } /* temporary hack --- FIXME --- */ if (p + 1.01 * SignRank.DBL_EPSILON >= 1.) { return Double.POSITIVE_INFINITY; } /* y := approx.value (Cornish-Fisher expansion) : */ z[0] = Distributions.qnorm(p, 0., 1., /*lower_tail*/ true, /*log_p*/ false); y = Math.floor(mu + sigma * (z[0] + gamma * (z[0] * z[0] - 1) / 6) + 0.5); z[0] = Distributions.pnbinom(y, (int) size, prob, /*lower_tail*/ true, /*log_p*/ false); /* fuzz to ensure left continuity: */ p *= 1 - 64 * SignRank.DBL_EPSILON; /* If the C-F value is not too large a simple search is OK */ if (y < 1e5) { return do_search(y, z, p, size, prob, 1); } /* Otherwise be a bit cleverer in the search */ { double incr = Math.floor(y * 0.001), oldincr; do { oldincr = incr; y = do_search(y, z, p, size, prob, incr); incr = Math.max(1, Math.floor(incr / 100)); } while (oldincr > 1 && incr > y * 1e-15); return y; } }