int gsl_sf_lncosh_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(fabs(x) < 1.0) {
double eps;
cosh_m1_series(x, &eps);
return gsl_sf_log_1plusx_e(eps, result);
}
else if(x < -0.5*GSL_LOG_DBL_EPSILON) {
result->val = x + log(0.5*(1.0 + exp(-2.0*x)));
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
result->val = -M_LN2 + x;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
int
gsl_sf_lnbeta_sgn_e(const double x, const double y, gsl_sf_result * result, double * sgn)
{
/* CHECK_POINTER(result) */
if(x == 0.0 || y == 0.0) {
*sgn = 0.0;
DOMAIN_ERROR(result);
} else if (isnegint(x) || isnegint(y)) {
*sgn = 0.0;
DOMAIN_ERROR(result); /* not defined for negative integers */
}
/* See if we can handle the postive case with min/max < 0.2 */
if (x > 0 && y > 0) {
const double max = GSL_MAX(x,y);
const double min = GSL_MIN(x,y);
const double rat = min/max;
if(rat < 0.2) {
/* min << max, so be careful
* with the subtraction
*/
double lnpre_val;
double lnpre_err;
double lnpow_val;
double lnpow_err;
double t1, t2, t3;
gsl_sf_result lnopr;
gsl_sf_result gsx, gsy, gsxy;
gsl_sf_gammastar_e(x, &gsx);
gsl_sf_gammastar_e(y, &gsy);
gsl_sf_gammastar_e(x+y, &gsxy);
gsl_sf_log_1plusx_e(rat, &lnopr);
lnpre_val = log(gsx.val*gsy.val/gsxy.val * M_SQRT2*M_SQRTPI);
lnpre_err = gsx.err/gsx.val + gsy.err/gsy.val + gsxy.err/gsxy.val;
t1 = min*log(rat);
t2 = 0.5*log(min);
t3 = (x+y-0.5)*lnopr.val;
lnpow_val = t1 - t2 - t3;
lnpow_err = GSL_DBL_EPSILON * (fabs(t1) + fabs(t2) + fabs(t3));
lnpow_err += fabs(x+y-0.5) * lnopr.err;
result->val = lnpre_val + lnpow_val;
result->err = lnpre_err + lnpow_err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
*sgn = 1.0;
return GSL_SUCCESS;
}
}
/* General case - Fallback */
{
gsl_sf_result lgx, lgy, lgxy;
double sgx, sgy, sgxy, xy = x+y;
int stat_gx = gsl_sf_lngamma_sgn_e(x, &lgx, &sgx);
int stat_gy = gsl_sf_lngamma_sgn_e(y, &lgy, &sgy);
int stat_gxy = gsl_sf_lngamma_sgn_e(xy, &lgxy, &sgxy);
*sgn = sgx * sgy * sgxy;
result->val = lgx.val + lgy.val - lgxy.val;
result->err = lgx.err + lgy.err + lgxy.err;
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(lgx.val) + fabs(lgy.val) + fabs(lgxy.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_3(stat_gx, stat_gy, stat_gxy);
}
}
int
gsl_sf_legendre_sphPlm_array(const int lmax, int m, const double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(m < 0 || lmax < m || x < -1.0 || x > 1.0) {
GSL_ERROR ("error", GSL_EDOM);
}
else if(m > 0 && (x == 1.0 || x == -1.0)) {
int ell;
for(ell=m; ell<=lmax; ell++) result_array[ell-m] = 0.0;
return GSL_SUCCESS;
}
else {
double y_mm;
double y_mmp1;
if(m == 0) {
y_mm = 0.5/M_SQRTPI; /* Y00 = 1/sqrt(4pi) */
y_mmp1 = x * M_SQRT3 * y_mm;
}
else {
/* |x| < 1 here */
gsl_sf_result lncirc;
gsl_sf_result lnpoch;
double lnpre;
const double sgn = ( GSL_IS_ODD(m) ? -1.0 : 1.0);
gsl_sf_log_1plusx_e(-x*x, &lncirc);
gsl_sf_lnpoch_e(m, 0.5, &lnpoch); /* Gamma(m+1/2)/Gamma(m) */
lnpre = -0.25*M_LNPI + 0.5 * (lnpoch.val + m*lncirc.val);
y_mm = sqrt((2.0+1.0/m)/(4.0*M_PI)) * sgn * exp(lnpre);
y_mmp1 = x * sqrt(2.0*m + 3.0) * y_mm;
}
if(lmax == m){
result_array[0] = y_mm;
return GSL_SUCCESS;
}
else if(lmax == m + 1) {
result_array[0] = y_mm;
result_array[1] = y_mmp1;
return GSL_SUCCESS;
}
else{
double y_ell;
int ell;
result_array[0] = y_mm;
result_array[1] = y_mmp1;
/* Compute Y_l^m, l > m+1, upward recursion on l. */
for(ell=m+2; ell <= lmax; ell++){
const double rat1 = (double)(ell-m)/(double)(ell+m);
const double rat2 = (ell-m-1.0)/(ell+m-1.0);
const double factor1 = sqrt(rat1*(2*ell+1)*(2*ell-1));
const double factor2 = sqrt(rat1*rat2*(2*ell+1)/(2*ell-3));
y_ell = (x*y_mmp1*factor1 - (ell+m-1)*y_mm*factor2) / (ell-m);
y_mm = y_mmp1;
y_mmp1 = y_ell;
result_array[ell-m] = y_ell;
}
}
return GSL_SUCCESS;
}
}
int
gsl_sf_legendre_sphPlm_e(const int l, int m, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(m < 0 || l < m || x < -1.0 || x > 1.0) {
DOMAIN_ERROR(result);
}
else if(m == 0) {
gsl_sf_result P;
int stat_P = gsl_sf_legendre_Pl_e(l, x, &P);
double pre = sqrt((2.0*l + 1.0)/(4.0*M_PI));
result->val = pre * P.val;
result->err = pre * P.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_P;
}
else if(x == 1.0 || x == -1.0) {
/* m > 0 here */
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
/* m > 0 and |x| < 1 here */
/* Starting value for recursion.
* Y_m^m(x) = sqrt( (2m+1)/(4pi m) gamma(m+1/2)/gamma(m) ) (-1)^m (1-x^2)^(m/2) / pi^(1/4)
*/
gsl_sf_result lncirc;
gsl_sf_result lnpoch;
double lnpre_val;
double lnpre_err;
gsl_sf_result ex_pre;
double sr;
const double sgn = ( GSL_IS_ODD(m) ? -1.0 : 1.0);
const double y_mmp1_factor = x * sqrt(2.0*m + 3.0);
double y_mm, y_mm_err;
double y_mmp1;
gsl_sf_log_1plusx_e(-x*x, &lncirc);
gsl_sf_lnpoch_e(m, 0.5, &lnpoch); /* Gamma(m+1/2)/Gamma(m) */
lnpre_val = -0.25*M_LNPI + 0.5 * (lnpoch.val + m*lncirc.val);
lnpre_err = 0.25*M_LNPI*GSL_DBL_EPSILON + 0.5 * (lnpoch.err + fabs(m)*lncirc.err);
gsl_sf_exp_err_e(lnpre_val, lnpre_err, &ex_pre);
sr = sqrt((2.0+1.0/m)/(4.0*M_PI));
y_mm = sgn * sr * ex_pre.val;
y_mmp1 = y_mmp1_factor * y_mm;
y_mm_err = 2.0 * GSL_DBL_EPSILON * fabs(y_mm) + sr * ex_pre.err;
y_mm_err *= 1.0 + 1.0/(GSL_DBL_EPSILON + fabs(1.0-x));
if(l == m){
result->val = y_mm;
result->err = y_mm_err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(y_mm);
return GSL_SUCCESS;
}
else if(l == m + 1) {
result->val = y_mmp1;
result->err = fabs(y_mmp1_factor) * y_mm_err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(y_mmp1);
return GSL_SUCCESS;
}
else{
double y_ell = 0.0;
int ell;
/* Compute Y_l^m, l > m+1, upward recursion on l. */
for(ell=m+2; ell <= l; ell++){
const double rat1 = (double)(ell-m)/(double)(ell+m);
const double rat2 = (ell-m-1.0)/(ell+m-1.0);
const double factor1 = sqrt(rat1*(2*ell+1)*(2*ell-1));
const double factor2 = sqrt(rat1*rat2*(2*ell+1)/(2*ell-3));
y_ell = (x*y_mmp1*factor1 - (ell+m-1)*y_mm*factor2) / (ell-m);
y_mm = y_mmp1;
y_mmp1 = y_ell;
}
result->val = y_ell;
result->err = (0.5*(l-m) + 1.0) * GSL_DBL_EPSILON * fabs(y_ell);
result->err += fabs(y_mm_err/y_mm) * fabs(y_ell);
return GSL_SUCCESS;
}
}
}
/* Assumes a>0 and a+x>0.
*/
static
int
lnpoch_pos(const double a, const double x, gsl_sf_result * result)
{
double absx = fabs(x);
if(absx > 0.1*a || absx*log(GSL_MAX_DBL(a,2.0)) > 0.1) {
if(a < GSL_SF_GAMMA_XMAX && a+x < GSL_SF_GAMMA_XMAX) {
/* If we can do it by calculating the gamma functions
* directly, then that will be more accurate than
* doing the subtraction of the logs.
*/
gsl_sf_result g1;
gsl_sf_result g2;
gsl_sf_gammainv_e(a, &g1);
gsl_sf_gammainv_e(a+x, &g2);
result->val = -log(g2.val/g1.val);
result->err = g1.err/fabs(g1.val) + g2.err/fabs(g2.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
/* Otherwise we must do the subtraction.
*/
gsl_sf_result lg1;
gsl_sf_result lg2;
int stat_1 = gsl_sf_lngamma_e(a, &lg1);
int stat_2 = gsl_sf_lngamma_e(a+x, &lg2);
result->val = lg2.val - lg1.val;
result->err = lg2.err + lg1.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_1, stat_2);
}
}
else if(absx < 0.1*a && a > 15.0) {
/* Be careful about the implied subtraction.
* Note that both a+x and and a must be
* large here since a is not small
* and x is not relatively large.
* So we calculate using Stirling for Log[Gamma(z)].
*
* Log[Gamma(a+x)/Gamma(a)] = x(Log[a]-1) + (x+a-1/2)Log[1+x/a]
* + (1/(1+eps) - 1) / (12 a)
* - (1/(1+eps)^3 - 1) / (360 a^3)
* + (1/(1+eps)^5 - 1) / (1260 a^5)
* - (1/(1+eps)^7 - 1) / (1680 a^7)
* + ...
*/
const double eps = x/a;
const double den = 1.0 + eps;
const double d3 = den*den*den;
const double d5 = d3*den*den;
const double d7 = d5*den*den;
const double c1 = -eps/den;
const double c3 = -eps*(3.0+eps*(3.0+eps))/d3;
const double c5 = -eps*(5.0+eps*(10.0+eps*(10.0+eps*(5.0+eps))))/d5;
const double c7 = -eps*(7.0+eps*(21.0+eps*(35.0+eps*(35.0+eps*(21.0+eps*(7.0+eps))))))/d7;
const double p8 = gsl_sf_pow_int(1.0+eps,8);
const double c8 = 1.0/p8 - 1.0; /* these need not */
const double c9 = 1.0/(p8*(1.0+eps)) - 1.0; /* be very accurate */
const double a4 = a*a*a*a;
const double a6 = a4*a*a;
const double ser_1 = c1 + c3/(30.0*a*a) + c5/(105.0*a4) + c7/(140.0*a6);
const double ser_2 = c8/(99.0*a6*a*a) - 691.0/360360.0 * c9/(a6*a4);
const double ser = (ser_1 + ser_2)/ (12.0*a);
double term1 = x * log(a/M_E);
double term2;
gsl_sf_result ln_1peps;
gsl_sf_log_1plusx_e(eps, &ln_1peps); /* log(1 + x/a) */
term2 = (x + a - 0.5) * ln_1peps.val;
result->val = term1 + term2 + ser;
result->err = GSL_DBL_EPSILON*fabs(term1);
result->err += fabs((x + a - 0.5)*ln_1peps.err);
result->err += fabs(ln_1peps.val) * GSL_DBL_EPSILON * (fabs(x) + fabs(a) + 0.5);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result poch_rel;
int stat_p = pochrel_smallx(a, x, &poch_rel);
double eps = x*poch_rel.val;
int stat_e = gsl_sf_log_1plusx_e(eps, result);
result->err = 2.0 * fabs(x * poch_rel.err / (1.0 + eps));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_e, stat_p);
}
}
int
gsl_sf_beta_inc_e(
const double a,
const double b,
const double x,
gsl_sf_result * result
)
{
if(a <= 0.0 || b <= 0.0 || x < 0.0 || x > 1.0) {
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 {
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;
}
}
}
double gsl_sf_log_1plusx(const double x)
{
EVAL_RESULT(gsl_sf_log_1plusx_e(x, &result));
}
static VALUE Log_log_1px_e(VALUE self, VALUE x) {
int ret;
gsl_sf_result r;
ret = gsl_sf_log_1plusx_e(NUM2DBL(x), &r);
return RESULT(&r);
}
