static void
int_d2x2xk(int K, double *m, double *n, double *t, double *d)
{
int i, j, l, w, y, z;
double u, **c;
c = (double **) R_alloc(K + 1, sizeof(double *));
l = y = z = 0;
c[0] = (double *) R_alloc(1, sizeof(double));
c[0][0] = 1;
for(i = 0; i < K; i++) {
y = imax2(0, (int)(*t - *n));
z = imin2((int)*m, (int)*t);
c[i + 1] = (double *) R_alloc(l + z - y + 1, sizeof(double));
for(j = 0; j <= l + z - y; j++) c[i + 1][j] = 0;
for(j = 0; j <= z - y; j++) {
u = dhyper(j + y, *m, *n, *t, FALSE);
for(w = 0; w <= l; w++) c[i + 1][w + j] += c[i][w] * u;
}
l = l + z - y;
m++; n++; t++;
}
u = 0;
for(j = 0; j <= l; j++) u += c[K][j];
for(j = 0; j <= l; j++) d[j] = c[K][j] / u;
}
double dhypergeo(double r, double n, double N, double k, int i)
{
if((r > N) || (k > n) || (k > r))
return std::numeric_limits<double>::quiet_NaN();
double nr = r;
double nb = N - r;
return dhyper(nr, nb, n, k, i);
}
/* 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);
}
