double psignrank(double x, double n, int lower_tail, int log_p) { int i; double f, p; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(n)) return(x + n); #endif if (!R_FINITE(n)) ML_ERR_return_NAN; n = floor(n + 0.5); if (n <= 0) ML_ERR_return_NAN; x = floor(x + 1e-7); if (x < 0.0) return(R_DT_0); if (x >= n * (n + 1) / 2) return(R_DT_1); w_init_maybe(n); f = exp(- n * M_LN2); p = 0; if (x <= (n * (n + 1) / 4)) { for (i = 0; i <= x; i++) p += csignrank(i, n) * f; } else { x = n * (n + 1) / 2 - x; for (i = 0; i < x; i++) p += csignrank(i, n) * f; lower_tail = !lower_tail; /* p = 1 - p; */ } return(R_DT_val(p)); } /* psignrank() */
double dwilcox(double x, double m, double n, int give_log) { double d; #ifdef IEEE_754 /* NaNs propagated correctly */ if (ISNAN(x) || ISNAN(m) || ISNAN(n)) return(x + m + n); #endif m = R_forceint(m); n = R_forceint(n); if (m <= 0 || n <= 0) ML_ERR_return_NAN; if (fabs(x - R_forceint(x)) > 1e-7) return(R_D__0); x = R_forceint(x); if ((x < 0) || (x > m * n)) return(R_D__0); int mm = (int) m, nn = (int) n, xx = (int) x; w_init_maybe(mm, nn); d = give_log ? log(cwilcox(xx, mm, nn)) - lchoose(m + n, n) : cwilcox(xx, mm, nn) / choose(m + n, n); return(d); }
double qwilcox(double x, double m, double n, int lower_tail, int log_p) { double c, p; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(m) || ISNAN(n)) return(x + m + n); #endif if(!R_FINITE(x) || !R_FINITE(m) || !R_FINITE(n)) ML_ERR_return_NAN; R_Q_P01_check(x); m = R_forceint(m); n = R_forceint(n); if (m <= 0 || n <= 0) ML_ERR_return_NAN; if (x == R_DT_0) return(0); if (x == R_DT_1) return(m * n); if(log_p || !lower_tail) x = R_DT_qIv(x); /* lower_tail,non-log "p" */ int mm = (int) m, nn = (int) n; w_init_maybe(mm, nn); c = choose(m + n, n); p = 0; int q = 0; if (x <= 0.5) { x = x - 10 * DBL_EPSILON; for (;;) { p += cwilcox(q, mm, nn) / c; if (p >= x) break; q++; } } else { x = 1 - x + 10 * DBL_EPSILON; for (;;) { p += cwilcox(q, mm, nn) / c; if (p > x) { q = (int) (m * n - q); break; } q++; } } return(q); }
double qsignrank(double x, double n, int lower_tail, int log_p) { double f, p; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(n)) return(x + n); #endif if (!R_FINITE(x) || !R_FINITE(n)) ML_ERR_return_NAN; R_Q_P01_check(x); n = floor(n + 0.5); if (n <= 0) ML_ERR_return_NAN; if (x == R_DT_0) return(0); if (x == R_DT_1) return(n * (n + 1) / 2); if(log_p || !lower_tail) x = R_DT_qIv(x); /* lower_tail,non-log "p" */ int nn = (int) n; w_init_maybe(nn); f = exp(- n * M_LN2); p = 0; int q = 0; if (x <= 0.5) { x = x - 10 * DBL_EPSILON; for (;;) { p += csignrank(q, nn) * f; if (p >= x) break; q++; } } else { x = 1 - x + 10 * DBL_EPSILON; for (;;) { p += csignrank(q, nn) * f; if (p > x) { q = (int)(n * (n + 1) / 2 - q); break; } q++; } } return(q); }
/* args have the same meaning as R function pwilcox */ double pwilcox(double q, double m, double n, int lower_tail, int log_p) { int i; double c, p; #ifdef IEEE_754 if (ISNAN(q) || ISNAN(m) || ISNAN(n)) return(q + m + n); #endif if (!R_FINITE(m) || !R_FINITE(n)) ML_ERR_return_NAN; m = R_forceint(m); n = R_forceint(n); if (m <= 0 || n <= 0) ML_ERR_return_NAN; q = floor(q + 1e-7); if (q < 0.0) return(R_DT_0); if (q >= m * n) return(R_DT_1); int mm = (int) m, nn = (int) n; w_init_maybe(mm, nn); c = choose(m + n, n); p = 0; /* Use summation of probs over the shorter range */ if (q <= (m * n / 2)) { for (i = 0; i <= q; i++) p += cwilcox(i, mm, nn) / c; } else { q = m * n - q; for (i = 0; i < q; i++) p += cwilcox(i, mm, nn) / c; lower_tail = !lower_tail; /* p = 1 - p; */ } return(R_DT_val(p)); } /* pwilcox */
double dsignrank(double x, double n, int give_log) { double d; #ifdef IEEE_754 /* NaNs propagated correctly */ if (ISNAN(x) || ISNAN(n)) return(x + n); #endif n = floor(n + 0.5); if (n <= 0) ML_ERR_return_NAN; if (fabs(x - floor(x + 0.5)) > 1e-7) return(R_D__0); x = floor(x + 0.5); if ((x < 0) || (x > (n * (n + 1) / 2))) return(R_D__0); w_init_maybe(n); d = R_D_exp(log(csignrank(x, n)) - n * M_LN2); return(d); }