/*
Parameters:
s - the input floating-point number
n, p - parameters from the algorithm
tc - an array of p floating-point numbers tc[1]..tc[p]
Output:
b is the result, i.e.
sum(tc[i]*product((s+2j)*(s+2j-1)/n^2,j=1..i-1), i=1..p)*s*n^(-s-1)
*/
static void
mpfr_zeta_part_b (mpfr_t b, mpfr_srcptr s, int n, int p, mpfr_t *tc)
{
mpfr_t s1, d, u;
unsigned long n2;
int l, t;
MPFR_GROUP_DECL (group);
if (p == 0)
{
MPFR_SET_ZERO (b);
MPFR_SET_POS (b);
return;
}
n2 = n * n;
MPFR_GROUP_INIT_3 (group, MPFR_PREC (b), s1, d, u);
/* t equals 2p-2, 2p-3, ... ; s1 equals s+t */
t = 2 * p - 2;
mpfr_set (d, tc[p], GMP_RNDN);
for (l = 1; l < p; l++)
{
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l-1) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_div_ui (d, d, n2, GMP_RNDN);
mpfr_add (d, d, tc[p-l], GMP_RNDN);
/* since s is positive and the tc[i] have alternate signs,
the following is unlikely */
if (MPFR_UNLIKELY (mpfr_cmpabs (d, tc[p-l]) > 0))
mpfr_set (d, tc[p-l], GMP_RNDN);
}
mpfr_mul (d, d, s, GMP_RNDN);
mpfr_add (s1, s, __gmpfr_one, GMP_RNDN);
mpfr_neg (s1, s1, GMP_RNDN);
mpfr_ui_pow (u, n, s1, GMP_RNDN);
mpfr_mul (b, d, u, GMP_RNDN);
MPFR_GROUP_CLEAR (group);
}
/* Input: s - a floating-point number
n - an integer
Output: sum - a floating-point number approximating sum(1/i^s, i=1..n-1) */
static void
mpfr_zeta_part_a (mpfr_t sum, mpfr_srcptr s, int n)
{
mpfr_t u, s1;
int i;
MPFR_GROUP_DECL (group);
MPFR_GROUP_INIT_2 (group, MPFR_PREC (sum), u, s1);
mpfr_neg (s1, s, GMP_RNDN);
mpfr_ui_pow (u, n, s1, GMP_RNDN);
mpfr_div_2ui (u, u, 1, GMP_RNDN);
mpfr_set (sum, u, GMP_RNDN);
for (i=n-1; i>1; i--)
{
mpfr_ui_pow (u, i, s1, GMP_RNDN);
mpfr_add (sum, sum, u, GMP_RNDN);
}
mpfr_add (sum, sum, __gmpfr_one, GMP_RNDN);
MPFR_GROUP_CLEAR (group);
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", xt, xt, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mp_exp_t d;
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* compute sinh */
mpfr_clear_flags ();
mpfr_exp (t, x, GMP_RNDD); /* exp(x) */
/* exp(x) can overflow! */
/* BUG/TODO/FIXME: exp can overflow but sinh may be representable! */
if (MPFR_UNLIKELY (mpfr_overflow_p ())) {
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, GMP_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, GMP_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y), rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_tanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
/****** Declaration ******/
mpfr_t x;
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special value checking */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
/* tanh(inf) = 1 && tanh(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (xt), rnd_mode);
}
else /* tanh (0) = 0 and xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO(xt));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* tanh(x) = x - x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 0,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te;
mpfr_exp_t d;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
long int err; /* error */
int sign = MPFR_SIGN (xt);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
/* First check for BIG overflow of exp(2*x):
For x > 0, exp(2*x) > 2^(2*x)
If 2 ^(2*x) > 2^emax or x>emax/2, there is an overflow */
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax/2) >= 0)) {
/* initialise of intermediary variables
since 'set_one' label assumes the variables have been
initialize */
MPFR_GROUP_INIT_2 (group, MPFR_PREC_MIN, t, te);
goto set_one;
}
/* Compute the precision of intermediary variable */
/* The optimal number of bits: see algorithms.tex */
Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 4;
/* if x is small, there will be a cancellation in exp(2x)-1 */
if (MPFR_GET_EXP (x) < 0)
Nt += -MPFR_GET_EXP (x);
/* initialise of intermediary variable */
MPFR_GROUP_INIT_2 (group, Nt, t, te);
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* tanh = (exp(2x)-1)/(exp(2x)+1) */
mpfr_mul_2ui (te, x, 1, MPFR_RNDN); /* 2x */
/* since x > 0, we can only have an overflow */
mpfr_exp (te, te, MPFR_RNDN); /* exp(2x) */
if (MPFR_UNLIKELY (MPFR_IS_INF (te))) {
set_one:
inexact = MPFR_FROM_SIGN_TO_INT (sign);
mpfr_set4 (y, __gmpfr_one, MPFR_RNDN, sign);
if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG_SIGN (sign)))
{
inexact = -inexact;
mpfr_nexttozero (y);
}
break;
}
d = MPFR_GET_EXP (te); /* For Error calculation */
mpfr_add_ui (t, te, 1, MPFR_RNDD); /* exp(2x) + 1*/
mpfr_sub_ui (te, te, 1, MPFR_RNDU); /* exp(2x) - 1*/
d = d - MPFR_GET_EXP (te);
mpfr_div (t, te, t, MPFR_RNDN); /* (exp(2x)-1)/(exp(2x)+1)*/
/* Calculation of the error */
d = MAX(3, d + 1);
err = Nt - (d + 1);
if (MPFR_LIKELY ((d <= Nt / 2) && MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, sign);
break;
}
/* if t=1, we still can round since |sinh(x)| < 1 */
if (MPFR_GET_EXP (t) == 1)
goto set_one;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, te);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
inexact = mpfr_check_range (y, inexact, rnd_mode);
return inexact;
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mpfr_exp_t d;
mpfr_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh */
MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */
/* t <- cosh(x/2): error(t) <= 1 ulp(t) */
MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
overflows too */
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
mpfr_sinh (ti, ti, MPFR_RNDD);
/* multiplication below, error(t) <= 5 ulp(t) */
MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* doubling below, exact */
MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* we have lost at most 3 bits of precision */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
err = Nt; /* double the precision */
}
else
{
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact_sh, inexact_ch;
MPFR_ASSERTN (sh != ch);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg",
mpfr_get_prec (sh), mpfr_log_prec, sh,
mpfr_get_prec (ch), mpfr_log_prec, ch));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (ch);
MPFR_SET_NAN (sh);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (sh);
MPFR_SET_SAME_SIGN (sh, xt);
MPFR_SET_INF (ch);
MPFR_SET_POS (ch);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (sh); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (sh, xt);
inexact_sh = 0;
inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */
return INEX(inexact_sh,inexact_ch);
}
}
/* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure
that the code also works in case of overlap (see sin_cos.c) */
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t s, c, ti;
mpfr_exp_t d;
mpfr_prec_t N; /* Precision of the intermediary variables */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
N = MPFR_PREC (ch);
N = MAX (N, MPFR_PREC (sh));
/* the optimal number of bits : see algorithms.ps */
N = N + MPFR_INT_CEIL_LOG2 (N) + 4;
/* initialise of intermediary variables */
MPFR_GROUP_INIT_3 (group, N, s, c, ti);
/* First computation of sinh_cosh */
MPFR_ZIV_INIT (loop, N);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh_cosh */
MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* since cosh(x) >= exp(x), cosh(x) overflows too */
inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS);
/* sinh(x) may be representable */
inexact_sh = mpfr_sinh (sh, xt, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (s);
mpfr_ui_div (ti, 1, s, MPFR_RNDU); /* 1/exp(x) */
mpfr_add (c, s, ti, MPFR_RNDU); /* exp(x) + 1/exp(x) */
mpfr_sub (s, s, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* 1/2(exp(x) + 1/exp(x)) */
mpfr_div_2ui (s, s, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that s is zero (in fact, it can only occur when exp(x)=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (s))
err = N; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (s) + 2;
/* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = N - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh),
rnd_mode) && \
MPFR_CAN_ROUND (c, err, MPFR_PREC (ch),
rnd_mode)))
{
inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt));
inexact_ch = mpfr_set (ch, c, rnd_mode);
break;
}
}
/* actualisation of the precision */
N += err;
MPFR_ZIV_NEXT (loop, N);
MPFR_GROUP_REPREC_3 (group, N, s, c, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
/* now, let's raise the flags if needed */
inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode);
inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode);
return INEX(inexact_sh,inexact_ch);
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t K0, K, precy, m, k, l;
int inexact, reduce = 0;
mpfr_t r, s, xr, c;
mpfr_exp_t exps, cancel = 0, expx;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_LOG_FUNC (
("x[%Pu]=%*.Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%*.Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y,
inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* cos(x) = 1-x^2/2 + ..., so error < 2^(2*EXP(x)-1) */
expx = MPFR_GET_EXP (x);
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, -2 * expx,
1, 0, rnd_mode, expo, {});
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_cos_fast (y, x, rnd_mode);
}
K0 = __gmpfr_isqrt (precy / 3);
m = precy + 2 * MPFR_INT_CEIL_LOG2 (precy) + 2 * K0;
if (expx >= 3)
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_init2 call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_init2 (c, expx + m - 1);
mpfr_init2 (xr, m);
}
MPFR_GROUP_INIT_2 (group, m, r, s);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* If |x| >= 4, first reduce x cmod (2*Pi) into xr, using mpfr_remainder:
let e = EXP(x) >= 3, and m the target precision:
(1) c <- 2*Pi [precision e+m-1, nearest]
(2) xr <- remainder (x, c) [precision m, nearest]
We have |c - 2*Pi| <= 1/2ulp(c) = 2^(3-e-m)
|xr - x - k c| <= 1/2ulp(xr) <= 2^(1-m)
|k| <= |x|/(2*Pi) <= 2^(e-2)
Thus |xr - x - 2kPi| <= |k| |c - 2Pi| + 2^(1-m) <= 2^(2-m).
It follows |cos(xr) - cos(x)| <= 2^(2-m). */
if (reduce)
{
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN); /* 2Pi */
mpfr_remainder (xr, x, c, MPFR_RNDN);
if (MPFR_IS_ZERO(xr))
goto ziv_next;
/* now |xr| <= 4, thus r <= 16 below */
mpfr_mul (r, xr, xr, MPFR_RNDU); /* err <= 1 ulp */
}
else
mpfr_mul (r, x, x, MPFR_RNDU); /* err <= 1 ulp */
/* now |x| < 4 (or xr if reduce = 1), thus |r| <= 16 */
/* we need |r| < 1/2 for mpfr_cos2_aux, i.e., EXP(r) - 2K <= -1 */
K = K0 + 1 + MAX(0, MPFR_GET_EXP(r)) / 2;
/* since K0 >= 0, if EXP(r) < 0, then K >= 1, thus EXP(r) - 2K <= -3;
otherwise if EXP(r) >= 0, then K >= 1/2 + EXP(r)/2, thus
EXP(r) - 2K <= -1 */
MPFR_SET_EXP (r, MPFR_GET_EXP (r) - 2 * K); /* Can't overflow! */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
/* l is the error bound in ulps on s */
MPFR_SET_ONE (r);
for (k = 0; k < K; k++)
{
mpfr_sqr (s, s, MPFR_RNDU); /* err <= 2*olderr */
MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); /* Can't overflow */
mpfr_sub (s, s, r, MPFR_RNDN); /* err <= 4*olderr */
if (MPFR_IS_ZERO(s))
goto ziv_next;
MPFR_ASSERTD (MPFR_GET_EXP (s) <= 1);
}
/* The absolute error on s is bounded by (2l+1/3)*2^(2K-m)
2l+1/3 <= 2l+1.
If |x| >= 4, we need to add 2^(2-m) for the argument reduction
by 2Pi: if K = 0, this amounts to add 4 to 2l+1/3, i.e., to add
2 to l; if K >= 1, this amounts to add 1 to 2*l+1/3. */
l = 2 * l + 1;
if (reduce)
l += (K == 0) ? 4 : 1;
k = MPFR_INT_CEIL_LOG2 (l) + 2*K;
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
exps = MPFR_GET_EXP (s);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, exps + m - k, precy, rnd_mode)))
break;
if (MPFR_UNLIKELY (exps == 1))
/* s = 1 or -1, and except x=0 which was already checked above,
cos(x) cannot be 1 or -1, so we can round if the error is less
than 2^(-precy) for directed rounding, or 2^(-precy-1) for rounding
to nearest. */
{
if (m > k && (m - k >= precy + (rnd_mode == MPFR_RNDN)))
{
/* If round to nearest or away, result is s = 1 or -1,
otherwise it is round(nexttoward (s, 0)). However in order to
have the inexact flag correctly set below, we set |s| to
1 - 2^(-m) in all cases. */
mpfr_nexttozero (s);
break;
}
}
if (exps < cancel)
{
m += cancel - exps;
cancel = exps;
}
ziv_next:
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, r, s);
if (reduce)
{
mpfr_set_prec (xr, m);
mpfr_set_prec (c, expx + m - 1);
}
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
MPFR_GROUP_CLEAR (group);
if (reduce)
{
mpfr_clear (xr);
mpfr_clear (c);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_log (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_prec_t p, q;
mpfr_t tmp1, tmp2;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL(group);
MPFR_LOG_FUNC
(("a[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (a), mpfr_log_prec, a, rnd_mode),
("r[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (r), mpfr_log_prec, r,
inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a)))
{
/* If a is NaN, the result is NaN */
if (MPFR_IS_NAN (a))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* check for infinity before zero */
else if (MPFR_IS_INF (a))
{
if (MPFR_IS_NEG (a))
/* log(-Inf) = NaN */
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* log(+Inf) = +Inf */
{
MPFR_SET_INF (r);
MPFR_SET_POS (r);
MPFR_RET (0);
}
}
else /* a is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (a));
MPFR_SET_INF (r);
MPFR_SET_NEG (r);
mpfr_set_divby0 ();
MPFR_RET (0); /* log(0) is an exact -infinity */
}
}
/* If a is negative, the result is NaN */
else if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* If a is 1, the result is 0 */
else if (MPFR_UNLIKELY (MPFR_GET_EXP (a) == 1 && mpfr_cmp_ui (a, 1) == 0))
{
MPFR_SET_ZERO (r);
MPFR_SET_POS (r);
MPFR_RET (0); /* only "normal" case where the result is exact */
}
q = MPFR_PREC (r);
/* use initial precision about q+lg(q)+5 */
p = q + 5 + 2 * MPFR_INT_CEIL_LOG2 (q);
/* % ~(mpfr_prec_t)GMP_NUMB_BITS ;
m=q; while (m) { p++; m >>= 1; } */
/* if (MPFR_LIKELY(p % GMP_NUMB_BITS != 0))
p += GMP_NUMB_BITS - (p%GMP_NUMB_BITS); */
MPFR_SAVE_EXPO_MARK (expo);
MPFR_GROUP_INIT_2 (group, p, tmp1, tmp2);
MPFR_ZIV_INIT (loop, p);
for (;;)
{
long m;
mpfr_exp_t cancel;
/* Calculus of m (depends on p) */
m = (p + 1) / 2 - MPFR_GET_EXP (a) + 1;
mpfr_mul_2si (tmp2, a, m, MPFR_RNDN); /* s=a*2^m, err<=1 ulp */
mpfr_div (tmp1, __gmpfr_four, tmp2, MPFR_RNDN);/* 4/s, err<=2 ulps */
mpfr_agm (tmp2, __gmpfr_one, tmp1, MPFR_RNDN); /* AG(1,4/s),err<=3 ulps */
mpfr_mul_2ui (tmp2, tmp2, 1, MPFR_RNDN); /* 2*AG(1,4/s), err<=3 ulps */
mpfr_const_pi (tmp1, MPFR_RNDN); /* compute pi, err<=1ulp */
mpfr_div (tmp2, tmp1, tmp2, MPFR_RNDN); /* pi/2*AG(1,4/s), err<=5ulps */
mpfr_const_log2 (tmp1, MPFR_RNDN); /* compute log(2), err<=1ulp */
mpfr_mul_si (tmp1, tmp1, m, MPFR_RNDN); /* compute m*log(2),err<=2ulps */
mpfr_sub (tmp1, tmp2, tmp1, MPFR_RNDN); /* log(a), err<=7ulps+cancel */
if (MPFR_LIKELY (MPFR_IS_PURE_FP (tmp1) && MPFR_IS_PURE_FP (tmp2)))
{
cancel = MPFR_GET_EXP (tmp2) - MPFR_GET_EXP (tmp1);
MPFR_LOG_MSG (("canceled bits=%ld\n", (long) cancel));
MPFR_LOG_VAR (tmp1);
if (MPFR_UNLIKELY (cancel < 0))
cancel = 0;
/* we have 7 ulps of error from the above roundings,
4 ulps from the 4/s^2 second order term,
plus the canceled bits */
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp1, p-cancel-4, q, rnd_mode)))
break;
/* VL: I think it is better to have an increment that it isn't
too low; in particular, the increment must be positive even
if cancel = 0 (can this occur?). */
p += cancel >= 8 ? cancel : 8;
}
else
{
/* TODO: find why this case can occur and what is best to do
with it. */
p += 32;
}
MPFR_ZIV_NEXT (loop, p);
MPFR_GROUP_REPREC_2 (group, p, tmp1, tmp2);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (r, tmp1, rnd_mode);
/* We clean */
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (r, inexact, rnd_mode);
}
/* evaluates erf(x) using the expansion at x=0:
erf(x) = 2/sqrt(Pi) * sum((-1)^k*x^(2k+1)/k!/(2k+1), k=0..infinity)
Assumes x is neither NaN nor infinite nor zero.
Assumes also that e*x^2 <= n (target precision).
*/
static int
mpfr_erf_0 (mpfr_ptr res, mpfr_srcptr x, double xf2, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t n, m;
mpfr_exp_t nuk, sigmak;
double tauk;
mpfr_t y, s, t, u;
unsigned int k;
int log2tauk;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
n = MPFR_PREC (res); /* target precision */
/* initial working precision */
m = n + (mpfr_prec_t) (xf2 / LOG2) + 8 + MPFR_INT_CEIL_LOG2 (n);
MPFR_GROUP_INIT_4(group, m, y, s, t, u);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_mul (y, x, x, MPFR_RNDU); /* err <= 1 ulp */
mpfr_set_ui (s, 1, MPFR_RNDN);
mpfr_set_ui (t, 1, MPFR_RNDN);
tauk = 0.0;
for (k = 1; ; k++)
{
mpfr_mul (t, y, t, MPFR_RNDU);
mpfr_div_ui (t, t, k, MPFR_RNDU);
mpfr_div_ui (u, t, 2 * k + 1, MPFR_RNDU);
sigmak = MPFR_GET_EXP (s);
if (k % 2)
mpfr_sub (s, s, u, MPFR_RNDN);
else
mpfr_add (s, s, u, MPFR_RNDN);
sigmak -= MPFR_GET_EXP(s);
nuk = MPFR_GET_EXP(u) - MPFR_GET_EXP(s);
if ((nuk < - (mpfr_exp_t) m) && ((double) k >= xf2))
break;
/* tauk <- 1/2 + tauk * 2^sigmak + (1+8k)*2^nuk */
tauk = 0.5 + mul_2exp (tauk, sigmak)
+ mul_2exp (1.0 + 8.0 * (double) k, nuk);
}
mpfr_mul (s, x, s, MPFR_RNDU);
MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1);
mpfr_const_pi (t, MPFR_RNDZ);
mpfr_sqrt (t, t, MPFR_RNDZ);
mpfr_div (s, s, t, MPFR_RNDN);
tauk = 4.0 * tauk + 11.0; /* final ulp-error on s */
log2tauk = __gmpfr_ceil_log2 (tauk);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, m - log2tauk, n, rnd_mode)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_4 (group, m, y, s, t, u);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (res, s, rnd_mode);
MPFR_GROUP_CLEAR (group);
return inex;
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
double sd, eps, m1, c;
long add;
mp_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("s[%#R]=%R rnd=%d", s, s, rnd_mode),
("z[%#R]=%R inexact=%d", z, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, GMP_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
mpfr_set_ui (z, 1, rnd_mode);
mpfr_div_2ui (z, z, 1, rnd_mode);
MPFR_CHANGE_SIGN (z);
MPFR_RET (0);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|.
Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding
(the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest).
A sufficient condition is that EXP(s) + 1 < -PREC(z). */
if (MPFR_EXP(s) + 1 < - (mp_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if ((rnd_mode == GMP_RNDU || rnd_mode == GMP_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == GMP_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == GMP_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == GMP_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (GMP_RNDZ and s > 0) or GMP_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
sd = mpfr_get_d (s, GMP_RNDN) - 1.0;
if (sd < 0.0)
sd = -sd; /* now sd = abs(s-1.0) */
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
/* eps = pow (2.0, - (double) precz - 14.0); */
eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0);
m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps);
c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1));
/* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */
add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1));
prec1 = precz + add;
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_sub (s1, __gmpfr_one, s, GMP_RNDN);/* s1 = 1-s */
mpfr_zeta_pos (z_pre, s1, GMP_RNDN); /* zeta(1-s) */
mpfr_gamma (y, s1, GMP_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k,
Zeta(s) > 0 for -4k < s < -4k+2 */
{
MPFR_SET_INF (z_pre);
mpfr_div_2ui (s1, s, 2, GMP_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, GMP_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
MPFR_SET_NEG (z_pre);
else
MPFR_SET_POS (z_pre);
break;
}
mpfr_mul (z_pre, z_pre, y, GMP_RNDN); /* gamma(1-s)*zeta(1-s) */
mpfr_const_pi (p, GMP_RNDD);
mpfr_mul (y, s, p, GMP_RNDN);
mpfr_div_2ui (y, y, 1, GMP_RNDN); /* s*Pi/2 */
mpfr_sin (y, y, GMP_RNDN); /* sin(Pi*s/2) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (y, p, 1, GMP_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, GMP_RNDN); /* s-1 */
mpfr_pow (y, y, s1, GMP_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, GMP_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Input: s - a floating-point number >= 1/2.
rnd_mode - a rounding mode.
Assumes s is neither NaN nor Infinite.
Output: z - Zeta(s) rounded to the precision of z with direction rnd_mode
*/
static int
mpfr_zeta_pos (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode)
{
mpfr_t b, c, z_pre, f, s1;
double beta, sd, dnep;
mpfr_t *tc1;
mp_prec_t precz, precs, d, dint;
int p, n, l, add;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_ASSERTD (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0);
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Zeta(x) = 1+1/2^x+1/3^x+1/4^x+1/5^x+O(1/6^x)
so with 2^(EXP(x)-1) <= x < 2^EXP(x)
So for x > 2^3, k^x > k^8, so 2/k^x < 2/k^8
Zeta(x) = 1 + 1/2^x*(1+(2/3)^x+(2/4)^x+...)
= 1 + 1/2^x*(1+sum((2/k)^x,k=3..infinity))
<= 1 + 1/2^x*(1+sum((2/k)^8,k=3..infinity))
And sum((2/k)^8,k=3..infinity) = -257+128*Pi^8/4725 ~= 0.0438035
So Zeta(x) <= 1 + 1/2^x*2 for x >= 8
The error is < 2^(-x+1) <= 2^(-2^(EXP(x)-1)+1) */
if (MPFR_GET_EXP (s) > 3)
{
mp_exp_t err;
err = MPFR_GET_EXP (s) - 1;
if (err > (mp_exp_t) (sizeof (mp_exp_t)*CHAR_BIT-2))
err = MPFR_EMAX_MAX;
else
err = ((mp_exp_t)1) << err;
err = 1 - (-err+1); /* GET_EXP(one) - (-err+1) = err :) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (z, __gmpfr_one, err, 0, 1,
rnd_mode, {});
}
d = precz + MPFR_INT_CEIL_LOG2(precz) + 10;
/* we want that s1 = s-1 is exact, i.e. we should have PREC(s1) >= EXP(s) */
dint = (mpfr_uexp_t) MPFR_GET_EXP (s);
mpfr_init2 (s1, MAX (precs, dint));
inex = mpfr_sub (s1, s, __gmpfr_one, GMP_RNDN);
MPFR_ASSERTD (inex == 0);
/* case s=1 */
if (MPFR_IS_ZERO (s1))
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
MPFR_ASSERTD (inex == 0);
goto clear_and_return;
}
MPFR_GROUP_INIT_4 (group, MPFR_PREC_MIN, b, c, z_pre, f);
MPFR_ZIV_INIT (loop, d);
for (;;)
{
/* Principal loop: we compute, in z_pre,
an approximation of Zeta(s), that we send to can_round */
if (MPFR_GET_EXP (s1) <= -(mp_exp_t) ((mpfr_prec_t) (d-3)/2))
/* Branch 1: when s-1 is very small, one
uses the approximation Zeta(s)=1/(s-1)+gamma,
where gamma is Euler's constant */
{
dint = MAX (d + 3, precs);
MPFR_TRACE (printf ("branch 1\ninternal precision=%d\n", dint));
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
mpfr_div (z_pre, __gmpfr_one, s1, GMP_RNDN);
mpfr_const_euler (f, GMP_RNDN);
mpfr_add (z_pre, z_pre, f, GMP_RNDN);
}
else /* Branch 2 */
{
size_t size;
MPFR_TRACE (printf ("branch 2\n"));
/* Computation of parameters n, p and working precision */
dnep = (double) d * LOG2;
sd = mpfr_get_d (s, GMP_RNDN);
/* beta = dnep + 0.61 + sd * log (6.2832 / sd);
but a larger value is ok */
#define LOG6dot2832 1.83787940484160805532
beta = dnep + 0.61 + sd * (LOG6dot2832 - LOG2 *
__gmpfr_floor_log2 (sd));
if (beta <= 0.0)
{
p = 0;
/* n = 1 + (int) (exp ((dnep - LOG2) / sd)); */
n = 1 + (int) __gmpfr_ceil_exp2 ((d - 1.0) / sd);
}
else
{
p = 1 + (int) beta / 2;
n = 1 + (int) ((sd + 2.0 * (double) p - 1.0) / 6.2832);
}
MPFR_TRACE (printf ("\nn=%d\np=%d\n",n,p));
/* add = 4 + floor(1.5 * log(d) / log (2)).
We should have add >= 10, which is always fulfilled since
d = precz + 11 >= 12, thus ceil(log2(d)) >= 4 */
add = 4 + (3 * MPFR_INT_CEIL_LOG2 (d)) / 2;
MPFR_ASSERTD(add >= 10);
dint = d + add;
if (dint < precs)
dint = precs;
MPFR_TRACE (printf("internal precision=%d\n",dint));
size = (p + 1) * sizeof(mpfr_t);
tc1 = (mpfr_t*) (*__gmp_allocate_func) (size);
for (l=1; l<=p; l++)
mpfr_init2 (tc1[l], dint);
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
MPFR_TRACE (printf ("precision of z =%d\n", precz));
/* Computation of the coefficients c_k */
mpfr_zeta_c (p, tc1);
/* Computation of the 3 parts of the fonction Zeta. */
mpfr_zeta_part_a (z_pre, s, n);
mpfr_zeta_part_b (b, s, n, p, tc1);
/* s1 = s-1 is already computed above */
mpfr_div (c, __gmpfr_one, s1, GMP_RNDN);
mpfr_ui_pow (f, n, s1, GMP_RNDN);
mpfr_div (c, c, f, GMP_RNDN);
MPFR_TRACE (MPFR_DUMP (c));
mpfr_add (z_pre, z_pre, c, GMP_RNDN);
mpfr_add (z_pre, z_pre, b, GMP_RNDN);
for (l=1; l<=p; l++)
mpfr_clear (tc1[l]);
(*__gmp_free_func) (tc1, size);
/* End branch 2 */
}
MPFR_TRACE (MPFR_DUMP (z_pre));
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, d-3, precz, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, d);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
clear_and_return:
mpfr_clear (s1);
return inex;
}
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity),
and return e such that the absolute error is bound by 2^e ulp(y) */
static mp_exp_t
mpfr_eint_aux (mpfr_t y, mpfr_srcptr x)
{
mpfr_t eps; /* dynamic (absolute) error bound on t */
mpfr_t erru, errs;
mpz_t m, s, t, u;
mp_exp_t e, sizeinbase;
mp_prec_t w = MPFR_PREC(y);
unsigned long k;
MPFR_GROUP_DECL (group);
/* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x)
where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2
thus |R(x)/x| <= |x|/2
thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */
if (MPFR_GET_EXP(x) <= - (mp_exp_t) w)
{
mpfr_set (y, x, GMP_RNDN);
return 0;
}
mpz_init (s); /* initializes to 0 */
mpz_init (t);
mpz_init (u);
mpz_init (m);
MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs);
e = mpfr_get_z_exp (m, x); /* x = m * 2^e */
MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x));
if (MPFR_PREC (x) > w)
{
e += MPFR_PREC (x) - w;
mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w);
}
/* remove trailing zeroes from m: this will speed up much cases where
x is a small integer divided by a power of 2 */
k = mpz_scan1 (m, 0);
mpz_tdiv_q_2exp (m, m, k);
e += k;
/* initialize t to 2^w */
mpz_set_ui (t, 1);
mpz_mul_2exp (t, t, w);
mpfr_set_ui (eps, 0, GMP_RNDN); /* eps[0] = 0 */
mpfr_set_ui (errs, 0, GMP_RNDN);
for (k = 1;; k++)
{
/* let eps[k] be the absolute error on t[k]:
since t[k] = trunc(t[k-1]*m*2^e/k), we have
eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k
= 1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k
= 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */
mpfr_mul_2ui (eps, eps, w - 1, GMP_RNDU);
mpfr_add_z (eps, eps, t, GMP_RNDU);
MPFR_MPZ_SIZEINBASE2 (sizeinbase, m);
mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_add_ui (eps, eps, 1, GMP_RNDU);
mpz_mul (t, t, m);
if (e < 0)
mpz_tdiv_q_2exp (t, t, -e);
else
mpz_mul_2exp (t, t, e);
mpz_tdiv_q_ui (t, t, k);
mpz_tdiv_q_ui (u, t, k);
mpz_add (s, s, u);
/* the absolute error on u is <= 1 + eps[k]/k */
mpfr_div_ui (erru, eps, k, GMP_RNDU);
mpfr_add_ui (erru, erru, 1, GMP_RNDU);
/* and that on s is the sum of all errors on u */
mpfr_add (errs, errs, erru, GMP_RNDU);
/* we are done when t is smaller than errs */
if (mpz_sgn (t) == 0)
sizeinbase = 0;
else
MPFR_MPZ_SIZEINBASE2 (sizeinbase, t);
if (sizeinbase < MPFR_GET_EXP (errs))
break;
}
/* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...)
<= (|t|+eps)/k*|x|/(k-|x|) */
mpz_abs (t, t);
mpfr_add_z (eps, eps, t, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_abs (erru, x, GMP_RNDU); /* |x| */
mpfr_mul (eps, eps, erru, GMP_RNDU);
mpfr_ui_sub (erru, k, erru, GMP_RNDD);
if (MPFR_IS_NEG (erru))
{
/* the truncated series does not converge, return fail */
e = w;
}
else
{
mpfr_div (eps, eps, erru, GMP_RNDU);
mpfr_add (errs, errs, eps, GMP_RNDU);
mpfr_set_z (y, s, GMP_RNDN);
mpfr_div_2ui (y, y, w, GMP_RNDN);
/* errs was an absolute error bound on s. We must convert it to an error
in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must
divide the error by 2^(EXP(y)-PREC(y)), but since we divided also
y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */
e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y);
}
MPFR_GROUP_CLEAR (group);
mpz_clear (s);
mpz_clear (t);
mpz_clear (u);
mpz_clear (m);
return e;
}
/* Don't need to save/restore exponent range: the cache does it.
Catalan's constant is G = sum((-1)^k/(2*k+1)^2, k=0..infinity).
We compute it using formula (31) of Victor Adamchik's page
"33 representations for Catalan's constant"
http://www-2.cs.cmu.edu/~adamchik/articles/catalan/catalan.htm
G = Pi/8*log(2+sqrt(3)) + 3/8*sum(k!^2/(2k)!/(2k+1)^2,k=0..infinity)
*/
int
mpfr_const_catalan_internal (mpfr_ptr g, mpfr_rnd_t rnd_mode)
{
mpfr_t x, y, z;
mpz_t T, P, Q;
mpfr_prec_t pg, p;
int inex;
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
MPFR_LOG_FUNC (("rnd_mode=%d", rnd_mode), ("g[%#R]=%R inex=%d", g, g, inex));
/* Here are the WC (max prec = 100.000.000)
Once we have found a chain of 11, we only look for bigger chain.
Found 3 '1' at 0
Found 5 '1' at 9
Found 6 '0' at 34
Found 9 '1' at 176
Found 11 '1' at 705
Found 12 '0' at 913
Found 14 '1' at 12762
Found 15 '1' at 152561
Found 16 '0' at 171725
Found 18 '0' at 525355
Found 20 '0' at 529245
Found 21 '1' at 6390133
Found 22 '0' at 7806417
Found 25 '1' at 11936239
Found 27 '1' at 51752950
*/
pg = MPFR_PREC (g);
p = pg + MPFR_INT_CEIL_LOG2 (pg) + 7;
MPFR_GROUP_INIT_3 (group, p, x, y, z);
mpz_init (T);
mpz_init (P);
mpz_init (Q);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_sqrt_ui (x, 3, MPFR_RNDU);
mpfr_add_ui (x, x, 2, MPFR_RNDU);
mpfr_log (x, x, MPFR_RNDU);
mpfr_const_pi (y, MPFR_RNDU);
mpfr_mul (x, x, y, MPFR_RNDN);
S (T, P, Q, 0, (p - 1) / 2);
mpz_mul_ui (T, T, 3);
mpfr_set_z (y, T, MPFR_RNDU);
mpfr_set_z (z, Q, MPFR_RNDD);
mpfr_div (y, y, z, MPFR_RNDN);
mpfr_add (x, x, y, MPFR_RNDN);
mpfr_div_2ui (x, x, 3, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (x, p - 5, pg, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, p);
MPFR_GROUP_REPREC_3 (group, p, x, y, z);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (g, x, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (T);
mpz_clear (P);
mpz_clear (Q);
return inex;
}
/* Don't need to save / restore exponent range: the cache does it */
int
mpfr_const_log2_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
unsigned long n = MPFR_PREC (x);
mpfr_prec_t w; /* working precision */
unsigned long N;
mpz_t *T, *P, *Q;
mpfr_t t, q;
int inexact;
int ok = 1; /* ensures that the 1st try will give correct rounding */
unsigned long lgN, i;
MPFR_GROUP_DECL(group);
MPFR_TMP_DECL(marker);
MPFR_ZIV_DECL(loop);
MPFR_LOG_FUNC (
("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inex=%d", mpfr_get_prec(x), mpfr_log_prec, x, inexact));
if (n < 1253)
w = n + 10; /* ensures correct rounding for the four rounding modes,
together with N = w / 3 + 1 (see below). */
else if (n < 2571)
w = n + 11; /* idem */
else if (n < 3983)
w = n + 12;
else if (n < 4854)
w = n + 13;
else if (n < 26248)
w = n + 14;
else
{
w = n + 15;
ok = 0;
}
MPFR_TMP_MARK(marker);
MPFR_GROUP_INIT_2(group, w, t, q);
MPFR_ZIV_INIT (loop, w);
for (;;)
{
N = w / 3 + 1; /* Warning: do not change that (even increasing N!)
without checking correct rounding in the above
ranges for n. */
/* the following are needed for error analysis (see algorithms.tex) */
MPFR_ASSERTD(w >= 3 && N >= 2);
lgN = MPFR_INT_CEIL_LOG2 (N) + 1;
T = (mpz_t *) MPFR_TMP_ALLOC (3 * lgN * sizeof (mpz_t));
P = T + lgN;
Q = T + 2*lgN;
for (i = 0; i < lgN; i++)
{
mpz_init (T[i]);
mpz_init (P[i]);
mpz_init (Q[i]);
}
S (T, P, Q, 0, N, 0);
mpfr_set_z (t, T[0], MPFR_RNDN);
mpfr_set_z (q, Q[0], MPFR_RNDN);
mpfr_div (t, t, q, MPFR_RNDN);
for (i = 0; i < lgN; i++)
{
mpz_clear (T[i]);
mpz_clear (P[i]);
mpz_clear (Q[i]);
}
if (MPFR_LIKELY (ok != 0
|| mpfr_can_round (t, w - 2, MPFR_RNDN, rnd_mode, n)))
break;
MPFR_ZIV_NEXT (loop, w);
MPFR_GROUP_REPREC_2(group, w, t, q);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, t, rnd_mode);
MPFR_GROUP_CLEAR(group);
MPFR_TMP_FREE(marker);
return inexact;
}
/* computes tan(x) = sign(x)*sqrt(1/cos(x)^2-1) */
int
mpfr_tan (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mp_prec_t precy, m;
int inexact;
mpfr_t s, c;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(x)))
{
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y, x);
MPFR_RET(0);
}
}
/* tan(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 1, 1,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
precy = MPFR_PREC (y);
m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13;
MPFR_ASSERTD (m >= 2); /* needed for the error analysis in algorithms.tex */
MPFR_GROUP_INIT_2 (group, m, s, c);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* The only way to get an overflow is to get ~ Pi/2
But the result will be ~ 2^Prec(y). */
mpfr_sin_cos (s, c, x, GMP_RNDN); /* err <= 1/2 ulp on s and c */
mpfr_div (c, s, c, GMP_RNDN); /* err <= 4 ulps */
MPFR_ASSERTD (!MPFR_IS_SINGULAR (c));
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, m - 2, precy, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, s, c);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, c, rnd_mode);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
/* We use the reflection formula
Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t))
in order to treat the case x <= 1,
i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x)
*/
int
mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, GammaTrial, tmp, tmp2;
mpz_t fact;
mpfr_prec_t realprec;
int compared, is_integer;
int inex = 0; /* 0 means: result gamma not set yet */
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("gamma[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex));
/* Trivial cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
if (MPFR_IS_NEG (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF (gamma);
MPFR_SET_POS (gamma);
MPFR_RET (0); /* exact */
}
}
else /* x is zero */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
MPFR_SET_INF(gamma);
MPFR_SET_SAME_SIGN(gamma, x);
MPFR_SET_DIVBY0 ();
MPFR_RET (0); /* exact */
}
}
/* Check for tiny arguments, where gamma(x) ~ 1/x - euler + ....
We know from "Bound on Runs of Zeros and Ones for Algebraic Functions",
Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal
number of consecutive zeroes or ones after the round bit is n-1 for an
input of n bits. But we need a more precise lower bound. Assume x has
n bits, and 1/x is near a floating-point number y of n+1 bits. We can
write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits.
Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e).
Two cases can happen:
(i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y
are themselves powers of two, i.e., x is a power of two;
(ii) or X*Y is at distance at least one from 2^(f-e), thus
|xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n).
Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means
that the distance |y-1/x| >= 2^(-2n) ufp(y).
Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1,
if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y),
and round(1/x) with precision >= 2n+2 gives the correct result.
If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1).
A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)).
*/
if (MPFR_GET_EXP (x) + 2
<= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma)))
{
int sign = MPFR_SIGN (x); /* retrieve sign before possible override */
int special;
MPFR_BLOCK_DECL (flags);
MPFR_SAVE_EXPO_MARK (expo);
/* for overflow cases, see below; this needs to be done
before x possibly gets overridden. */
special =
MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX &&
MPFR_IS_POS_SIGN (sign) &&
MPFR_IS_LIKE_RNDD (rnd_mode, sign) &&
mpfr_powerof2_raw (x);
MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode));
if (inex == 0) /* x is a power of two */
{
/* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */
if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign))
inex = 1;
else
{
mpfr_nextbelow (gamma);
inex = -1;
}
}
else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* Overflow in the division 1/x. This is a real overflow, except
in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to
the "- euler", the rounded value in unbounded exponent range
is 0.111...11 * 2^emax (not an overflow). */
if (!special)
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags);
}
MPFR_SAVE_EXPO_FREE (expo);
/* Note: an overflow is possible with an infinite result;
in this case, the overflow flag will automatically be
restored by mpfr_check_range. */
return mpfr_check_range (gamma, inex, rnd_mode);
}
is_integer = mpfr_integer_p (x);
/* gamma(x) for x a negative integer gives NaN */
if (is_integer && MPFR_IS_NEG(x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
compared = mpfr_cmp_ui (x, 1);
if (compared == 0)
return mpfr_set_ui (gamma, 1, rnd_mode);
/* if x is an integer that fits into an unsigned long, use mpfr_fac_ui
if argument is not too large.
If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)),
so for u <= M(p), fac_ui should be faster.
We approximate here M(p) by p*log(p)^2, which is not a bad guess.
Warning: since the generic code does not handle exact cases,
we want all cases where gamma(x) is exact to be treated here.
*/
if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long int u;
mpfr_prec_t p = MPFR_PREC(gamma);
u = mpfr_get_ui (x, MPFR_RNDN);
if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN))
/* bits_fac: lower bound on the number of bits of m,
where gamma(x) = (u-1)! = m*2^e with m odd. */
return mpfr_fac_ui (gamma, u - 1, rnd_mode);
/* if bits_fac(...) > p (resp. p+1 for rounding to nearest),
then gamma(x) cannot be exact in precision p (resp. p+1).
FIXME: remove the test u < 44787929UL after changing bits_fac
to return a mpz_t or mpfr_t. */
}
MPFR_SAVE_EXPO_MARK (expo);
/* check for overflow: according to (6.1.37) in Abramowitz & Stegun,
gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi)
>= 2 * (x/e)^x / x for x >= 1 */
if (compared > 0)
{
mpfr_t yp;
mpfr_exp_t expxp;
MPFR_BLOCK_DECL (flags);
/* quick test for the default exponent range */
if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* 1/e rounded down to 53 bits */
#define EXPM1_STR "0.010111100010110101011000110110001011001110111100111"
mpfr_init2 (xp, 53);
mpfr_init2 (yp, 53);
mpfr_set_str_binary (xp, EXPM1_STR);
mpfr_mul (xp, x, xp, MPFR_RNDZ);
mpfr_sub_ui (yp, x, 2, MPFR_RNDZ);
mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */
mpfr_set_str_binary (yp, EXPM1_STR);
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */
mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */
MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ));
expxp = MPFR_GET_EXP (xp);
mpfr_clear (xp);
mpfr_clear (yp);
MPFR_SAVE_EXPO_FREE (expo);
return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ?
mpfr_overflow (gamma, rnd_mode, 1) :
mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* now compared < 0 */
/* check for underflow: for x < 1,
gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x).
Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have
|gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))|
<= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|.
To avoid an underflow in ((2-x)/e)^x, we compute the logarithm.
*/
if (MPFR_IS_NEG(x))
{
int underflow = 0, sgn, ck;
mpfr_prec_t w;
mpfr_init2 (xp, 53);
mpfr_init2 (tmp, 53);
mpfr_init2 (tmp2, 53);
/* we want an upper bound for x * [log(2-x)-1].
since x < 0, we need a lower bound on log(2-x) */
mpfr_ui_sub (xp, 2, x, MPFR_RNDD);
mpfr_log (xp, xp, MPFR_RNDD);
mpfr_sub_ui (xp, xp, 1, MPFR_RNDD);
mpfr_mul (xp, xp, x, MPFR_RNDU);
/* we need an upper bound on 1/|sin(Pi*(2-x))|,
thus a lower bound on |sin(Pi*(2-x))|.
If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p)
thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u,
assuming u <= 1, thus <= u + 3Pi(2-x)u */
w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */
w += 17; /* to get tmp2 small enough */
mpfr_set_prec (tmp, w);
mpfr_set_prec (tmp2, w);
MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN));
MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */
mpfr_const_pi (tmp2, MPFR_RNDN);
mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */
mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */
sgn = mpfr_sgn (tmp);
mpfr_abs (tmp, tmp, MPFR_RNDN);
mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */
mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */
mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU);
/* if tmp2<|tmp|, we get a lower bound */
if (mpfr_cmp (tmp2, tmp) < 0)
{
mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */
mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */
mpfr_log2 (tmp, tmp, MPFR_RNDU);
mpfr_add (xp, tmp, xp, MPFR_RNDU);
/* The assert below checks that expo.saved_emin - 2 always
fits in a long. FIXME if we want to allow mpfr_exp_t to
be a long long, for instance. */
MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN);
underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0;
}
mpfr_clear (xp);
mpfr_clear (tmp);
mpfr_clear (tmp2);
if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn);
}
}
realprec = MPFR_PREC (gamma);
/* we want both 1-x and 2-x to be exact */
{
mpfr_prec_t w;
w = mpfr_gamma_1_minus_x_exact (x);
if (realprec < w)
realprec = w;
w = mpfr_gamma_2_minus_x_exact (x);
if (realprec < w)
realprec = w;
}
realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20;
MPFR_ASSERTD(realprec >= 5);
MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20,
xp, tmp, tmp2, GammaTrial);
mpz_init (fact);
MPFR_ZIV_INIT (loop, realprec);
for (;;)
{
mpfr_exp_t err_g;
int ck;
MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial);
/* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */
ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */
mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */
mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */
err_g = MPFR_GET_EXP(GammaTrial);
mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */
/* If tmp is +Inf, we compute exp(lngamma(x)). */
if (mpfr_inf_p (tmp))
{
inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode);
if (inex)
goto end;
else
goto ziv_next;
}
err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial);
/* let g0 the true value of Pi*(2-x), g the computed value.
We have g = g0 + h with |h| <= |(1+u^2)-1|*g.
Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g.
The relative error is thus bounded by |(1+u^2)-1|*g/sin(g)
<= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4.
With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */
ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */
mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN);
/* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u
+ (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2.
For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <=
0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus
(0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4
<= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */
mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN);
/* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u].
For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2
<= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4.
(1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u)
= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3
+ (18+9*2^err_g)*u^4
<= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3
<= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2
<= 1 + (23 + 10*2^err_g)*u.
The final error is thus bounded by (23 + 10*2^err_g) ulps,
which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */
err_g = (err_g <= 2) ? 6 : err_g + 4;
if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g,
MPFR_PREC(gamma), rnd_mode)))
break;
ziv_next:
MPFR_ZIV_NEXT (loop, realprec);
}
end:
MPFR_ZIV_FREE (loop);
if (inex == 0)
inex = mpfr_set (gamma, GammaTrial, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (fact);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (gamma, inex, rnd_mode);
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
long add;
mpfr_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (
("s[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, MPFR_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
return mpfr_set_si_2exp (z, -1, -1, rnd_mode);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 2^(-4), we have |zeta(s) + 1/2| <= |s|.
EXP(s) + 1 < -PREC(z) is a sufficient condition to be able to round
correctly, for any PREC(z) >= 1 (see algorithms.tex for details). */
if (MPFR_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if (rnd_mode == MPFR_RNDA)
rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */
if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == MPFR_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == MPFR_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_GET_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* Check for case s=1 before changing the exponent range */
if (mpfr_cmp (s, __gmpfr_one) == 0)
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
MPFR_SET_DIVBY0 ();
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
int overflow = 0;
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
add = compute_add (s, precz);
prec1 = precz + add;
/* FIXME: To avoid that the working precision (prec1) depends on the
input precision, one would need to take into account the error made
when s1 is not exactly 1-s when computing zeta(s1) and gamma(s1)
below, and also in the case y=Inf (i.e. when gamma(s1) overflows).
Make sure that underflows do not occur in intermediate computations.
Due to the limited precision, they are probably not possible
in practice; add some MPFR_ASSERTN's to be sure that problems
do not remain undetected? */
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_exp_t ey;
mpfr_t z_up;
mpfr_const_pi (p, MPFR_RNDD); /* p is Pi */
mpfr_sub (s1, __gmpfr_one, s, MPFR_RNDN); /* s1 = 1-s */
mpfr_gamma (y, s1, MPFR_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* zeta(s) < 0 for -4k-2 < s < -4k,
zeta(s) > 0 for -4k < s < -4k+2 */
{
/* FIXME: An overflow in gamma(s1) does not imply that
zeta(s) will overflow. A solution:
1. Compute
log(|zeta(s)|/2) = (s-1)*log(2*pi) + lngamma(1-s)
+ log(abs(sin(Pi*s/2)) * zeta(1-s))
(possibly sharing computations with the normal case)
with a rather good accuracy (see (2)).
Memorize the sign of sin(...) for the final sign.
2. Take the exponential, ~= |zeta(s)|/2. If there is an
overflow, then this means an overflow on the final result
(due to the multiplication by 2, which has not been done
yet).
3. Ziv test.
4. Correct the sign from the sign of sin(...).
5. Round then multiply by 2. Here, an overflow in either
operation means a real overflow. */
mpfr_reflection_overflow (z_pre, s1, s, y, p, MPFR_RNDD);
/* z_pre is a lower bound of |zeta(s)|/2, thus if it overflows,
or has exponent emax, then |zeta(s)| overflows too. */
if (MPFR_IS_INF (z_pre) || MPFR_GET_EXP(z_pre) == __gmpfr_emax)
{ /* determine the sign of overflow */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1;
break;
}
else /* EXP(z_pre) < __gmpfr_emax */
{
int ok = 0;
mpfr_t z_down;
mpfr_init2 (z_up, mpfr_get_prec (z_pre));
mpfr_reflection_overflow (z_up, s1, s, y, p, MPFR_RNDU);
/* if the lower approximation z_pre does not overflow, but
z_up does, we need more precision */
if (MPFR_IS_INF (z_up) || MPFR_GET_EXP(z_up) == __gmpfr_emax)
goto next_loop;
/* check if z_pre and z_up round to the same number */
mpfr_init2 (z_down, precz);
mpfr_set (z_down, z_pre, rnd_mode);
/* Note: it might be that EXP(z_down) = emax here, in that
case we will have overflow below when we multiply by 2 */
mpfr_prec_round (z_up, precz, rnd_mode);
ok = mpfr_cmp (z_down, z_up) == 0;
mpfr_clear (z_up);
mpfr_clear (z_down);
if (ok)
{
/* get correct sign and multiply by 2 */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
mpfr_neg (z_pre, z_pre, rnd_mode);
mpfr_mul_2ui (z_pre, z_pre, 1, rnd_mode);
break;
}
else
goto next_loop;
}
}
mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */
/* multiply z_pre by 2^s*Pi^(s-1) where p=Pi, s1=1-s */
mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */
mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_RNDN);
/* multiply z_pre by sin(Pi*s/2) */
mpfr_mul (y, s, p, MPFR_RNDN);
mpfr_div_2ui (p, y, 1, MPFR_RNDN); /* p = s*Pi/2 */
/* FIXME: sinpi will be available, we should replace the mpfr_sin
call below by mpfr_sinpi(s/2), where s/2 will be exact.
Can mpfr_sin underflow? Moreover, the code below should be
improved so that the "if" condition becomes unlikely, e.g.
by taking a slightly larger working precision. */
mpfr_sin (y, p, MPFR_RNDN); /* y = sin(Pi*s/2) */
ey = MPFR_GET_EXP (y);
if (ey < 0) /* take account of cancellation in sin(p) */
{
mpfr_t t;
MPFR_ASSERTN (- ey < MPFR_PREC_MAX - prec1);
mpfr_init2 (t, prec1 - ey);
mpfr_const_pi (t, MPFR_RNDD);
mpfr_mul (t, s, t, MPFR_RNDN);
mpfr_div_2ui (t, t, 1, MPFR_RNDN);
mpfr_sin (y, t, MPFR_RNDN);
mpfr_clear (t);
}
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
next_loop:
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
if (overflow != 0)
{
inex = mpfr_overflow (z, rnd_mode, overflow);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
}
else
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
