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