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;
}
}
