/* Analytical solution for change point for given CDF and change point k0 as well as hyperparameters alpha and beta */ double probChangePoint(const int *CDF, int k0, int n, double alpha, double beta) { int succIn1=CDF[k0], failIn1 = k0-CDF[k0]; int succIn2=CDF[n-1]-CDF[k0], failIn2 = n-k0-succIn2; int status; double p1,p2; gsl_sf_result result; /* fprintf(OUT, "Successes until k0 = %i: %i\n", k0, succIn1); */ /* fprintf(OUT, "Failures: %i\n", failIn1); */ /* fprintf(OUT, "\nSuccesses after k0 = %i: %i\n", k0, succIn2); */ /* fprintf(OUT, "Failures: %i\n", failIn2); */ status = gsl_sf_beta_e (succIn1+alpha+1, failIn1+beta+1, &result); if(status != GSL_SUCCESS) { fprintf(ERR, "Evaluation of beta function B(%f,%f) failed.\n", succIn1+alpha+1, failIn1+beta+1); exit(1); } p1=result.val; status = gsl_sf_beta_e (succIn2+alpha+1, failIn2+beta+1, &result); if(status != GSL_SUCCESS) { fprintf(ERR, "Evaluation of beta function B(%f,%f) failed.\n", succIn2+alpha+1, failIn2+beta+1); exit(1); } p2=result.val; return p1*p2; }
/// Beta functions. double beta(double x, double y) { gsl_sf_result result; int stat = gsl_sf_beta_e(x, y, &result); if (stat != GSL_SUCCESS) { std::ostringstream msg("Error in beta:"); msg << " x=" << x << " y=" << y; throw std::runtime_error(msg.str()); } else return result.val; }
double gsl_sf_beta(const double x, const double y) { EVAL_RESULT(gsl_sf_beta_e(x, y, &result)); }
int gsl_sf_beta_inc_e( const double a, const double b, const double x, gsl_sf_result * result ) { if(x < 0.0 || x > 1.0) { DOMAIN_ERROR(result); } else if (isnegint(a) || isnegint(b)) { DOMAIN_ERROR(result); } else if (isnegint(a+b)) { DOMAIN_ERROR(result); } else if(x == 0.0) { result->val = 0.0; result->err = 0.0; return GSL_SUCCESS; } else if(x == 1.0) { result->val = 1.0; result->err = 0.0; return GSL_SUCCESS; } else if (a <= 0 || b <= 0) { gsl_sf_result f, beta; int stat; const int stat_f = gsl_sf_hyperg_2F1_e(a, 1-b, a+1, x, &f); const int stat_beta = gsl_sf_beta_e(a, b, &beta); double prefactor = (pow(x, a) / a); result->val = prefactor * f.val / beta.val; result->err = fabs(prefactor) * f.err/ fabs(beta.val) + fabs(result->val/beta.val) * beta.err; stat = GSL_ERROR_SELECT_2(stat_f, stat_beta); if(stat == GSL_SUCCESS) { CHECK_UNDERFLOW(result); } return stat; } else { gsl_sf_result ln_beta; gsl_sf_result ln_x; gsl_sf_result ln_1mx; gsl_sf_result prefactor; const int stat_ln_beta = gsl_sf_lnbeta_e(a, b, &ln_beta); const int stat_ln_1mx = gsl_sf_log_1plusx_e(-x, &ln_1mx); const int stat_ln_x = gsl_sf_log_e(x, &ln_x); const int stat_ln = GSL_ERROR_SELECT_3(stat_ln_beta, stat_ln_1mx, stat_ln_x); const double ln_pre_val = -ln_beta.val + a * ln_x.val + b * ln_1mx.val; const double ln_pre_err = ln_beta.err + fabs(a*ln_x.err) + fabs(b*ln_1mx.err); const int stat_exp = gsl_sf_exp_err_e(ln_pre_val, ln_pre_err, &prefactor); if(stat_ln != GSL_SUCCESS) { result->val = 0.0; result->err = 0.0; GSL_ERROR ("error", GSL_ESANITY); } if(x < (a + 1.0)/(a+b+2.0)) { /* Apply continued fraction directly. */ gsl_sf_result cf; const int stat_cf = beta_cont_frac(a, b, x, &cf); int stat; result->val = prefactor.val * cf.val / a; result->err = (fabs(prefactor.err * cf.val) + fabs(prefactor.val * cf.err))/a; stat = GSL_ERROR_SELECT_2(stat_exp, stat_cf); if(stat == GSL_SUCCESS) { CHECK_UNDERFLOW(result); } return stat; } else { /* Apply continued fraction after hypergeometric transformation. */ gsl_sf_result cf; const int stat_cf = beta_cont_frac(b, a, 1.0-x, &cf); int stat; const double term = prefactor.val * cf.val / b; result->val = 1.0 - term; result->err = fabs(prefactor.err * cf.val)/b; result->err += fabs(prefactor.val * cf.err)/b; result->err += 2.0 * GSL_DBL_EPSILON * (1.0 + fabs(term)); stat = GSL_ERROR_SELECT_2(stat_exp, stat_cf); if(stat == GSL_SUCCESS) { CHECK_UNDERFLOW(result); } return stat; } } }