/* The dominant part,
* D(a,x) := x^a e^(-x) / Gamma(a+1)
*/
static
int
gamma_inc_D(const double a, const double x, gsl_sf_result * result)
{
if(a < 10.0) {
double lnr;
gsl_sf_result lg;
gsl_sf_lngamma_e(a+1.0, &lg);
lnr = a * log(x) - x - lg.val;
result->val = exp(lnr);
result->err = 2.0 * GSL_DBL_EPSILON * (fabs(lnr) + 1.0) * fabs(result->val);
return GSL_SUCCESS;
}
else {
double mu = (x-a)/a;
double term1;
gsl_sf_result gstar;
gsl_sf_result ln_term;
gsl_sf_log_1plusx_mx_e(mu, &ln_term); /* log(1+mu) - mu */
gsl_sf_gammastar_e(a, &gstar);
term1 = exp(a*ln_term.val)/sqrt(2.0*M_PI*a);
result->val = term1/gstar.val;
result->err = 2.0 * GSL_DBL_EPSILON * (fabs(a*ln_term.val) + 1.0) * fabs(result->val);
result->err += gstar.err/fabs(gstar.val) * fabs(result->val);
return GSL_SUCCESS;
}
}
/* Uniform asymptotic for x near a, a and x large.
* See [Temme, p. 285]
*/
static
int
gamma_inc_Q_asymp_unif(const double a, const double x, gsl_sf_result * result)
{
const double rta = sqrt(a);
const double eps = (x-a)/a;
gsl_sf_result ln_term;
const int stat_ln = gsl_sf_log_1plusx_mx_e(eps, &ln_term); /* log(1+eps) - eps */
const double eta = GSL_SIGN(eps) * sqrt(-2.0*ln_term.val);
gsl_sf_result erfc;
double R;
double c0, c1;
/* This used to say erfc(eta*M_SQRT2*rta), which is wrong.
* The sqrt(2) is in the denominator. Oops.
* Fixed: [GJ] Mon Nov 15 13:25:32 MST 2004
*/
gsl_sf_erfc_e(eta*rta/M_SQRT2, &erfc);
if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
c0 = -1.0/3.0 + eps*(1.0/12.0 - eps*(23.0/540.0 - eps*(353.0/12960.0 - eps*589.0/30240.0)));
c1 = -1.0/540.0 - eps/288.0;
}
else {
const double rt_term = sqrt(-2.0 * ln_term.val/(eps*eps));
const double lam = x/a;
c0 = (1.0 - 1.0/rt_term)/eps;
c1 = -(eta*eta*eta * (lam*lam + 10.0*lam + 1.0) - 12.0 * eps*eps*eps) / (12.0 * eta*eta*eta*eps*eps*eps);
}
R = exp(-0.5*a*eta*eta)/(M_SQRT2*M_SQRTPI*rta) * (c0 + c1/a);
result->val = 0.5 * erfc.val + R;
result->err = GSL_DBL_EPSILON * fabs(R * 0.5 * a*eta*eta) + 0.5 * erfc.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_ln;
}
/* Uniform asymptotic for x near a, a and x large.
* See [Temme, p. 285]
* FIXME: need c1 coefficient
*/
static
int
gamma_inc_Q_asymp_unif(const double a, const double x, gsl_sf_result * result)
{
const double rta = sqrt(a);
const double eps = (x-a)/a;
gsl_sf_result ln_term;
const int stat_ln = gsl_sf_log_1plusx_mx_e(eps, &ln_term); /* log(1+eps) - eps */
const double eta = eps * sqrt(-2.0*ln_term.val/(eps*eps));
gsl_sf_result erfc;
double R;
double c0, c1;
gsl_sf_erfc_e(eta*M_SQRT2*rta, &erfc);
if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
c0 = -1.0/3.0 + eps*(1.0/12.0 - eps*(23.0/540.0 - eps*(353.0/12960.0 - eps*589.0/30240.0)));
c1 = 0.0;
}
else {
double rt_term;
rt_term = sqrt(-2.0 * ln_term.val/(eps*eps));
c0 = (1.0 - 1.0/rt_term)/eps;
c1 = 0.0;
}
R = exp(-0.5*a*eta*eta)/(M_SQRT2*M_SQRTPI*rta) * (c0 + c1/a);
result->val = 0.5 * erfc.val + R;
result->err = GSL_DBL_EPSILON * fabs(R * 0.5 * a*eta*eta) + 0.5 * erfc.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_ln;
}
double gsl_sf_log_1plusx_mx(const double x)
{
EVAL_RESULT(gsl_sf_log_1plusx_mx_e(x, &result));
}
static VALUE Log_log_1px_mx_e(VALUE self, VALUE x) {
int ret;
gsl_sf_result r;
ret = gsl_sf_log_1plusx_mx_e(NUM2DBL(x), &r);
return RESULT(&r);
}
