static double
beta_inc_AXPY (const double A, const double Y,
const double a, const double b, const double x)
{
if (x == 0.0)
{
return A * 0 + Y;
}
else if (x == 1.0)
{
return A * 1 + Y;
}
else if (a > 1e5 && b < 10 && x > a / (a + b))
{
/* Handle asymptotic regime, large a, small b, x > peak [AS 26.5.17] */
double N = a + (b - 1.0) / 2.0;
return A * gsl_sf_gamma_inc_Q (b, -N * log (x)) + Y;
}
else if (b > 1e5 && a < 10 && x < b / (a + b))
{
/* Handle asymptotic regime, small a, large b, x < peak [AS 26.5.17] */
double N = b + (a - 1.0) / 2.0;
return A * gsl_sf_gamma_inc_P (a, -N * log1p (-x)) + Y;
}
else
{
double ln_beta = gsl_sf_lnbeta (a, b);
double ln_pre = -ln_beta + a * log (x) + b * log1p (-x);
double prefactor = exp (ln_pre);
if (x < (a + 1.0) / (a + b + 2.0))
{
/* Apply continued fraction directly. */
double epsabs = fabs (Y / (A * prefactor / a)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (a, b, x, epsabs);
return A * (prefactor * cf / a) + Y;
}
else
{
/* Apply continued fraction after hypergeometric transformation. */
double epsabs =
fabs ((A + Y) / (A * prefactor / b)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (b, a, 1.0 - x, epsabs);
double term = prefactor * cf / b;
if (A == -Y)
{
return -A * term;
}
else
{
return A * (1 - term) + Y;
}
}
}
}
double cis_betaLogLikelihood(const gsl_vector *v, void *params) {
double * p = (double *) params;
double beta_shape1 = gsl_vector_get(v, 0);
double beta_shape2 = gsl_vector_get(v, 1);
if (beta_shape1 < BETA_SHAPE1_MIN) throw cis_learn_beta_exception("beta_shape1 too small [" + stb.str(beta_shape1, 3) + "]");
if (beta_shape1 > BETA_SHAPE1_MAX) throw cis_learn_beta_exception("beta_shape1 too large [" + stb.str(beta_shape1, 3) + "]");
if (beta_shape2 < BETA_SHAPE2_MIN) throw cis_learn_beta_exception("beta_shape2 too small [" + stb.str(beta_shape2, 3) + "]");
if (beta_shape2 > BETA_SHAPE2_MAX) throw cis_learn_beta_exception("beta_shape2 too large [" + stb.str(beta_shape2, 3) + "]");
return -1.0 * ((beta_shape1 - 1) * p[0] + (beta_shape2 - 1) * p[1] - p[2] * gsl_sf_lnbeta(beta_shape1, beta_shape2));
}
static double
beta_inc_AXPY (const double A, const double Y,
const double a, const double b, const double x)
{
if (x == 0.0)
{
return A * 0 + Y;
}
else if (x == 1.0)
{
return A * 1 + Y;
}
else
{
double ln_beta = gsl_sf_lnbeta (a, b);
double ln_pre = -ln_beta + a * log (x) + b * log1p (-x);
double prefactor = exp (ln_pre);
if (x < (a + 1.0) / (a + b + 2.0))
{
/* Apply continued fraction directly. */
double epsabs = fabs (Y / (A * prefactor / a)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (a, b, x, epsabs);
return A * (prefactor * cf / a) + Y;
}
else
{
/* Apply continued fraction after hypergeometric transformation. */
double epsabs =
fabs ((A + Y) / (A * prefactor / b)) * GSL_DBL_EPSILON;
double cf = beta_cont_frac (b, a, 1.0 - x, epsabs);
double term = prefactor * cf / b;
if (A == -Y)
{
return -A * term;
}
else
{
return A * (1 - term) + Y;
}
}
}
}
static VALUE rb_gsl_sf_lnbeta(VALUE obj, VALUE a, VALUE b)
{
Need_Float(a); Need_Float(b);
return rb_float_new(gsl_sf_lnbeta(NUM2DBL(a), NUM2DBL(b)));
}
