public static double dnbinom_mu(double x, double size, double mu, boolean give_log) { /* originally, just set prob := size / (size + mu) and called dbinom_raw(), * but that suffers from cancellation when mu << size */ double ans, p; if (DoubleVector.isNaN(x) || DoubleVector.isNaN(size) || DoubleVector.isNaN(mu)) { return x + size + mu; } if (mu < 0 || size < 0) { return DoubleVector.NaN; } // R_D_nonint_check(x); if (SignRank.R_D_nonint(x, true, give_log)) { // MATHLIB_WARNING("non-integer x = %f", x); // How to warn?? return SignRank.R_D__0(true, give_log); } if (x < 0 || !DoubleVector.isFinite(x)) { return SignRank.R_D__0(true, give_log); } x = SignRank.R_D_forceint(x); if (x == 0) /* be accerate, both for n << mu, and n >> mu :*/ { return SignRank.R_D_exp( size * (size < mu ? Math.log(size / (size + mu)) : Math.log1p(-mu / (size + mu))), true, give_log); } if (x < 1e-10 * size) { /* don't use dbinom_raw() but MM's formula: */ /* FIXME --- 1e-8 shows problem; rather use algdiv() from ./toms708.c */ return SignRank.R_D_exp( x * Math.log(size * mu / (size + mu)) - mu - org.apache.commons.math.special.Gamma.logGamma(x + 1) + Math.log1p(x * (x - 1) / (2 * size)), true, give_log); } /* else: no unnecessary cancellation inside dbinom_raw, when * x_ = size and n_ = x+size are so close that n_ - x_ loses accuracy */ ans = dbinom_raw(size, x + size, size / (size + mu), mu / (size + mu), give_log); p = ((double) size) / (size + x); return ((give_log) ? Math.log(p) + ans : p * ans); }
public static double dbinom_raw(double x, double n, double p, double q, boolean give_log) { double lf, lc; if (p == 0) { return ((x == 0) ? SignRank.R_D__1(true, give_log) : SignRank.R_D__0(true, give_log)); } if (q == 0) { return ((x == n) ? SignRank.R_D__1(true, give_log) : SignRank.R_D__0(true, give_log)); } if (x == 0) { if (n == 0) { return SignRank.R_D__1(true, give_log); } lc = (p < 0.1) ? -bd0(n, n * q) - n * p : n * Math.log(q); return (SignRank.R_D_exp(lc, true, give_log)); } if (x == n) { lc = (q < 0.1) ? -bd0(n, n * p) - n * q : n * Math.log(p); return (SignRank.R_D_exp(lc, true, give_log)); } if (x < 0 || x > n) { return (SignRank.R_D__0(true, give_log)); } /* n*p or n*q can underflow to zero if n and p or q are small. This used to occur in dbeta, and gives NaN as from R 2.3.0. */ lc = stirlerr(n) - stirlerr(x) - stirlerr(n - x) - bd0(x, n * p) - bd0(n - x, n * q); /* f = (M_2PI*x*(n-x))/n; could overflow or underflow */ /* Upto R 2.7.1: * lf = log(M_2PI) + log(x) + log(n-x) - log(n); * -- following is much better for x << n : */ lf = Math.log(2.0 * Math.PI) + Math.log(x) + Math.log1p(-x / n); return SignRank.R_D_exp(lc - 0.5 * lf, true, give_log); }
public static double dnbeta(double x, double a, double b, double ncp, boolean give_log) { final double eps = 1.e-15; int kMax; double k, ncp2, dx2, d, D; double sum, term, p_k, q; /* They were LDOUBLE */ if (DoubleVector.isNaN(x) || DoubleVector.isNaN(a) || DoubleVector.isNaN(b) || DoubleVector.isNaN(ncp)) { return x + a + b + ncp; } if (ncp < 0 || a <= 0 || b <= 0) { return DoubleVector.NaN; } if (!DoubleVector.isFinite(a) || !DoubleVector.isFinite(b) || !DoubleVector.isFinite(ncp)) { return DoubleVector.NaN; } if (x < 0 || x > 1) { return (SignRank.R_D__0(true, give_log)); } if (ncp == 0) { return Distributions.dbeta(x, a, b, give_log); } /* New algorithm, starting with *largest* term : */ ncp2 = 0.5 * ncp; dx2 = ncp2 * x; d = (dx2 - a - 1) / 2; D = d * d + dx2 * (a + b) - a; if (D <= 0) { kMax = 0; } else { D = Math.ceil(d + Math.sqrt(D)); kMax = (D > 0) ? (int) D : 0; } /* The starting "middle term" --- first look at it's log scale: */ term = Distributions.dbeta(x, a + kMax, b, /* log = */ true); p_k = Poisson.dpois_raw(kMax, ncp2, true); if (x == 0. || !DoubleVector.isFinite(term) || !DoubleVector.isFinite(p_k)) /* if term = +Inf */ { return SignRank.R_D_exp(p_k + term, true, give_log); } /* Now if s_k := p_k * t_k {here = exp(p_k + term)} would underflow, * we should rather scale everything and re-scale at the end:*/ p_k += term; /* = log(p_k) + log(t_k) == log(s_k) -- used at end to rescale */ /* mid = 1 = the rescaled value, instead of mid = exp(p_k); */ /* Now sum from the inside out */ sum = term = 1. /* = mid term */; /* middle to the left */ k = kMax; while (k > 0 && term > sum * eps) { k--; q = /* 1 / r_k = */ (k + 1) * (k + a) / (k + a + b) / dx2; term *= q; sum += term; } /* middle to the right */ term = 1.; k = kMax; do { q = /* r_{old k} = */ dx2 * (k + a + b) / (k + a) / (k + 1); k++; term *= q; sum += term; } while (term > sum * eps); return SignRank.R_D_exp(p_k + Math.log(sum), true, give_log); }