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