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