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