double
dhyper (double x, double r, double b, double n, int give_log)
{
double p, q, p1, p2, p3;
if (isnan (x) || isnan (r) || isnan (b) || isnan (n))
return x + r + b + n;
if (R_D_negInonint (r) || R_D_negInonint (b) || R_D_negInonint (n)
|| n > r + b)
return(NAN);
if (x < 0)
return (R_D__0);
R_D_nonint_check (x); // incl warning
x = round (x);
r = round (r);
b = round (b);
n = round (n);
if (n < x || r < x || n - x > b)
return (R_D__0);
if (n == 0)
return ((x == 0) ? R_D__1 : R_D__0);
p = ((double) n) / ((double) (r + b));
q = ((double) (r + b - n)) / ((double) (r + b));
p1 = dbinom_raw (x, r, p, q, give_log);
p2 = dbinom_raw (n - x, b, p, q, give_log);
p3 = dbinom_raw (n, r + b, p, q, give_log);
return ((give_log) ? p1 + p2 - p3 : p1 * p2 / p3);
}
double dpois(NMATH_STATE *state, double x, double lambda, int give_log)
{
if(isnan(x) || isnan(lambda))
return x + lambda;
if (lambda < 0) return NAN;
R_D_nonint_check(x);
if (x < 0 || !isfinite(x))
return R_D__0;
x = R_D_forceint(x);
return( dpois_raw(state, x,lambda,give_log) );
}
double dpois(double x, double lambda, int give_log)
{
#ifdef IEEE_754
if(ISNAN(x) || ISNAN(lambda))
return x + lambda;
#endif
if (lambda < 0) ML_ERR_return_NAN;
R_D_nonint_check(x);
if (x < 0 || !R_FINITE(x))
return R_D__0;
x = R_D_forceint(x);
return( dpois_raw(x,lambda,give_log) );
}
double dbinom(double x, double n, double p, int give_log)
{
#ifdef IEEE_754
/* NaNs propagated correctly */
if (ISNAN(x) || ISNAN(n) || ISNAN(p)) return x + n + p;
#endif
if (p < 0 || p > 1 || R_D_negInonint(n))
ML_ERR_return_NAN;
R_D_nonint_check(x);
if (x < 0 || !R_FINITE(x)) return R_D__0;
n = R_forceint(n);
x = R_forceint(x);
return dbinom_raw(x, n, p, 1-p, give_log);
}
double dgeom(double x, double p, int give_log)
{
double prob;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(p)) return x + p;
#endif
if (p < 0 || p > 1) ML_ERR_return_NAN;
R_D_nonint_check(x);
if (x < 0 || !R_FINITE(x) || p == 0) return R_D__0;
x = R_D_forceint(x);
/* prob = (1-p)^x, stable for small p */
prob = dbinom_raw(0.,x, p,1-p, give_log);
return((give_log) ? log(p) + prob : p*prob);
}
double dnbinom(double x, double size, double prob, int give_log)
{
double ans, p;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(size) || ISNAN(prob))
return x + size + prob;
#endif
if (prob <= 0 || prob > 1 || size < 0) ML_ERR_return_NAN;
R_D_nonint_check(x);
if (x < 0 || !R_FINITE(x)) return R_D__0;
/* limiting case as size approaches zero is point mass at zero */
if (x == 0 && size==0) return R_D__1;
x = R_forceint(x);
ans = dbinom_raw(size, x+size, prob, 1-prob, give_log);
p = ((double)size)/(size+x);
return((give_log) ? log(p) + ans : p * ans);
}
double dnbinom_mu(double x, double size, double mu, int give_log)
{
/* originally, just set prob := size / (size + mu) and called dbinom_raw(),
* but that suffers from cancellation when mu << size */
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(size) || ISNAN(mu))
return x + size + mu;
#endif
if (mu < 0 || size < 0) ML_ERR_return_NAN;
R_D_nonint_check(x);
if (x < 0 || !R_FINITE(x)) return R_D__0;
/* limiting case as size approaches zero is point mass at zero,
* even if mu is kept constant. limit distribution does not
* have mean mu, though.
*/
if (x == 0 && size == 0) return R_D__1;
x = R_forceint(x);
if(!R_FINITE(size)) // limit case: Poisson
return(dpois_raw(x, mu, give_log));
if(x == 0)/* be accurate, both for n << mu, and n >> mu :*/
return R_D_exp(size * (size < mu ? log(size/(size+mu)) : log1p(- mu/(size+mu))));
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 */
double p = (size < mu ? log(size/(1 + size/mu)) : log(mu / (1 + mu/size)));
return R_D_exp(x * p - mu - lgamma(x+1) +
log1p(x*(x-1)/(2*size)));
} else {
/* no unnecessary cancellation inside dbinom_raw, when
* x_ = size and n_ = x+size are so close that n_ - x_ loses accuracy */
double p = ((double)size)/(size+x),
ans = dbinom_raw(size, x+size, size/(size+mu), mu/(size+mu), give_log);
return((give_log) ? log(p) + ans : p * ans);
}
}
