int mpfr_si_div (mpfr_ptr y, long int u, mpfr_srcptr x,mp_rnd_t rnd_mode)
{
int res;
if (u >= 0)
res = mpfr_ui_div (y, u, x, rnd_mode);
else
{
res = -mpfr_ui_div (y, -u, x, MPFR_INVERT_RND(rnd_mode));
MPFR_CHANGE_SIGN (y);
}
return res;
}
static void
check_nan (void)
{
mpfr_t d, q;
mpfr_init2 (d, 100L);
mpfr_init2 (q, 100L);
/* 1/+inf == 0 */
MPFR_CLEAR_FLAGS (d);
MPFR_SET_INF (d);
MPFR_SET_POS (d);
MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_number_p (q));
MPFR_ASSERTN (mpfr_sgn (q) == 0);
/* 1/-inf == -0 */
MPFR_CLEAR_FLAGS (d);
MPFR_SET_INF (d);
MPFR_SET_NEG (d);
MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_number_p (q));
MPFR_ASSERTN (mpfr_sgn (q) == 0);
/* 1/nan == nan */
MPFR_SET_NAN (d);
MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_nan_p (q));
/* 0/0 == nan */
mpfr_set_ui (d, 0L, GMP_RNDN);
MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_nan_p (q));
/* 1/+0 = +inf */
mpfr_set_ui (d, 0L, GMP_RNDN);
MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0);
/* 1/-0 = -inf */
mpfr_set_ui (d, 0L, GMP_RNDN);
mpfr_neg (d, d, GMP_RNDN);
MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0);
/* 0/1 = +0 */
mpfr_set_ui (d, 1L, GMP_RNDN);
MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_cmp_ui (q, 0) == 0 && MPFR_IS_POS (q));
/* 0/-1 = -0 */
mpfr_set_si (d, -1, GMP_RNDN);
MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */
MPFR_ASSERTN (mpfr_cmp_ui (q, 0) == 0 && MPFR_IS_NEG (q));
mpfr_clear (d);
mpfr_clear (q);
}
static PyObject *
GMPy_Context_Degrees(PyObject *self, PyObject *other)
{
MPFR_Object *result, *tempx, *temp;
CTXT_Object *context = NULL;
if (self && CTXT_Check(self)) {
context = (CTXT_Object*)self;
}
else {
CHECK_CONTEXT(context);
}
result = GMPy_MPFR_New(0, context);
temp = GMPy_MPFR_New(context->ctx.mpfr_prec + 100, context);
tempx = GMPy_MPFR_From_Real(other, 1, context);
if (!result || !temp || !tempx) {
Py_XDECREF((PyObject*)temp);
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)result);
return NULL;
}
mpfr_const_pi(temp->f, MPFR_RNDN);
mpfr_ui_div(temp->f, 180, temp->f, MPFR_RNDN);
mpfr_clear_flags();
mpfr_mul(result->f, temp->f, tempx->f, MPFR_RNDN);
Py_DECREF((PyObject*)temp);
Py_DECREF((PyObject*)tempx);
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
static void _fmpq_poly_oz_sqrt_approx_scale(fmpq_poly_t y, fmpq_poly_t z, const long n, const mpfr_prec_t prec) {
/* We scale by about |det(y) · det(z)|^(-1/(2n)) to make it converge faster */
mpfr_t gamma;
mpfr_init2(gamma, prec);
mpfr_t tmp;
mpfr_init2(tmp, prec);
fmpq_t gamma_q;
fmpq_init(gamma_q);
/* det(y) */
fmpq_poly_oz_ideal_norm(gamma_q, y, n, 1);
fmpq_get_mpfr(gamma, gamma_q, MPFR_RNDN);
/* det(y) · det(z) */
fmpq_poly_oz_ideal_norm(gamma_q, z, n, 1);
fmpq_get_mpfr(tmp, gamma_q, MPFR_RNDN);
mpfr_mul(gamma, gamma, tmp, MPFR_RNDN);
/* (det(y) · det(z))^(-1/(2n)) */
mpfr_root(gamma, gamma, 2*n, MPFR_RNDN);
mpfr_ui_div(gamma, 1, gamma, MPFR_RNDN);
mpfr_abs(gamma, gamma, MPFR_RNDN);
fmpq_set_mpfr(gamma_q, gamma, MPFR_RNDN);
fmpq_poly_scalar_mul_fmpq(y, y, gamma_q);
fmpq_poly_scalar_mul_fmpq(z, z, gamma_q);
fmpq_clear(gamma_q);
mpfr_clear(gamma);
mpfr_clear(tmp);
}
void mpfr_squaring_int_exp(mpfr_t R, mpfr_t x, mpz_t a)
{
if(mpz_cmp_ui(a, 0) < 0)
{
mpz_t b;
mpz_init_set(b, a);
mpz_neg(b, b);
mpfr_squaring_int_exp(R, x, b);
mpfr_ui_div(R, 1, R, MPFR_RNDN);
}
else
{
mpfr_t y;
mpz_t n;
mpfr_init_set(y, x, MPFR_RNDN);
mpfr_set_ui(R, 1, MPFR_RNDN);
mpz_init_set(n, a);
while(mpz_cmp_ui(n, 0) > 0)
{
if(mpz_odd_p(n))
{
mpfr_mul(R, R, y, MPFR_RNDN);
mpz_sub_ui(n, n, 1);
}
mpfr_mul(y, y, y, MPFR_RNDN);
mpz_div_ui(n, n, 2);
}
}
}
mpfr_t* simple_pole_case_c(long pole_order_max, mpfr_t base, mpfr_t pole_position, mpfr_t incomplete_gamma_factor, mpfr_prec_t prec){
mpfr_t* result=malloc(sizeof(mpfr_t)*(pole_order_max+1));
mpfr_t temp1;
mpfr_init2(temp1,prec);
mpfr_t temp2;
mpfr_init2(temp2,prec);
mpfr_t temp3;
mpfr_init2(temp3,prec);
mpfr_t minus_pole_position;
mpfr_init2(minus_pole_position,prec);
mpfr_neg(minus_pole_position,pole_position,MPFR_RNDN);
mpfr_t factorial;
mpfr_init2(factorial,prec);
mpfr_set_ui(factorial,1,MPFR_RNDN);
mpfr_t minus_log_base;
mpfr_init2(minus_log_base,prec);
mpfr_log(minus_log_base,base,prec);
mpfr_neg(minus_log_base,minus_log_base,MPFR_RNDN);
mpfr_ui_div(minus_log_base,1,minus_log_base,MPFR_RNDN);
mpfr_t log_base_power;
mpfr_init2(log_base_power,prec);
mpfr_set(log_base_power,minus_log_base,MPFR_RNDN);
mpfr_set_ui(temp1,0,MPFR_RNDN);
mpfr_mul(temp2,pole_position,incomplete_gamma_factor,MPFR_RNDN);
mpfr_init2(result[0],prec);
mpfr_set(result[0],incomplete_gamma_factor,MPFR_RNDN);
for(long j=1;j<=pole_order_max;j++){
mpfr_init2(result[j],prec);
mpfr_mul(temp1,temp1,pole_position,MPFR_RNDN);
mpfr_mul(temp3,factorial,log_base_power,MPFR_RNDN);
mpfr_add(temp1,temp3,temp1,MPFR_RNDN);
mpfr_add(result[j],temp1,temp2,MPFR_RNDN);
if(j<pole_order_max){
mpfr_mul(temp2,temp2,pole_position,MPFR_RNDN);
mpfr_mul(log_base_power,log_base_power,minus_log_base,MPFR_RNDN);
mpfr_mul_si(factorial,factorial,j,MPFR_RNDN);
}
}
mpfr_clear(temp1);
mpfr_clear(temp2);
mpfr_clear(temp3);
mpfr_clear(minus_pole_position);
mpfr_clear(factorial);
mpfr_clear(minus_log_base);
mpfr_clear(log_base_power);
return result;
}
static void
check_inexact (void)
{
mpfr_t x, y, z;
mpfr_prec_t px, py;
int inexact, cmp;
unsigned long int u;
int rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
for (px=2; px<300; px++)
{
mpfr_set_prec (x, px);
do
{
mpfr_urandomb (x, RANDS);
}
while (mpfr_cmp_ui (x, 0) == 0);
u = randlimb ();
for (py=2; py<300; py++)
{
mpfr_set_prec (y, py);
mpfr_set_prec (z, py + px);
for (rnd = 0; rnd < MPFR_RND_MAX; rnd++)
{
inexact = mpfr_ui_div (y, u, x, (mpfr_rnd_t) rnd);
if (mpfr_mul (z, y, x, (mpfr_rnd_t) rnd))
{
printf ("z <- y * x should be exact\n");
exit (1);
}
cmp = mpfr_cmp_ui (z, u);
if (((inexact == 0) && (cmp != 0)) ||
((inexact > 0) && (cmp <= 0)) ||
((inexact < 0) && (cmp >= 0)))
{
printf ("Wrong inexact flag for u=%lu, rnd=%s\n",
u, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("y*x="); mpfr_print_binary (z); puts ("");
exit (1);
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
/* checks that y/x gives the right result with 53 bits of precision */
static void
check (unsigned long y, const char *xs, mpfr_rnd_t rnd_mode, const char *zs)
{
mpfr_t xx, zz;
mpfr_inits2 (53, xx, zz, (mpfr_ptr) 0);
mpfr_set_str1 (xx, xs);
mpfr_ui_div (zz, y, xx, rnd_mode);
if (mpfr_cmp_str1(zz, zs))
{
printf ("expected quotient is %s, got ", zs);
mpfr_out_str (stdout, 10, 0, zz, MPFR_RNDN);
printf ("mpfr_ui_div failed for y=%lu x=%s with rnd_mode=%s\n",
y, xs, mpfr_print_rnd_mode (rnd_mode));
exit (1);
}
mpfr_clears (xx, zz, (mpfr_ptr) 0);
}
/* Return in y an approximation of Ei(x) using the asymptotic expansion:
Ei(x) = exp(x)/x * (1 + 1/x + 2/x^2 + ... + k!/x^k + ...)
Assumes x >= PREC(y) * log(2).
Returns the error bound in terms of ulp(y).
*/
static mp_exp_t
mpfr_eint_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mp_prec_t p = MPFR_PREC(y);
mpfr_t invx, t, err;
unsigned long k;
mp_exp_t err_exp;
mpfr_init2 (t, p);
mpfr_init2 (invx, p);
mpfr_init2 (err, 31); /* error in ulps on y */
mpfr_ui_div (invx, 1, x, GMP_RNDN); /* invx = 1/x*(1+u) with |u|<=2^(1-p) */
mpfr_set_ui (t, 1, GMP_RNDN); /* exact */
mpfr_set (y, t, GMP_RNDN);
mpfr_set_ui (err, 0, GMP_RNDN);
for (k = 1; MPFR_GET_EXP(t) + (mp_exp_t) p > MPFR_GET_EXP(y); k++)
{
mpfr_mul (t, t, invx, GMP_RNDN); /* 2 more roundings */
mpfr_mul_ui (t, t, k, GMP_RNDN); /* 1 more rounding: t = k!/x^k*(1+u)^e
with u=2^{-p} and |e| <= 3*k */
/* we use the fact that |(1+u)^n-1| <= 2*|n*u| for |n*u| <= 1, thus
the error on t is less than 6*k*2^{-p}*t <= 6*k*ulp(t) */
/* err is in terms of ulp(y): transform it in terms of ulp(t) */
mpfr_mul_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add_ui (err, err, 6 * k, GMP_RNDU);
/* transform back in terms of ulp(y) */
mpfr_div_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add (y, y, t, GMP_RNDN);
}
/* add the truncation error bounded by ulp(y): 1 ulp */
mpfr_mul (y, y, invx, GMP_RNDN); /* err <= 2*err + 3/2 */
mpfr_exp (t, x, GMP_RNDN); /* err(t) <= 1/2*ulp(t) */
mpfr_mul (y, y, t, GMP_RNDN); /* again: err <= 2*err + 3/2 */
mpfr_mul_2ui (err, err, 2, GMP_RNDU);
mpfr_add_ui (err, err, 8, GMP_RNDU);
err_exp = MPFR_GET_EXP(err);
mpfr_clear (t);
mpfr_clear (invx);
mpfr_clear (err);
return err_exp;
}
void mpfr_naive_int_exp(mpfr_t R, mpfr_t x, mpz_t a)
{
if(mpz_cmp_ui(a, 0) < 0)
{
mpz_t b;
mpz_init_set(b, a);
mpz_neg(b, b);
mpfr_naive_int_exp(R, x, b);
mpfr_ui_div(R, 1, R, MPFR_RNDN);
}
else
{
mpz_t n;
mpz_init_set(n, a);
mpfr_set_ui(R, 1, MPFR_RNDN);
while(mpz_cmp_ui(n, 0) > 0)
{
mpfr_mul(R, R, x, MPFR_RNDN);
mpz_sub_ui(n, n, 1);
}
}
}
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd)
{
if (n >= 0)
return mpfr_pow_ui (y, x, n, rnd);
else
{
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
MPFR_SET_ZERO (y);
if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET (0);
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_INF(y);
if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET(0);
}
}
MPFR_CLEAR_FLAGS (y);
/* detect exact powers: x^(-n) is exact iff x is a power of 2 */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0)
{
mp_exp_t expx = MPFR_EXP (x) - 1, expy;
MPFR_ASSERTD (n < 0);
/* Warning: n * expx may overflow!
* Some systems (apparently alpha-freebsd) abort with
* LONG_MIN / 1, and LONG_MIN / -1 is undefined.
* Proof of the overflow checking. The expressions below are
* assumed to be on the rational numbers, but the word "overflow"
* still has its own meaning in the C context. / still denotes
* the integer (truncated) division, and // denotes the exact
* division.
* - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n
* cannot overflow due to the constraints on the exponents of
* MPFR numbers.
* - If n = -1, then n * expx = - expx, which is representable
* because of the constraints on the exponents of MPFR numbers.
* - If expx = 0, then n * expx = 0, which is representable.
* - If n < -1 and expx > 0:
* + If expx > (__gmpfr_emin - 1) / n, then
* expx >= (__gmpfr_emin - 1) / n + 1
* > (__gmpfr_emin - 1) // n,
* and
* n * expx < __gmpfr_emin - 1,
* i.e.
* n * expx <= __gmpfr_emin - 2.
* This corresponds to an underflow, with a null result in
* the rounding-to-nearest mode.
* + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot
* overflow since 0 < expx <= (__gmpfr_emin - 1) / n and
* 0 > n * expx >= n * ((__gmpfr_emin - 1) / n)
* >= __gmpfr_emin - 1.
* - If n < -1 and expx < 0:
* + If expx < (__gmpfr_emax - 1) / n, then
* expx <= (__gmpfr_emax - 1) / n - 1
* < (__gmpfr_emax - 1) // n,
* and
* n * expx > __gmpfr_emax - 1,
* i.e.
* n * expx >= __gmpfr_emax.
* This corresponds to an overflow (2^(n * expx) has an
* exponent > __gmpfr_emax).
* + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot
* overflow since 0 > expx >= (__gmpfr_emax - 1) / n and
* 0 < n * expx <= n * ((__gmpfr_emax - 1) / n)
* <= __gmpfr_emax - 1.
* Note: one could use expx bounds based on MPFR_EXP_MIN and
* MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The
* current bounds do not lead to noticeably slower code and
* allow us to avoid a bug in Sun's compiler for Solaris/x86
* (when optimizations are enabled).
*/
expy =
n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ?
MPFR_EMIN_MIN - 2 /* Underflow */ :
n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ?
MPFR_EMAX_MAX /* Overflow */ : n * expx;
return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1,
expy, rnd);
}
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mp_prec_t Ny = MPFR_PREC (y); /* target precision */
mp_prec_t Nt; /* working precision */
mp_exp_t err; /* error */
int inexact;
unsigned long abs_n;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
abs_n = - (unsigned long) n;
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 3 + MPFR_INT_CEIL_LOG2 (Ny);
MPFR_SAVE_EXPO_MARK (expo);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute 1/(x^n), with n > 0 */
mpfr_pow_ui (t, x, abs_n, GMP_RNDN);
mpfr_ui_div (t, 1, t, GMP_RNDN);
/* FIXME: old code improved, but I think this is still incorrect. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (t)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd == GMP_RNDN ? GMP_RNDZ : rnd,
abs_n & 1 ? MPFR_SIGN (x) :
MPFR_SIGN_POS);
}
if (MPFR_UNLIKELY (MPFR_IS_INF (t)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) :
MPFR_SIGN_POS);
}
/* error estimate -- see pow function in algorithms.ps */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd)))
break;
/* actualisation of the precision */
Nt += BITS_PER_MP_LIMB;
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd);
}
}
}
int
main (void)
{
mpfr_t x;
mpfr_exp_t emin;
tests_start_mpfr ();
emin = mpfr_get_emin ();
mpfr_init2 (x, IEEE_DBL_MANT_DIG);
mpfr_set_d (x, 2.34763465, MPFR_RNDN);
if (mpfr_cmp_d (x, 2.34763465) != 0)
{
printf ("Error in mpfr_cmp_d 2.34763465 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
if (mpfr_cmp_d (x, 2.345) <= 0)
{
printf ("Error in mpfr_cmp_d 2.345 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
if (mpfr_cmp_d (x, 2.4) >= 0)
{
printf ("Error in mpfr_cmp_d 2.4 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDZ);
mpfr_neg (x, x, MPFR_RNDZ);
if (mpfr_cmp_d (x, 0.0))
{
printf ("Error in mpfr_cmp_d 0.0 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_ui_div (x, 1, x, MPFR_RNDU);
if (mpfr_cmp_d (x, 0.0) == 0)
{
printf ("Error in mpfr_cmp_d (Inf, 0)\n");
exit (1);
}
/* Test in reduced exponent range. */
set_emin (1);
mpfr_set_ui (x, 1, MPFR_RNDN);
if (mpfr_cmp_d (x, 0.9) <= 0)
{
printf ("Error in reduced exponent range.\n");
exit (1);
}
set_emin (emin);
#if !defined(MPFR_ERRDIVZERO)
/* Check NAN */
{
int c;
mpfr_clear_flags ();
c = mpfr_cmp_d (x, DBL_NAN);
if (c != 0 || __gmpfr_flags != MPFR_FLAGS_ERANGE)
{
printf ("ERROR for NAN (1)\n");
printf ("Expected 0, got %d\n", c);
printf ("Expected flags:");
flags_out (MPFR_FLAGS_ERANGE);
printf ("Got flags: ");
flags_out (__gmpfr_flags);
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_flags ();
c = mpfr_cmp_d (x, 2.0);
if (c != 0 || __gmpfr_flags != MPFR_FLAGS_ERANGE)
{
printf ("ERROR for NAN (2)\n");
printf ("Expected 0, got %d\n", c);
printf ("Expected flags:");
flags_out (MPFR_FLAGS_ERANGE);
printf ("Got flags: ");
flags_out (__gmpfr_flags);
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
}
#endif /* MPFR_ERRDIVZERO */
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd_mode)
{
if (n > 0)
return mpfr_pow_ui(y, x, n, rnd_mode);
else
{
int inexact = 0;
if (MPFR_IS_NAN(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
MPFR_CLEAR_NAN(y);
if (n == 0)
return mpfr_set_ui(y, 1, GMP_RNDN);
if (MPFR_IS_INF(x))
{
MPFR_SET_ZERO(y);
if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0)
MPFR_SET_POS(y);
else
MPFR_SET_NEG(y);
MPFR_RET(0);
}
if (MPFR_IS_ZERO(x))
{
MPFR_SET_INF(y);
if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0)
MPFR_SET_POS(y);
else
MPFR_SET_NEG(y);
MPFR_RET(0);
}
MPFR_CLEAR_INF(y);
n = -n;
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, ti;
/* Declaration of the size variable */
mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */
mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
/* compute the precision of intermediary variable */
Nt=MAX(Nx,Ny);
/* the optimal number of bits : see algorithms.ps */
Nt=Nt+3+_mpfr_ceil_log2(Nt);
/* initialise of intermediary variable */
mpfr_init(t);
mpfr_init(ti);
do {
/* reactualisation of the precision */
mpfr_set_prec(t,Nt);
mpfr_set_prec(ti,Nt);
/* compute 1/(x^n) n>0*/
mpfr_pow_ui(ti,x,(unsigned long int)(n),GMP_RNDN);
mpfr_ui_div(t,1,ti,GMP_RNDN);
/* estimation of the error -- see pow function in algorithms.ps*/
err = Nt - 3;
/* actualisation of the precision */
Nt += 10;
} while (err<0 || !mpfr_can_round(t,err,GMP_RNDN,rnd_mode,Ny));
inexact = mpfr_set(y,t,rnd_mode);
mpfr_clear(t);
mpfr_clear(ti);
}
return inexact;
}
}
static void
compute_l2b (int output)
{
mpfr_ptr p;
mpfr_srcptr t;
int beta, i;
int error = 0;
char buffer[30];
if (output)
printf ("#ifndef UINT64_C\n# define UINT64_C(c) c\n#endif\n\n");
for (beta = 2; beta <= BASE_MAX; beta++)
{
for (i = 0; i < 2; i++)
{
p = &l2b[beta-2][i];
/* Compute the value */
if (i == 0)
{
/* 23-bit upper approximation to log(b)/log(2) */
mpfr_init2 (p, 23);
mpfr_set_ui (p, beta, MPFR_RNDU);
mpfr_log2 (p, p, MPFR_RNDU);
}
else
{
/* 77-bit upper approximation to log(2)/log(b) */
mpfr_init2 (p, 77);
mpfr_set_ui (p, beta, MPFR_RNDD);
mpfr_log2 (p, p, MPFR_RNDD);
mpfr_ui_div (p, 1, p, MPFR_RNDU);
}
sprintf (buffer, "mpfr_l2b_%d_%d", beta, i);
if (output)
print_mpfr (p, buffer);
/* Check the value */
t = &__gmpfr_l2b[beta-2][i];
if (t == NULL || MPFR_PREC (t) == 0 || !mpfr_equal_p (p, t))
{
if (!output)
{
error = 1;
printf ("Error for constant %s\n", buffer);
}
}
if (!output)
mpfr_clear (p);
}
}
if (output)
{
if (printf ("const __mpfr_struct __gmpfr_l2b[BASE_MAX-1][2] = {\n")
< 0)
{ fprintf (stderr, "Error in printf\n"); exit (1); }
for (beta = 2; beta <= BASE_MAX; beta++)
{
for (i = 0; i < 2; i++)
{
p = &l2b[beta-2][i];
if (printf (" %c {%3d,%2d,%3ld, (mp_limb_t *) "
"mpfr_l2b_%d_%d__tab }%s\n", i == 0 ? '{' : ' ',
(int) MPFR_PREC (p), MPFR_SIGN (p),
(long) MPFR_GET_EXP (p), beta, i,
i == 0 ? "," : beta < BASE_MAX ? " }," : " } };")
< 0)
{ fprintf (stderr, "Error in printf\n"); exit (1); }
mpfr_clear (p);
}
}
}
/* If there was an error, the test fails. */
if (error)
exit (1);
}
static int
mpfr_inv (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t r)
{
return mpfr_ui_div (y, 1, x, r);
}
static int
mpfr_all_div (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t r)
{
mpfr_t a2;
unsigned int oldflags, newflags;
int inex, inex2;
oldflags = __gmpfr_flags;
inex = mpfr_div (a, b, c, r);
if (a == b || a == c)
return inex;
newflags = __gmpfr_flags;
mpfr_init2 (a2, MPFR_PREC (a));
if (mpfr_integer_p (b) && ! (MPFR_IS_ZERO (b) && MPFR_IS_NEG (b)))
{
/* b is an integer, but not -0 (-0 is rejected as
it becomes +0 when converted to an integer). */
if (mpfr_fits_ulong_p (b, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_ui_div (a2, mpfr_get_ui (b, MPFR_RNDN), c, r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_ui_div", b, c, r);
}
if (mpfr_fits_slong_p (b, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_si_div (a2, mpfr_get_si (b, MPFR_RNDN), c, r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_si_div", b, c, r);
}
}
if (mpfr_integer_p (c) && ! (MPFR_IS_ZERO (c) && MPFR_IS_NEG (c)))
{
/* c is an integer, but not -0 (-0 is rejected as
it becomes +0 when converted to an integer). */
if (mpfr_fits_ulong_p (c, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_div_ui (a2, b, mpfr_get_ui (c, MPFR_RNDN), r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_div_ui", b, c, r);
}
if (mpfr_fits_slong_p (c, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_div_si (a2, b, mpfr_get_si (c, MPFR_RNDN), r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_div_si", b, c, r);
}
}
mpfr_clear (a2);
return inex;
}
mpfr_t* double_pole_case_c(long pole_order_max, mpfr_t base, mpfr_t pole_position, mpfr_t incomplete_gamma_factor, mpfr_prec_t prec){
mpfr_t* result=malloc(sizeof(mpfr_t)*(pole_order_max+1));
mpfr_t temp1;
mpfr_init2(temp1,prec);
mpfr_t double_pole_integral;
mpfr_init2(double_pole_integral,prec);
mpfr_t temp2;
mpfr_init2(temp2,prec);
mpfr_t minus_pole_position;
mpfr_init2(minus_pole_position,prec);
mpfr_neg(minus_pole_position,pole_position,MPFR_RNDN);
// mpfr_t factorial;
// mpfr_init2(factorial,prec);
// mpfr_set_ui(factorial,1,MPFR_RNDN);
mpfr_t minus_log_base;
mpfr_init2(minus_log_base,prec);
mpfr_log(minus_log_base,base,prec);
mpfr_neg(minus_log_base,minus_log_base,MPFR_RNDN);
mpfr_ui_div(minus_log_base,1,minus_log_base,MPFR_RNDN);
mpfr_t log_base_power;
mpfr_init2(log_base_power,prec);
mpfr_set(log_base_power,minus_log_base,MPFR_RNDN);
//mpfr_set_ui(temp1,0,MPFR_RNDN);
//mpfr_mul(double_pole_integral,temp1,incomplete_gamma_factor,MPFR_RNDN);
mpfr_log(temp1,base,MPFR_RNDN);
mpfr_mul(double_pole_integral,incomplete_gamma_factor,temp1,MPFR_RNDN);
mpfr_ui_div(temp1,1,minus_pole_position,MPFR_RNDN);
mpfr_add(double_pole_integral,double_pole_integral,temp1,MPFR_RNDN);
//mpfr_printf("before loop: double_pole_integral = %.32RNf\n",double_pole_integral);
for(int i=0;i<=pole_order_max;i++){
mpfr_init2(result[i],prec);
mpfr_set(result[i],double_pole_integral,MPFR_RNDN);
if(i<pole_order_max){
mpfr_mul(double_pole_integral,double_pole_integral,pole_position,MPFR_RNDN);
}
}
#ifdef debug_mode
for(int i=0;i<=pole_order_max;i++){
mpfr_printf("result[%d] = %.16RNf\n",i,result[i],MPFR_RNDN);
}
#endif
mpfr_t * factorial_times_power_lnb;
mpfr_t * single_pole_coeffs;
/*
* x**1/(x+a)**2 case
* */
if(pole_order_max >= 1){
single_pole_coeffs=malloc(sizeof(mpfr_t)*(pole_order_max));
/* x^(j+1)=(
* single_pole_coeffs[0] x^(j-1) +
* single_pole_coeffs[1] x^(j-2) + ... +
* single_pole_coeffs[j-1] x^0
* )*(x-a)^2 +
*
* single_pole_coeffs[j](x-a) * ((x-a) + a)
*
* + a^(j+1)
*
* => single_pole_coeffs[j+1]
*
* single_pole_coeffs[j+1] = single_pole_coeffs[j]*a + a^j+1
* single_pole_coeffs[0] =
* */
if(pole_order_max>=2){
factorial_times_power_lnb=malloc(sizeof(mpfr_t)*(pole_order_max-1));
mpfr_init2(factorial_times_power_lnb[0],prec);
mpfr_set(factorial_times_power_lnb[0],minus_log_base,MPFR_RNDN);
}
mpfr_set(temp1,pole_position,MPFR_RNDN);
/* below temp1 is used as pole_position^j*/
mpfr_init2(single_pole_coeffs[0],prec);
mpfr_set_ui(single_pole_coeffs[0], 1 ,MPFR_RNDN);
mpfr_add(result[1],result[1],incomplete_gamma_factor,MPFR_RNDN);
for(int j=1;j<=pole_order_max-1;j++){
mpfr_init2(single_pole_coeffs[j],prec);
mpfr_mul(single_pole_coeffs[j],single_pole_coeffs[j-1],pole_position,MPFR_RNDN);
mpfr_add(single_pole_coeffs[j],single_pole_coeffs[j],temp1,MPFR_RNDN);
mpfr_mul(temp2,single_pole_coeffs[j],incomplete_gamma_factor,MPFR_RNDN);
mpfr_add(result[j+1],result[j+1],temp2,MPFR_RNDN);
if(j<=pole_order_max-2){
mpfr_init2(factorial_times_power_lnb[j],prec);
mpfr_mul(temp1,temp1,pole_position,MPFR_RNDN);
mpfr_mul(factorial_times_power_lnb[j],factorial_times_power_lnb[j-1],minus_log_base,MPFR_RNDN);
mpfr_mul_ui(factorial_times_power_lnb[j],factorial_times_power_lnb[j],j,MPFR_RNDN);
}
}
}
#ifdef debug_mode
for(int j=0;j<=pole_order_max-1;j++){
mpfr_printf("single_pole_coeffs[%d] = %.16RNf\n",j,single_pole_coeffs[j]);
}
#endif
#ifdef debug_mode
for(int j=0;j<=pole_order_max-2;j++){
mpfr_printf("factorial_times_power_lnb[%d] = %.16RNf\n",j,factorial_times_power_lnb[j]);
}
#endif
for(int j=0;j<=pole_order_max-2;j++){
for(int k=0;k<=j;k++){
mpfr_mul(temp2,factorial_times_power_lnb[k],single_pole_coeffs[j-k],MPFR_RNDN);
mpfr_add(result[j+2],result[j+2],temp2,MPFR_RNDN);
}
}
for(int i=0;i<=pole_order_max-1;i++){
mpfr_clear(single_pole_coeffs[i]);
}
for(int i=0;i<=pole_order_max-2;i++){
mpfr_clear(factorial_times_power_lnb[i]);
}
if(pole_order_max > 0){
free(single_pole_coeffs);
}
if(pole_order_max > 1){
free(factorial_times_power_lnb);
}
mpfr_clear(temp1);
mpfr_clear(double_pole_integral);
mpfr_clear(temp2);
mpfr_clear(minus_pole_position);
//mpfr_clear(factorial);
mpfr_clear(minus_log_base);
mpfr_clear(log_base_power);
return result;
}
int
main (void)
{
mpfr_t x;
int c;
tests_start_mpfr ();
mpfr_init2(x, MPFR_LDBL_MANT_DIG);
mpfr_set_ld (x, 2.34763465, GMP_RNDN);
if (mpfr_cmp_ld(x, 2.34763465)!=0) {
printf("Error in mpfr_cmp_ld 2.34763465 and ");
mpfr_out_str(stdout, 10, 0, x, GMP_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_ld(x, 2.345)<=0) {
printf("Error in mpfr_cmp_ld 2.345 and ");
mpfr_out_str(stdout, 10, 0, x, GMP_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_ld(x, 2.4)>=0) {
printf("Error in mpfr_cmp_ld 2.4 and ");
mpfr_out_str(stdout, 10, 0, x, GMP_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, GMP_RNDZ);
mpfr_neg (x, x, GMP_RNDZ);
if (mpfr_cmp_ld (x, 0.0)) {
printf("Error in mpfr_cmp_ld 0.0 and ");
mpfr_out_str(stdout, 10, 0, x, GMP_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_ui_div (x, 1, x, GMP_RNDU);
if (mpfr_cmp_ld (x, 0.0) == 0)
{
printf ("Error in mpfr_cmp_ld (Inf, 0)\n");
exit (1);
}
/* Check NAN */
mpfr_clear_erangeflag ();
c = mpfr_cmp_ld (x, DBL_NAN);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (1)\n");
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_erangeflag ();
c = mpfr_cmp_ld (x, 2.0);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (2)\n");
exit (1);
}
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
int
main (void)
{
mpfr_t x;
tests_start_mpfr ();
mpfr_init2(x, MPFR_LDBL_MANT_DIG);
mpfr_set_ld (x, 2.34763465L, MPFR_RNDN);
if (mpfr_cmp_ld(x, 2.34763465L)!=0) {
printf("Error in mpfr_cmp_ld 2.34763465 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_ld(x, 2.345L)<=0) {
printf("Error in mpfr_cmp_ld 2.345 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_ld(x, 2.4L)>=0) {
printf("Error in mpfr_cmp_ld 2.4 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, MPFR_RNDZ);
mpfr_neg (x, x, MPFR_RNDZ);
if (mpfr_cmp_ld (x, 0.0)) {
printf("Error in mpfr_cmp_ld 0.0 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_ui_div (x, 1, x, MPFR_RNDU);
if (mpfr_cmp_ld (x, 0.0) == 0)
{
printf ("Error in mpfr_cmp_ld (Inf, 0)\n");
exit (1);
}
#if !defined(MPFR_ERRDIVZERO)
/* Check NAN */
{
int c;
mpfr_clear_erangeflag ();
c = mpfr_cmp_ld (x, DBL_NAN);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (1)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_erangeflag ();
c = mpfr_cmp_ld (x, 2.0);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (2)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
}
#endif /* MPFR_ERRDIVZERO */
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
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
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
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);
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
/* Put in s an approximation of digamma(x).
Assumes x >= 2.
Assumes s does not overlap with x.
Returns an integer e such that the error is bounded by 2^e ulps
of the result s.
*/
static mpfr_exp_t
mpfr_digamma_approx (mpfr_ptr s, mpfr_srcptr x)
{
mpfr_prec_t p = MPFR_PREC (s);
mpfr_t t, u, invxx;
mpfr_exp_t e, exps, f, expu;
mpz_t *INITIALIZED(B); /* variable B declared as initialized */
unsigned long n0, n; /* number of allocated B[] */
MPFR_ASSERTN(MPFR_IS_POS(x) && (MPFR_EXP(x) >= 2));
mpfr_init2 (t, p);
mpfr_init2 (u, p);
mpfr_init2 (invxx, p);
mpfr_log (s, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_ui_div (t, 1, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_div_2exp (t, t, 1, MPFR_RNDN); /* exact */
mpfr_sub (s, s, t, MPFR_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(olds)-EXP(s)) + 1/2*2^(EXP(t)-EXP(s)).
For x >= 2, log(x) >= 2*(1/(2x)), thus olds >= 2t, and olds - t >= olds/2,
thus 0 <= EXP(olds)-EXP(s) <= 1, and EXP(t)-EXP(s) <= 0, thus
error <= 1/2 + 1/2*2 + 1/2 <= 2 ulps. */
e = 2; /* initial error */
mpfr_mul (invxx, x, x, MPFR_RNDZ); /* invxx = x^2 * (1 + theta)
for |theta| <= 2^(-p) */
mpfr_ui_div (invxx, 1, invxx, MPFR_RNDU); /* invxx = 1/x^2 * (1 + theta)^2 */
/* in the following we note err=xxx when the ratio between the approximation
and the exact result can be written (1 + theta)^xxx for |theta| <= 2^(-p),
following Higham's method */
B = mpfr_bernoulli_internal ((mpz_t *) 0, 0);
mpfr_set_ui (t, 1, MPFR_RNDN); /* err = 0 */
for (n = 1;; n++)
{
/* compute next Bernoulli number */
B = mpfr_bernoulli_internal (B, n);
/* The main term is Bernoulli[2n]/(2n)/x^(2n) = B[n]/(2n+1)!(2n)/x^(2n)
= B[n]*t[n]/(2n) where t[n]/t[n-1] = 1/(2n)/(2n+1)/x^2. */
mpfr_mul (t, t, invxx, MPFR_RNDU); /* err = err + 3 */
mpfr_div_ui (t, t, 2 * n, MPFR_RNDU); /* err = err + 1 */
mpfr_div_ui (t, t, 2 * n + 1, MPFR_RNDU); /* err = err + 1 */
/* we thus have err = 5n here */
mpfr_div_ui (u, t, 2 * n, MPFR_RNDU); /* err = 5n+1 */
mpfr_mul_z (u, u, B[n], MPFR_RNDU); /* err = 5n+2, and the
absolute error is bounded
by 10n+4 ulp(u) [Rule 11] */
/* if the terms 'u' are decreasing by a factor two at least,
then the error coming from those is bounded by
sum((10n+4)/2^n, n=1..infinity) = 24 */
exps = mpfr_get_exp (s);
expu = mpfr_get_exp (u);
if (expu < exps - (mpfr_exp_t) p)
break;
mpfr_sub (s, s, u, MPFR_RNDN); /* error <= 24 + n/2 */
if (mpfr_get_exp (s) < exps)
e <<= exps - mpfr_get_exp (s);
e ++; /* error in mpfr_sub */
f = 10 * n + 4;
while (expu < exps)
{
f = (1 + f) / 2;
expu ++;
}
e += f; /* total rouding error coming from 'u' term */
}
n0 = ++n;
while (n--)
mpz_clear (B[n]);
(*__gmp_free_func) (B, n0 * sizeof (mpz_t));
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (invxx);
f = 0;
while (e > 1)
{
f++;
e = (e + 1) / 2;
/* Invariant: 2^f * e does not decrease */
}
return f;
}
static int
decimal (void)
{
mpfr_prec_t p = 128;
mpfr_t x;
mpfr_t z;
mpfr_init (z);
mpfr_init2 (x, p);
/* specifier 'P' for precision */
check_vsprintf ("128", "%Pu", p);
check_vsprintf ("00128", "%.5Pu", p);
/* special numbers */
mpfr_set_inf (x, 1);
check_sprintf (pinf_str, "%Re", x);
check_sprintf (pinf_str, "%RUe", x);
check_sprintf (pinf_uc_str, "%RE", x);
check_sprintf (pinf_uc_str, "%RDE", x);
check_sprintf (pinf_str, "%Rf", x);
check_sprintf (pinf_str, "%RYf", x);
check_sprintf (pinf_uc_str, "%RF", x);
check_sprintf (pinf_uc_str, "%RZF", x);
check_sprintf (pinf_str, "%Rg", x);
check_sprintf (pinf_str, "%RNg", x);
check_sprintf (pinf_uc_str, "%RG", x);
check_sprintf (pinf_uc_str, "%RUG", x);
check_sprintf (" inf", "%010Re", x);
check_sprintf (" inf", "%010RDe", x);
mpfr_set_inf (x, -1);
check_sprintf (minf_str, "%Re", x);
check_sprintf (minf_str, "%RYe", x);
check_sprintf (minf_uc_str, "%RE", x);
check_sprintf (minf_uc_str, "%RZE", x);
check_sprintf (minf_str, "%Rf", x);
check_sprintf (minf_str, "%RNf", x);
check_sprintf (minf_uc_str, "%RF", x);
check_sprintf (minf_uc_str, "%RUF", x);
check_sprintf (minf_str, "%Rg", x);
check_sprintf (minf_str, "%RDg", x);
check_sprintf (minf_uc_str, "%RG", x);
check_sprintf (minf_uc_str, "%RYG", x);
check_sprintf (" -inf", "%010Re", x);
check_sprintf (" -inf", "%010RZe", x);
mpfr_set_nan (x);
check_sprintf (nan_str, "%Re", x);
check_sprintf (nan_str, "%RNe", x);
check_sprintf (nan_uc_str, "%RE", x);
check_sprintf (nan_uc_str, "%RUE", x);
check_sprintf (nan_str, "%Rf", x);
check_sprintf (nan_str, "%RDf", x);
check_sprintf (nan_uc_str, "%RF", x);
check_sprintf (nan_uc_str, "%RYF", x);
check_sprintf (nan_str, "%Rg", x);
check_sprintf (nan_str, "%RZg", x);
check_sprintf (nan_uc_str, "%RG", x);
check_sprintf (nan_uc_str, "%RNG", x);
check_sprintf (" nan", "%010Re", x);
/* positive numbers */
mpfr_set_str (x, "18993474.61279296875", 10, MPFR_RNDN);
mpfr_set_ui (z, 0, MPFR_RNDD);
/* simplest case right justified */
check_sprintf (" 1.899347461279296875e+07", "%30Re", x);
check_sprintf (" 2e+07", "%30.0Re", x);
check_sprintf (" 18993474.612793", "%30Rf", x);
check_sprintf (" 18993474.6127930", "%30.7Rf", x);
check_sprintf (" 1.89935e+07", "%30Rg", x);
check_sprintf (" 2e+07", "%30.0Rg", x);
check_sprintf (" 18993474.61279296875", "%30.19Rg", x);
check_sprintf (" 0e+00", "%30.0Re", z);
check_sprintf (" 0", "%30.0Rf", z);
check_sprintf (" 0.0000", "%30.4Rf", z);
check_sprintf (" 0", "%30.0Rg", z);
check_sprintf (" 0", "%30.4Rg", z);
/* sign or space, pad with leading zeros */
check_sprintf (" 000001.899347461279296875E+07", "% 030RE", x);
check_sprintf (" 0000000000000000001.89935E+07", "% 030RG", x);
check_sprintf (" 0000000000000000000000002E+07", "% 030.0RE", x);
check_sprintf (" 0000000000000000000000000E+00", "% 030.0RE", z);
check_sprintf (" 00000000000000000000000000000", "% 030.0RF", z);
/* sign + or -, left justified */
check_sprintf ("+1.899347461279296875e+07 ", "%+-30Re", x);
check_sprintf ("+2e+07 ", "%+-30.0Re", x);
check_sprintf ("+0e+00 ", "%+-30.0Re", z);
check_sprintf ("+0 ", "%+-30.0Rf", z);
/* decimal point, left justified, precision and rounding parameter */
check_vsprintf ("1.9E+07 ", "%#-10.*R*E", 1, MPFR_RNDN, x);
check_vsprintf ("2.E+07 ", "%#*.*R*E", -10, 0, MPFR_RNDN, x);
check_vsprintf ("2.E+07 ", "%#-10.*R*G", 0, MPFR_RNDN, x);
check_vsprintf ("0.E+00 ", "%#-10.*R*E", 0, MPFR_RNDN, z);
check_vsprintf ("0. ", "%#-10.*R*F", 0, MPFR_RNDN, z);
check_vsprintf ("0. ", "%#-10.*R*G", 0, MPFR_RNDN, z);
/* sign or space */
check_sprintf (" 1.899e+07", "% .3RNe", x);
check_sprintf (" 2e+07", "% .0RNe", x);
/* sign + or -, decimal point, pad with leading zeros */
check_sprintf ("+0001.8E+07", "%0+#11.1RZE", x);
check_sprintf ("+00001.E+07", "%0+#11.0RZE", x);
check_sprintf ("+0000.0E+00", "%0+#11.1RZE", z);
check_sprintf ("+00000000.0", "%0+#11.1RZF", z);
/* pad with leading zero */
check_sprintf ("0000001.899347461279296875e+07", "%030RDe", x);
check_sprintf ("00000000000000000000000001e+07", "%030.0RDe", x);
/* sign or space, decimal point, left justified */
check_sprintf (" 1.8E+07 ", "%- #11.1RDE", x);
check_sprintf (" 1.E+07 ", "%- #11.0RDE", x);
/* negative numbers */
mpfr_mul_si (x, x, -1, MPFR_RNDD);
mpfr_mul_si (z, z, -1, MPFR_RNDD);
/* sign + or - */
check_sprintf (" -1.8e+07", "%+10.1RUe", x);
check_sprintf (" -1e+07", "%+10.0RUe", x);
check_sprintf (" -0e+00", "%+10.0RUe", z);
check_sprintf (" -0", "%+10.0RUf", z);
/* neighborhood of 1 */
mpfr_set_str (x, "0.99993896484375", 10, MPFR_RNDN);
check_sprintf ("9.9993896484375E-01 ", "%-20RE", x);
check_sprintf ("9.9993896484375E-01 ", "%-20.RE", x);
check_sprintf ("1E+00 ", "%-20.0RE", x);
check_sprintf ("1.0E+00 ", "%-20.1RE", x);
check_sprintf ("1.00E+00 ", "%-20.2RE", x);
check_sprintf ("9.999E-01 ", "%-20.3RE", x);
check_sprintf ("9.9994E-01 ", "%-20.4RE", x);
check_sprintf ("0.999939 ", "%-20RF", x);
check_sprintf ("0.999939 ", "%-20.RF", x);
check_sprintf ("1 ", "%-20.0RF", x);
check_sprintf ("1.0 ", "%-20.1RF", x);
check_sprintf ("1.00 ", "%-20.2RF", x);
check_sprintf ("1.000 ", "%-20.3RF", x);
check_sprintf ("0.9999 ", "%-20.4RF", x);
check_sprintf ("0.999939 ", "%-#20RF", x);
check_sprintf ("0.999939 ", "%-#20.RF", x);
check_sprintf ("1. ", "%-#20.0RF", x);
check_sprintf ("1.0 ", "%-#20.1RF", x);
check_sprintf ("1.00 ", "%-#20.2RF", x);
check_sprintf ("1.000 ", "%-#20.3RF", x);
check_sprintf ("0.9999 ", "%-#20.4RF", x);
check_sprintf ("1 ", "%-20.0RG", x);
check_sprintf ("1 ", "%-20.1RG", x);
check_sprintf ("1 ", "%-20.2RG", x);
check_sprintf ("1 ", "%-20.3RG", x);
check_sprintf ("0.9999 ", "%-20.4RG", x);
check_sprintf ("0.999939 ", "%-#20RG", x);
check_sprintf ("0.999939 ", "%-#20.RG", x);
check_sprintf ("1. ", "%-#20.0RG", x);
check_sprintf ("1. ", "%-#20.1RG", x);
check_sprintf ("1.0 ", "%-#20.2RG", x);
check_sprintf ("1.00 ", "%-#20.3RG", x);
check_sprintf ("0.9999 ", "%-#20.4RG", x);
/* multiple of 10 */
mpfr_set_str (x, "1e17", 10, MPFR_RNDN);
check_sprintf ("1e+17", "%Re", x);
check_sprintf ("1.000e+17", "%.3Re", x);
check_sprintf ("100000000000000000", "%.0Rf", x);
check_sprintf ("100000000000000000.0", "%.1Rf", x);
check_sprintf ("100000000000000000.000000", "%'Rf", x);
check_sprintf ("100000000000000000.0", "%'.1Rf", x);
mpfr_ui_div (x, 1, x, MPFR_RNDN); /* x=1e-17 */
check_sprintf ("1e-17", "%Re", x);
check_sprintf ("0.000000", "%Rf", x);
check_sprintf ("1e-17", "%Rg", x);
check_sprintf ("0.0", "%.1RDf", x);
check_sprintf ("0.0", "%.1RZf", x);
check_sprintf ("0.1", "%.1RUf", x);
check_sprintf ("0.1", "%.1RYf", x);
check_sprintf ("0", "%.0RDf", x);
check_sprintf ("0", "%.0RZf", x);
check_sprintf ("1", "%.0RUf", x);
check_sprintf ("1", "%.0RYf", x);
/* multiple of 10 with 'g' style */
mpfr_set_str (x, "10", 10, MPFR_RNDN);
check_sprintf ("10", "%Rg", x);
check_sprintf ("1e+01", "%.0Rg", x);
check_sprintf ("1e+01", "%.1Rg", x);
check_sprintf ("10", "%.2Rg", x);
mpfr_ui_div (x, 1, x, MPFR_RNDN);
check_sprintf ("0.1", "%Rg", x);
check_sprintf ("0.1", "%.0Rg", x);
check_sprintf ("0.1", "%.1Rg", x);
mpfr_set_str (x, "1000", 10, MPFR_RNDN);
check_sprintf ("1000", "%Rg", x);
check_sprintf ("1e+03", "%.0Rg", x);
check_sprintf ("1e+03", "%.3Rg", x);
check_sprintf ("1000", "%.4Rg", x);
mpfr_ui_div (x, 1, x, MPFR_RNDN);
check_sprintf ("0.001", "%Rg", x);
check_sprintf ("0.001", "%.0Rg", x);
check_sprintf ("0.001", "%.1Rg", x);
mpfr_set_str (x, "100000", 10, MPFR_RNDN);
check_sprintf ("100000", "%Rg", x);
check_sprintf ("1e+05", "%.0Rg", x);
check_sprintf ("1e+05", "%.5Rg", x);
check_sprintf ("100000", "%.6Rg", x);
mpfr_ui_div (x, 1, x, MPFR_RNDN);
check_sprintf ("1e-05", "%Rg", x);
check_sprintf ("1e-05", "%.0Rg", x);
check_sprintf ("1e-05", "%.1Rg", x);
/* check rounding mode */
mpfr_set_str (x, "0.0076", 10, MPFR_RNDN);
check_sprintf ("0.007", "%.3RDF", x);
check_sprintf ("0.007", "%.3RZF", x);
check_sprintf ("0.008", "%.3RF", x);
check_sprintf ("0.008", "%.3RUF", x);
check_sprintf ("0.008", "%.3RYF", x);
check_vsprintf ("0.008", "%.3R*F", MPFR_RNDA, x);
/* check limit between %f-style and %g-style */
mpfr_set_str (x, "0.0000999", 10, MPFR_RNDN);
check_sprintf ("0.0001", "%.0Rg", x);
check_sprintf ("9e-05", "%.0RDg", x);
check_sprintf ("0.0001", "%.1Rg", x);
check_sprintf ("0.0001", "%.2Rg", x);
check_sprintf ("9.99e-05", "%.3Rg", x);
/* trailing zeros */
mpfr_set_si_2exp (x, -1, -15, MPFR_RNDN); /* x=-2^-15 */
check_sprintf ("-3.0517578125e-05", "%.30Rg", x);
check_sprintf ("-3.051757812500000000000000000000e-05", "%.30Re", x);
check_sprintf ("-3.05175781250000000000000000000e-05", "%#.30Rg", x);
check_sprintf ("-0.000030517578125000000000000000", "%.30Rf", x);
/* bug 20081023 */
check_sprintf ("-3.0517578125e-05", "%.30Rg", x);
mpfr_set_str (x, "1.9999", 10, MPFR_RNDN);
check_sprintf ("1.999900 ", "%-#10.7RG", x);
check_sprintf ("1.9999 ", "%-10.7RG", x);
mpfr_set_ui (x, 1, MPFR_RNDN);
check_sprintf ("1.00000000000000000000000000000", "%#.30Rg", x);
check_sprintf ("1", "%.30Rg", x);
mpfr_set_ui (x, 0, MPFR_RNDN);
check_sprintf ("0.000000000000000000000000000000", "%#.30Rg", x);
check_sprintf ("0", "%.30Rg", x);
/* following tests with precision 53 bits */
mpfr_set_prec (x, 53);
/* Exponent zero has a plus sign */
mpfr_set_str (x, "-9.95645044213728791504536275169812142849e-01", 10,
MPFR_RNDN);
check_sprintf ("-1.0e+00", "%- #0.1Re", x);
/* Decimal point and no figure after it with '#' flag and 'G' style */
mpfr_set_str (x, "-9.90597761233942053494e-01", 10, MPFR_RNDN);
check_sprintf ("-1.", "%- #0.1RG", x);
/* precision zero */
mpfr_set_d (x, 9.5, MPFR_RNDN);
check_sprintf ("9", "%.0RDf", x);
check_sprintf ("10", "%.0RUf", x);
mpfr_set_d (x, 19.5, MPFR_RNDN);
check_sprintf ("19", "%.0RDf", x);
check_sprintf ("20", "%.0RUf", x);
mpfr_set_d (x, 99.5, MPFR_RNDN);
check_sprintf ("99", "%.0RDf", x);
check_sprintf ("100", "%.0RUf", x);
mpfr_set_d (x, -9.5, MPFR_RNDN);
check_sprintf ("-10", "%.0RDf", x);
check_sprintf ("-10", "%.0RYf", x);
check_sprintf ("-10", "%.0Rf", x);
check_sprintf ("-1e+01", "%.0Re", x);
check_sprintf ("-1e+01", "%.0Rg", x);
mpfr_set_ui_2exp (x, 1, -1, MPFR_RNDN);
check_sprintf ("0", "%.0Rf", x);
check_sprintf ("5e-01", "%.0Re", x);
check_sprintf ("0.5", "%.0Rg", x);
mpfr_set_ui_2exp (x, 3, -1, MPFR_RNDN);
check_sprintf ("2", "%.0Rf", x);
mpfr_set_ui_2exp (x, 5, -1, MPFR_RNDN);
check_sprintf ("2", "%.0Rf", x);
mpfr_set_ui (x, 0x1f, MPFR_RNDN);
check_sprintf ("0x1p+5", "%.0Ra", x);
mpfr_set_ui (x, 3, MPFR_RNDN);
check_sprintf ("1p+2", "%.0Rb", x);
/* round to next ten power with %f but not with %g */
mpfr_set_str (x, "-6.64464380544039223686e-02", 10, MPFR_RNDN);
check_sprintf ("-0.1", "%.1Rf", x);
check_sprintf ("-0.0", "%.1RZf", x);
check_sprintf ("-0.07", "%.1Rg", x);
check_sprintf ("-0.06", "%.1RZg", x);
/* round to next ten power and do not remove trailing zeros */
mpfr_set_str (x, "9.98429393291486722006e-02", 10, MPFR_RNDN);
check_sprintf ("0.1", "%#.1Rg", x);
check_sprintf ("0.10", "%#.2Rg", x);
check_sprintf ("0.099", "%#.2RZg", x);
/* Halfway cases */
mpfr_set_str (x, "1.5", 10, MPFR_RNDN);
check_sprintf ("2e+00", "%.0Re", x);
mpfr_set_str (x, "2.5", 10, MPFR_RNDN);
check_sprintf ("2e+00", "%.0Re", x);
mpfr_set_str (x, "9.5", 10, MPFR_RNDN);
check_sprintf ("1e+01", "%.0Re", x);
mpfr_set_str (x, "1.25", 10, MPFR_RNDN);
check_sprintf ("1.2e+00", "%.1Re", x);
mpfr_set_str (x, "1.75", 10, MPFR_RNDN);
check_sprintf ("1.8e+00", "%.1Re", x);
mpfr_set_str (x, "-0.5", 10, MPFR_RNDN);
check_sprintf ("-0", "%.0Rf", x);
mpfr_set_str (x, "1.25", 10, MPFR_RNDN);
check_sprintf ("1.2", "%.1Rf", x);
mpfr_set_str (x, "1.75", 10, MPFR_RNDN);
check_sprintf ("1.8", "%.1Rf", x);
mpfr_set_str (x, "1.5", 10, MPFR_RNDN);
check_sprintf ("2", "%.1Rg", x);
mpfr_set_str (x, "2.5", 10, MPFR_RNDN);
check_sprintf ("2", "%.1Rg", x);
mpfr_set_str (x, "9.25", 10, MPFR_RNDN);
check_sprintf ("9.2", "%.2Rg", x);
mpfr_set_str (x, "9.75", 10, MPFR_RNDN);
check_sprintf ("9.8", "%.2Rg", x);
/* assertion failure in r6320 */
mpfr_set_str (x, "-9.996", 10, MPFR_RNDN);
check_sprintf ("-10.0", "%.1Rf", x);
/* regression in MPFR 3.1.0 (bug introduced in r7761, fixed in r7931) */
check_sprintf ("-10", "%.2Rg", x);
mpfr_clears (x, z, (mpfr_ptr) 0);
return 0;
}
// TODO : Refactor function so that memory allocation and deallocation
//calls are minimized.
double network_eff(double bfrac, int mu, int gamma, int d, int phi, double pin,double xi, double yi, double delta, int prec)
{
int psiz=1,i,dmax=d;
double pini=pin,pmax=pin, pinc=0.1,effout;
mpz_t mump;
mpz_init_set_ui(mump,(unsigned long int)mu);
mpz_t dmp;
mpz_init_set_ui(dmp,(unsigned long int)dmax);
mpz_t gamp;
mpz_init(gamp);
mpz_set_ui(gamp,gamma);
mpz_t ncodes;
mpz_init(ncodes);
mpfr_t ncodesfr;
mpfr_t nc_pow;
mpfr_init2(nc_pow,prec);
mpfr_init2(ncodesfr,prec);
mpfr_set_d(ncodesfr,2,MPFR_RNDN);
mpfr_set_d(nc_pow,bfrac*mu,MPFR_RNDN);
mpfr_pow(ncodesfr,ncodesfr,nc_pow,MPFR_RNDN);
mpfr_get_z(ncodes,ncodesfr,MPFR_RNDN);
int pdfsize=(mu+1)*psiz;
mpfr_t * ipdfptr;
mpfr_t * ucodesptr;
mpfr_t * p0ptr;
ipdfptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
ucodesptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
p0ptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
for(i=0;i<=pdfsize-1;i++)
{
mpfr_init2(*(ipdfptr+i),prec);
mpfr_set_d(*(ipdfptr+i),0,MPFR_RNDN);
mpfr_init2(*(ucodesptr+i),prec);
mpfr_init2(*(p0ptr+i),prec);
}
int rsize=(mu+1)*(gamma+1);
mpfr_t * distptr;
distptr=(mpfr_t *) malloc(rsize*sizeof(mpfr_t));
for(i=0;i<=rsize-1;i++)
{
mpfr_init2(*(distptr+i),prec);
}
mpfr_t *eff;
int esize=1;
eff=(mpfr_t *) malloc(esize*sizeof(mpfr_t));
for(i=0;i<=esize-1;i++)
{
mpfr_init2(*(eff+i),prec);
mpfr_set_d(*(eff+i),0,MPFR_RNDN);
}
//Binomial coeffs: (z,x) with z:0->gamma, x:0->gamma
mpfr_t * gamma_bcfr;
int gbf_size=(gamma+1)*(gamma+1);
gamma_bcfr=(mpfr_t *)malloc(gbf_size*sizeof(mpfr_t));
for(i=0;i<=gbf_size-1;i++)
mpfr_init2(*(gamma_bcfr+i),prec);
//Binomial coeffs: (y,x) with y:0->mu, x:0->d
int bacsize=(mu+1)*(dmax+1);
mpz_t beta_ai_cnt[bacsize];
for(i=0;i<=bacsize-1;i++)
mpz_init(beta_ai_cnt[i]);
//Binomial coeffs: (mu,x) with x:0->mu
mpfr_t mu_bcfr[mu+1];
for(i=0;i<=mu;i++)
mpfr_init2(mu_bcfr[i],prec);
//Binomial coeff: (mu,d) x:1->d (integer)
mpz_t mu_bc[dmax];
for(i=0;i<=dmax-1;i++)
mpz_init(mu_bc[i]);
int ppsize=(mu+1);//0.5*(dmax*(dmax+1)-(dini-1)*dini)*(mu+1);
mpfr_t * ppptr;
ppptr=(mpfr_t *) malloc(ppsize*sizeof(mpfr_t));
for(i=0;i<=ppsize-1;i++)
{
mpfr_init2(*(ppptr+i),prec);
mpfr_set_d(*(ppptr+i),0,MPFR_RNDN);
}
tabulate_bins_fr(gamma_bcfr,0,gamma,0,gamma,prec);
tabulate_bins_fr(mu_bcfr,mu,mu,0,mu,prec);
tabulate_bins_z(mu_bc,mu,mu,1,dmax);
tabulate_bins_z(beta_ai_cnt,0,mu,0,dmax);
inpdf(ipdfptr,mump,psiz,pini,pinc,mu,mu_bcfr,prec);
uniquecodes(ucodesptr,psiz,mump,mu,ncodes,ipdfptr,prec);
pphi(ppptr,mump,dmp,mu,d,phi,beta_ai_cnt,mu_bc,prec);
scjoint(distptr,mu,gamma,psiz,d,phi,(gamma_bcfr+gamma*(gamma+1)),ipdfptr,ppptr,prec);
for(i=0;i<=pdfsize-1;i++)
{
if(mpfr_cmp_si(*(ucodesptr+i),0)<=0)
mpfr_set_ui(*(p0ptr+i),0,MPFR_RNDN);
else
mpfr_ui_div(*(p0ptr+i),1,*(ucodesptr+i),MPFR_RNDN);
}
eff_point(eff,ipdfptr,distptr,ppptr,gamma_bcfr,p0ptr,d,phi,mu,gamma,pin,xi,yi,delta,prec);
effout=mpfr_get_d(*eff,MPFR_RNDN);
mpz_clear(mump);
mpz_clear(dmp);
mpz_clear(gamp);
mpz_clear(ncodes);
mpfr_clear(ncodesfr);
mpfr_clear(nc_pow);
for(i=0;i<=pdfsize-1;i++)
{
mpfr_clear(*(ipdfptr+i));
mpfr_clear(*(ucodesptr+i));
mpfr_clear(*(p0ptr+i));
}
free(ipdfptr);
free(ucodesptr);
free(p0ptr);
for(i=0;i<=rsize-1;i++)
mpfr_clear(*(distptr+i));
free(distptr);
for(i=0;i<=esize-1;i++)
mpfr_clear(*(eff+i));
free(eff);
for(i=0;i<=(gamma+1)*(gamma+1)-1;i++)
mpfr_clear(*(gamma_bcfr+i));
free(gamma_bcfr);
for(i=0;i<=bacsize-1;i++)
mpz_clear(beta_ai_cnt[i]);
for(i=0;i<=mu;i++)
mpfr_clear(mu_bcfr[i]);
for(i=0;i<=dmax-1;i++)
mpz_clear(mu_bc[i]);
for(i=0;i<=ppsize-1;i++)
mpfr_clear(*(ppptr+i));
free(ppptr);
return effout;
}
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_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd)
{
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg n=%ld rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x, n, rnd),
("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y));
if (n >= 0)
return mpfr_pow_ui (y, x, n, rnd);
else
{
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else
{
int positive = MPFR_IS_POS (x) || ((unsigned long) n & 1) == 0;
if (MPFR_IS_INF (x))
MPFR_SET_ZERO (y);
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_INF (y);
mpfr_set_divby0 ();
}
if (positive)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET (0);
}
}
/* detect exact powers: x^(-n) is exact iff x is a power of 2 */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0)
{
mpfr_exp_t expx = MPFR_EXP (x) - 1, expy;
MPFR_ASSERTD (n < 0);
/* Warning: n * expx may overflow!
*
* Some systems (apparently alpha-freebsd) abort with
* LONG_MIN / 1, and LONG_MIN / -1 is undefined.
* http://www.freebsd.org/cgi/query-pr.cgi?pr=72024
*
* Proof of the overflow checking. The expressions below are
* assumed to be on the rational numbers, but the word "overflow"
* still has its own meaning in the C context. / still denotes
* the integer (truncated) division, and // denotes the exact
* division.
* - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n
* cannot overflow due to the constraints on the exponents of
* MPFR numbers.
* - If n = -1, then n * expx = - expx, which is representable
* because of the constraints on the exponents of MPFR numbers.
* - If expx = 0, then n * expx = 0, which is representable.
* - If n < -1 and expx > 0:
* + If expx > (__gmpfr_emin - 1) / n, then
* expx >= (__gmpfr_emin - 1) / n + 1
* > (__gmpfr_emin - 1) // n,
* and
* n * expx < __gmpfr_emin - 1,
* i.e.
* n * expx <= __gmpfr_emin - 2.
* This corresponds to an underflow, with a null result in
* the rounding-to-nearest mode.
* + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot
* overflow since 0 < expx <= (__gmpfr_emin - 1) / n and
* 0 > n * expx >= n * ((__gmpfr_emin - 1) / n)
* >= __gmpfr_emin - 1.
* - If n < -1 and expx < 0:
* + If expx < (__gmpfr_emax - 1) / n, then
* expx <= (__gmpfr_emax - 1) / n - 1
* < (__gmpfr_emax - 1) // n,
* and
* n * expx > __gmpfr_emax - 1,
* i.e.
* n * expx >= __gmpfr_emax.
* This corresponds to an overflow (2^(n * expx) has an
* exponent > __gmpfr_emax).
* + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot
* overflow since 0 > expx >= (__gmpfr_emax - 1) / n and
* 0 < n * expx <= n * ((__gmpfr_emax - 1) / n)
* <= __gmpfr_emax - 1.
* Note: one could use expx bounds based on MPFR_EXP_MIN and
* MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The
* current bounds do not lead to noticeably slower code and
* allow us to avoid a bug in Sun's compiler for Solaris/x86
* (when optimizations are enabled); known affected versions:
* cc: Sun C 5.8 2005/10/13
* cc: Sun C 5.8 Patch 121016-02 2006/03/31
* cc: Sun C 5.8 Patch 121016-04 2006/10/18
*/
expy =
n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ?
MPFR_EMIN_MIN - 2 /* Underflow */ :
n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ?
MPFR_EMAX_MAX /* Overflow */ : n * expx;
return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1,
expy, rnd);
}
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mpfr_prec_t Ny; /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_rnd_t rnd1;
int size_n;
int inexact;
unsigned long abs_n;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
abs_n = - (unsigned long) n;
count_leading_zeros (size_n, (mp_limb_t) abs_n);
size_n = GMP_NUMB_BITS - size_n;
/* initial working precision */
Ny = MPFR_PREC (y);
Nt = Ny + size_n + 3 + MPFR_INT_CEIL_LOG2 (Ny);
MPFR_SAVE_EXPO_MARK (expo);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
/* We will compute rnd(rnd1(1/x) ^ |n|), where rnd1 is the rounding
toward sign(x), to avoid spurious overflow or underflow, as in
mpfr_pow_z. */
rnd1 = MPFR_EXP (x) < 1 ? MPFR_RNDZ :
(MPFR_SIGN (x) > 0 ? MPFR_RNDU : MPFR_RNDD);
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute (1/x)^|n| */
MPFR_BLOCK (flags, mpfr_ui_div (t, 1, x, rnd1));
MPFR_ASSERTD (! MPFR_UNDERFLOW (flags));
/* t = (1/x)*(1+theta) where |theta| <= 2^(-Nt) */
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
goto overflow;
MPFR_BLOCK (flags, mpfr_pow_ui (t, t, abs_n, rnd));
/* t = (1/x)^|n|*(1+theta')^(|n|+1) where |theta'| <= 2^(-Nt).
If (|n|+1)*2^(-Nt) <= 1/2, which is satisfied as soon as
Nt >= bits(n)+2, then we can use Lemma \ref{lemma_graillat}
from algorithms.tex, which yields x^n*(1+theta) with
|theta| <= 2(|n|+1)*2^(-Nt), thus the error is bounded by
2(|n|+1) ulps <= 2^(bits(n)+2) ulps. */
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
overflow:
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
MPFR_LOG_MSG (("overflow\n", 0));
return mpfr_overflow (y, rnd, abs_n & 1 ?
MPFR_SIGN (x) : MPFR_SIGN_POS);
}
if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_LOG_MSG (("underflow\n", 0));
if (rnd == MPFR_RNDN)
{
mpfr_t y2, nn;
/* We cannot decide now whether the result should be
rounded toward zero or away from zero. So, like
in mpfr_pow_pos_z, let's use the general case of
mpfr_pow in precision 2. */
MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_SIGN (x),
MPFR_EXP (x) - 1) != 0);
mpfr_init2 (y2, 2);
mpfr_init2 (nn, sizeof (long) * CHAR_BIT);
inexact = mpfr_set_si (nn, n, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
inexact = mpfr_pow_general (y2, x, nn, rnd, 1,
(mpfr_save_expo_t *) NULL);
mpfr_clear (nn);
mpfr_set (y, y2, MPFR_RNDN);
mpfr_clear (y2);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
goto end;
}
else
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd, abs_n & 1 ?
MPFR_SIGN (x) : MPFR_SIGN_POS);
}
}
/* error estimate -- see pow function in algorithms.ps */
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - size_n - 2, Ny, rnd)))
break;
/* actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd);
mpfr_clear (t);
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd);
}
}
}
/* 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);
}
/* we have x >= 1/2 here */
static int
mpfr_digamma_positive (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t p = MPFR_PREC(y) + 10, q;
mpfr_t t, u, x_plus_j;
int inex;
mpfr_exp_t errt, erru, expt;
unsigned long j = 0, min;
MPFR_ZIV_DECL (loop);
/* compute a precision q such that x+1 is exact */
if (MPFR_PREC(x) < MPFR_EXP(x))
q = MPFR_EXP(x);
else
q = MPFR_PREC(x) + 1;
mpfr_init2 (x_plus_j, q);
mpfr_init2 (t, p);
mpfr_init2 (u, p);
MPFR_ZIV_INIT (loop, p);
for(;;)
{
/* Lower bound for x+j in mpfr_digamma_approx call: since the smallest
term of the divergent series for Digamma(x) is about exp(-2*Pi*x), and
we want it to be less than 2^(-p), this gives x > p*log(2)/(2*Pi)
i.e., x >= 0.1103 p.
To be safe, we ensure x >= 0.25 * p.
*/
min = (p + 3) / 4;
if (min < 2)
min = 2;
mpfr_set (x_plus_j, x, MPFR_RNDN);
mpfr_set_ui (u, 0, MPFR_RNDN);
j = 0;
while (mpfr_cmp_ui (x_plus_j, min) < 0)
{
j ++;
mpfr_ui_div (t, 1, x_plus_j, MPFR_RNDN); /* err <= 1/2 ulp */
mpfr_add (u, u, t, MPFR_RNDN);
inex = mpfr_add_ui (x_plus_j, x_plus_j, 1, MPFR_RNDZ);
if (inex != 0) /* we lost one bit */
{
q ++;
mpfr_prec_round (x_plus_j, q, MPFR_RNDZ);
mpfr_nextabove (x_plus_j);
}
/* since all terms are positive, the error is bounded by j ulps */
}
for (erru = 0; j > 1; erru++, j = (j + 1) / 2);
errt = mpfr_digamma_approx (t, x_plus_j);
expt = MPFR_EXP(t);
mpfr_sub (t, t, u, MPFR_RNDN);
if (MPFR_EXP(t) < expt)
errt += expt - MPFR_EXP(t);
if (MPFR_EXP(t) < MPFR_EXP(u))
erru += MPFR_EXP(u) - MPFR_EXP(t);
if (errt > erru)
errt = errt + 1;
else if (errt == erru)
errt = errt + 2;
else
errt = erru + 1;
if (MPFR_CAN_ROUND (t, p - errt, MPFR_PREC(y), rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (t, p);
mpfr_set_prec (u, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (y, t, rnd_mode);
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (x_plus_j);
return inex;
}
