static int stat_phyper (lua_State *L) {
lua_Number x = luaL_checknumber(L, 1);
lua_Number r = luaL_checknumber(L, 2);
lua_Number b = luaL_checknumber(L, 3);
lua_Number n = luaL_checknumber(L, 4);
lua_Number d;
int lower_tail = 1;
x = FORCE_INT(x);
r = FORCE_INT(r);
b = FORCE_INT(b);
n = FORCE_INT(n);
check_hyper(L, x, r, b, n);
if (x * (r + b) > n * r) { /* swap tails? */
lua_Number s = b;
b = r;
r = s;
x = n - x - 1;
lower_tail = 0;
}
if (x < 0) return 0;
d = dhyper_raw(x, r, b, n);
d *= pdhyper(x, r, b, n);
lua_pushnumber(L, (lower_tail ? d : (1.0 - d)));
return 1;
}
/* FIXME: The old phyper() code was basically used in ./qhyper.c as well
* ----- We need to sync this again!
*/
double phyper (double x, double NR, double NB, double n,
int lower_tail, int log_p)
{
/* Sample of n balls from NR red and NB black ones; x are red */
double d, pd;
#ifdef IEEE_754
if(ISNAN(x) || ISNAN(NR) || ISNAN(NB) || ISNAN(n))
return x + NR + NB + n;
#endif
x = floor (x + 1e-7);
NR = R_D_forceint(NR);
NB = R_D_forceint(NB);
n = R_D_forceint(n);
if (NR < 0 || NB < 0 || !R_FINITE(NR + NB) || n < 0 || n > NR + NB)
ML_ERR_return_NAN;
if (x * (NR + NB) > n * NR) {
/* Swap tails. */
double oldNB = NB;
NB = NR;
NR = oldNB;
x = n - x - 1;
lower_tail = !lower_tail;
}
if (x < 0)
return R_DT_0;
d = dhyper (x, NR, NB, n, log_p);
pd = pdhyper(x, NR, NB, n, log_p);
return log_p ? R_DT_Log(d + pd) : R_D_Lval(d * pd);
}
