double gsl_cdf_geometric_P (const unsigned int k, const double p) { double P, a, q; if (p > 1.0 || p < 0.0) { CDF_ERROR ("p < 0 or p > 1", GSL_EDOM); } if (k < 1) { return 0.0; } q = 1.0 - p; a = (double) k; if (p < 0.5) { P = -expm1 (a * log1p (-p)); } else { P = 1.0 - pow (q, a); } return P; }
double gsl_cdf_geometric_Q (const unsigned int k, const double p) { double Q, a, q; if (p > 1.0 || p < 0.0) { CDF_ERROR ("p < 0 or p > 1", GSL_EDOM); } if (k < 1) { Q = 1.0; } q = 1.0 - p; a = (double) k; if (p < 0.5) { Q = exp (a * log1p (-p)); } else { Q = pow (q, a); } return Q; }
double gsl_cdf_binomial_Q (const unsigned int k, const double p, const unsigned int n) { double Q; double a; double b; if (p > 1.0 || p < 0.0) { CDF_ERROR ("p < 0 or p > 1", GSL_EDOM); } if (k >= n) { Q = 0.0; } else { a = (double) k + 1.0; b = (double) n - k; Q = gsl_cdf_beta_P (p, a, b); } return Q; }
/* * Pr (X > k) */ double gsl_cdf_hypergeometric_Q (const unsigned int k, const unsigned int n1, const unsigned int n2, const unsigned int t) { double Q; if (t > (n1 + n2)) { CDF_ERROR ("t larger than population size", GSL_EDOM); } else if (k >= n1 || k >= t) { Q = 0.0; } else if (k < 0.0) { Q = 1.0; } else { double midpoint = (int) (t * n1 / (n1 + n2)); if (k < midpoint) { Q = 1 - lower_tail (k, n1, n2, t); } else { Q = upper_tail (k, n1, n2, t); } } return Q; }
double gsl_cdf_beta_Qinv (const double Q, const double a, const double b) { if (Q < 0.0 || Q > 1.0) { CDF_ERROR ("Q must be inside range 0 < Q < 1", GSL_EDOM); } if (a < 0.0) { CDF_ERROR ("a < 0", GSL_EDOM); } if (b < 0.0) { CDF_ERROR ("b < 0", GSL_EDOM); } if (Q == 0.0) { return 1.0; } if (Q == 1.0) { return 0.0; } if (Q > 0.5) { return gsl_cdf_beta_Pinv (1 - Q, a, b); } else { return 1 - gsl_cdf_beta_Pinv (Q, b, a); }; }
double gsl_cdf_fdist_Qinv (const double Q, const double nu1, const double nu2) { double result; double y; if (Q < 0.0) { CDF_ERROR ("Q < 0.0", GSL_EDOM); } if (Q > 1.0) { CDF_ERROR ("Q > 1.0", GSL_EDOM); } if (nu1 < 1.0) { CDF_ERROR ("nu1 < 1", GSL_EDOM); } if (nu2 < 1.0) { CDF_ERROR ("nu2 < 1", GSL_EDOM); } if (Q > 0.5) { y = gsl_cdf_beta_Qinv (Q, nu1 / 2.0, nu2 / 2.0); result = nu2 * y / (nu1 * (1.0 - y)); } else { y = gsl_cdf_beta_Pinv (Q, nu2 / 2.0, nu1 / 2.0); result = nu2 * (1 - y) / (nu1 * y); } return result; }
double gsl_cdf_negative_binomial_Q (const unsigned int k, const double p, const double n) { double Q; double a; double b; if (p > 1.0 || p < 0.0) { CDF_ERROR ("p < 0 or p > 1", GSL_EDOM); } if (n < 0) { CDF_ERROR ("n < 0", GSL_EDOM); } a = (double) n; b = (double) k + 1.0; Q = gsl_cdf_beta_Q (p, a, b); return Q; }
double gsl_cdf_poisson_Q (const unsigned int k, const double mu) { double Q; double a; if (mu <= 0.0) { CDF_ERROR ("mu <= 0", GSL_EDOM); } a = (double) k + 1.0; Q = gsl_cdf_gamma_P (mu, a, 1.0); return Q; }
double gsl_cdf_beta_Pinv (const double P, const double a, const double b) { double x, mean; if (P < 0.0 || P > 1.0) { CDF_ERROR ("P must be in range 0 < P < 1", GSL_EDOM); } if (a < 0.0) { CDF_ERROR ("a < 0", GSL_EDOM); } if (b < 0.0) { CDF_ERROR ("b < 0", GSL_EDOM); } if (P == 0.0) { return 0.0; } if (P == 1.0) { return 1.0; } if (P > 0.5) { return gsl_cdf_beta_Qinv (1 - P, a, b); } mean = a / (a + b); if (P < 0.1) { /* small x */ double lg_ab = gsl_sf_lngamma (a + b); double lg_a = gsl_sf_lngamma (a); double lg_b = gsl_sf_lngamma (b); double lx = (log (a) + lg_a + lg_b - lg_ab + log (P)) / a; if (lx <= 0) { x = exp (lx); /* first approximation */ x *= pow (1 - x, -(b - 1) / a); /* second approximation */ } else { x = mean; } if (x > mean) x = mean; } else { /* Use expected value as first guess */ x = mean; } { double lambda, dP, phi; unsigned int n = 0; start: dP = P - gsl_cdf_beta_P (x, a, b); phi = gsl_ran_beta_pdf (x, a, b); if (dP == 0.0 || n++ > 64) goto end; lambda = dP / GSL_MAX (2 * fabs (dP / x), phi); { double step0 = lambda; double step1 = -((a - 1) / x - (b - 1) / (1 - x)) * lambda * lambda / 2; double step = step0; if (fabs (step1) < fabs (step0)) { step += step1; } else { /* scale back step to a reasonable size when too large */ step *= 2 * fabs (step0 / step1); }; if (x + step > 0 && x + step < 1) { x += step; } else { x = sqrt (x) * sqrt (mean); /* try a new starting point */ } if (fabs (step0) > 1e-10 * x) goto start; } end: return x; } }