static mpfr_prec_t get_prec_max (mpfr_t *tab, unsigned long n, mpfr_prec_t f) { mpfr_prec_t res; mpfr_exp_t min, max; unsigned long i; i = 0; while (MPFR_IS_ZERO (tab[i])) { i++; if (i == n) return MPFR_PREC_MIN; /* all values are 0 */ } if (! mpfr_check (tab[i])) { printf ("tab[%lu] is not valid.\n", i); exit (1); } MPFR_ASSERTN (MPFR_IS_FP (tab[i])); min = max = MPFR_GET_EXP(tab[i]); for (i++; i < n; i++) { if (! mpfr_check (tab[i])) { printf ("tab[%lu] is not valid.\n", i); exit (1); } MPFR_ASSERTN (MPFR_IS_FP (tab[i])); if (! MPFR_IS_ZERO (tab[i])) { if (MPFR_GET_EXP(tab[i]) > max) max = MPFR_GET_EXP(tab[i]); if (MPFR_GET_EXP(tab[i]) < min) min = MPFR_GET_EXP(tab[i]); } } res = max - min; res += f; res += __gmpfr_ceil_log2 (n) + 1; return res; }
static mp_prec_t get_prec_max (mpfr_t *tab, unsigned long n, mp_prec_t f) { mp_prec_t res; mp_exp_t min, max; unsigned long i; min = max = MPFR_GET_EXP(tab[0]); for (i = 1; i < n; i++) { if (MPFR_GET_EXP(tab[i]) > max) max = MPFR_GET_EXP(tab[i]); if (MPFR_GET_EXP(tab[i]) < min) min = MPFR_GET_EXP(tab[i]); } res = max - min; res += f; res += __gmpfr_ceil_log2 (n) + 1; return res; }
static mpfr_prec_t get_prec_max (mpfr_t *t, int n) { mpfr_exp_t e, min, max; int i; min = MPFR_EMAX_MAX; max = MPFR_EMIN_MIN; for (i = 0; i < n; i++) if (MPFR_IS_PURE_FP (t[i])) { e = MPFR_GET_EXP (t[i]); if (e > max) max = e; e -= MPFR_GET_PREC (t[i]); if (e < min) min = e; } return min > max ? MPFR_PREC_MIN /* no pure FP values */ : max - min + __gmpfr_ceil_log2 (n); }
static mpfr_prec_t get_prec_max (mpfr_t *tab, unsigned long n, mpfr_prec_t f) { mpfr_prec_t res; mpfr_exp_t min, max; unsigned long i; for (i = 0; MPFR_IS_ZERO (tab[i]); i++) MPFR_ASSERTD (i < n); min = max = MPFR_GET_EXP(tab[i]); for (i++; i < n; i++) { if (!MPFR_IS_ZERO (tab[i])) { if (MPFR_GET_EXP(tab[i]) > max) max = MPFR_GET_EXP(tab[i]); if (MPFR_GET_EXP(tab[i]) < min) min = MPFR_GET_EXP(tab[i]); } } res = max - min; res += f; res += __gmpfr_ceil_log2 (n) + 1; return res; }
int mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mp_rnd_t rnd_mode) { int inexact = 0; mpfr_t x; mp_prec_t Nx = MPFR_PREC(xt); /* Precision of input variable */ /* Special cases */ if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(xt) )) { /* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result between -1 and 1 */ if (MPFR_IS_NAN(xt) || MPFR_IS_INF(xt)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } else /* necessarily xt is 0 */ { MPFR_ASSERTD(MPFR_IS_ZERO(xt)); MPFR_SET_ZERO(y); /* atanh(0) = 0 */ MPFR_SET_SAME_SIGN(y,xt); MPFR_RET(0); } } /* Useless due to final mpfr_set MPFR_CLEAR_FLAGS(y);*/ /* atanh(x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */ if (MPFR_EXP(xt) > 0) { if (MPFR_EXP(xt) == 1 && mpfr_powerof2_raw (xt)) { MPFR_SET_INF(y); MPFR_SET_SAME_SIGN(y, xt); MPFR_RET(0); } MPFR_SET_NAN(y); MPFR_RET_NAN; } mpfr_init2 (x, Nx); mpfr_abs (x, xt, GMP_RNDN); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, te,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+4+__gmpfr_ceil_log2(Nt); /* initialise of intermediary variable */ mpfr_init(t); mpfr_init(te); mpfr_init(ti); /* First computation of cosh */ do { /* reactualisation of the precision */ mpfr_set_prec(t,Nt); mpfr_set_prec(te,Nt); mpfr_set_prec(ti,Nt); /* compute atanh */ mpfr_ui_sub(te,1,x,GMP_RNDU); /* (1-xt)*/ mpfr_add_ui(ti,x,1,GMP_RNDD); /* (xt+1)*/ mpfr_div(te,ti,te,GMP_RNDN); /* (1+xt)/(1-xt)*/ mpfr_log(te,te,GMP_RNDN); /* ln((1+xt)/(1-xt))*/ mpfr_div_2ui(t,te,1,GMP_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/ /* error estimate see- algorithms.ps*/ /* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/ err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1); /* actualisation of the precision */ Nt += 10; } while ((err < 0) || (!mpfr_can_round (t, err, GMP_RNDN, GMP_RNDZ, Ny + (rnd_mode == GMP_RNDN)) || MPFR_IS_ZERO(t))); if (MPFR_IS_NEG(xt)) MPFR_CHANGE_SIGN(t); inexact = mpfr_set (y, t, rnd_mode); mpfr_clear(t); mpfr_clear(ti); mpfr_clear(te); } mpfr_clear(x); return inexact; }
int mpfr_zeta (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode) { mpfr_t z_pre, s1, y, p; double sd, eps, m1, c; long add; mp_prec_t precz, prec1, precs, precs1; int inex; MPFR_GROUP_DECL (group); MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("s[%#R]=%R rnd=%d", s, s, rnd_mode), ("z[%#R]=%R inexact=%d", z, z, inex)); /* Zero, Nan or Inf ? */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s))) { if (MPFR_IS_NAN (s)) { MPFR_SET_NAN (z); MPFR_RET_NAN; } else if (MPFR_IS_INF (s)) { if (MPFR_IS_POS (s)) return mpfr_set_ui (z, 1, GMP_RNDN); /* Zeta(+Inf) = 1 */ MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */ MPFR_RET_NAN; } else /* s iz zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (s)); mpfr_set_ui (z, 1, rnd_mode); mpfr_div_2ui (z, z, 1, rnd_mode); MPFR_CHANGE_SIGN (z); MPFR_RET (0); } } /* s is neither Nan, nor Inf, nor Zero */ /* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0, and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|. Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding (the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest). A sufficient condition is that EXP(s) + 1 < -PREC(z). */ if (MPFR_EXP(s) + 1 < - (mp_exp_t) MPFR_PREC(z)) { int signs = MPFR_SIGN(s); mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */ if ((rnd_mode == GMP_RNDU || rnd_mode == GMP_RNDZ) && signs < 0) { mpfr_nextabove (z); /* z = -1/2 + epsilon */ inex = 1; } else if (rnd_mode == GMP_RNDD && signs > 0) { mpfr_nextbelow (z); /* z = -1/2 - epsilon */ inex = -1; } else { if (rnd_mode == GMP_RNDU) /* s > 0: z = -1/2 */ inex = 1; else if (rnd_mode == GMP_RNDD) inex = -1; /* s < 0: z = -1/2 */ else /* (GMP_RNDZ and s > 0) or GMP_RNDN: z = -1/2 */ inex = (signs > 0) ? 1 : -1; } return mpfr_check_range (z, inex, rnd_mode); } /* Check for case s= -2n */ if (MPFR_IS_NEG (s)) { mpfr_t tmp; tmp[0] = *s; MPFR_EXP (tmp) = MPFR_EXP (s) - 1; if (mpfr_integer_p (tmp)) { MPFR_SET_ZERO (z); MPFR_SET_POS (z); MPFR_RET (0); } } MPFR_SAVE_EXPO_MARK (expo); /* Compute Zeta */ if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */ inex = mpfr_zeta_pos (z, s, rnd_mode); else /* use reflection formula zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */ { precz = MPFR_PREC (z); precs = MPFR_PREC (s); /* Precision precs1 needed to represent 1 - s, and s + 2, without any truncation */ precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s)); sd = mpfr_get_d (s, GMP_RNDN) - 1.0; if (sd < 0.0) sd = -sd; /* now sd = abs(s-1.0) */ /* Precision prec1 is the precision on elementary computations; it ensures a final precision prec1 - add for zeta(s) */ /* eps = pow (2.0, - (double) precz - 14.0); */ eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0); m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps); c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1)); /* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */ add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1)); prec1 = precz + add; prec1 = MAX (prec1, precs1) + 10; MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p); MPFR_ZIV_INIT (loop, prec1); for (;;) { mpfr_sub (s1, __gmpfr_one, s, GMP_RNDN);/* s1 = 1-s */ mpfr_zeta_pos (z_pre, s1, GMP_RNDN); /* zeta(1-s) */ mpfr_gamma (y, s1, GMP_RNDN); /* gamma(1-s) */ if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k, Zeta(s) > 0 for -4k < s < -4k+2 */ { MPFR_SET_INF (z_pre); mpfr_div_2ui (s1, s, 2, GMP_RNDN); /* s/4, exact */ mpfr_frac (s1, s1, GMP_RNDN); /* exact, -1 < s1 < 0 */ if (mpfr_cmp_si_2exp (s1, -1, -1) > 0) MPFR_SET_NEG (z_pre); else MPFR_SET_POS (z_pre); break; } mpfr_mul (z_pre, z_pre, y, GMP_RNDN); /* gamma(1-s)*zeta(1-s) */ mpfr_const_pi (p, GMP_RNDD); mpfr_mul (y, s, p, GMP_RNDN); mpfr_div_2ui (y, y, 1, GMP_RNDN); /* s*Pi/2 */ mpfr_sin (y, y, GMP_RNDN); /* sin(Pi*s/2) */ mpfr_mul (z_pre, z_pre, y, GMP_RNDN); mpfr_mul_2ui (y, p, 1, GMP_RNDN); /* 2*Pi */ mpfr_neg (s1, s1, GMP_RNDN); /* s-1 */ mpfr_pow (y, y, s1, GMP_RNDN); /* (2*Pi)^(s-1) */ mpfr_mul (z_pre, z_pre, y, GMP_RNDN); mpfr_mul_2ui (z_pre, z_pre, 1, GMP_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz, rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec1); MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p); } MPFR_ZIV_FREE (loop); inex = mpfr_set (z, z_pre, rnd_mode); MPFR_GROUP_CLEAR (group); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (z, inex, rnd_mode); }
int mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd) { int inex; mpfr_t tmp, ump; mp_exp_t err, te; mp_prec_t prec; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd), ("y[%#R]=%R inexact=%d", y, y, inex)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { /* exp(NaN) = exp(-Inf) = NaN */ if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x))) { MPFR_SET_NAN (y); MPFR_RET_NAN; } /* eint(+inf) = +inf */ else if (MPFR_IS_INF (x)) { MPFR_SET_INF(y); MPFR_SET_POS(y); MPFR_RET(0); } else /* eint(+/-0) = -Inf */ { MPFR_SET_INF(y); MPFR_SET_NEG(y); MPFR_RET(0); } } /* eint(x) = NaN for x < 0 */ if (MPFR_IS_NEG(x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } MPFR_SAVE_EXPO_MARK (expo); /* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2). Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax, then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */ mpfr_init2 (tmp, 64); mpfr_init2 (ump, 64); mpfr_log (tmp, x, GMP_RNDU); mpfr_sub (ump, x, tmp, GMP_RNDD); mpfr_const_log2 (tmp, GMP_RNDU); mpfr_div (ump, ump, tmp, GMP_RNDD); /* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */ MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX); if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0) { mpfr_clear (tmp); mpfr_clear (ump); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (y, rnd, 1); } /* Init stuff */ prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6; /* eint() has a root 0.37250741078136663446..., so if x is near, already take more bits */ if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */ { double d; d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663; d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d); prec += -d; } mpfr_set_prec (tmp, prec); mpfr_set_prec (ump, prec); MPFR_ZIV_INIT (loop, prec); /* Initialize the ZivLoop controler */ for (;;) /* Infinite loop */ { /* We need that the smallest value of k!/x^k is smaller than 2^(-p). The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x for x>=1. */ if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec + 0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0) err = mpfr_eint_asympt (tmp, x); else { err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */ te = MPFR_GET_EXP(tmp); mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */ mpfr_add (tmp, tmp, ump, GMP_RNDN); /* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err) <= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp)) <= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */ err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp); err = MAX(0, err); te = MPFR_GET_EXP(tmp); mpfr_log (ump, x, GMP_RNDN); mpfr_add (tmp, tmp, ump, GMP_RNDN); /* same formula as above, except now EXP(ump) is not 0 */ err += te + 1; if (MPFR_LIKELY (!MPFR_IS_ZERO (ump))) err = MAX (MPFR_GET_EXP (ump), err); err = MAX(0, err - MPFR_GET_EXP (tmp)); } if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd))) break; MPFR_ZIV_NEXT (loop, prec); /* Increase used precision */ mpfr_set_prec (tmp, prec); mpfr_set_prec (ump, prec); } MPFR_ZIV_FREE (loop); /* Free the ZivLoop Controler */ inex = mpfr_set (y, tmp, rnd); /* Set y to the computed value */ mpfr_clear (tmp); mpfr_clear (ump); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inex, rnd); }
/* evaluates erf(x) using the expansion at x=0: erf(x) = 2/sqrt(Pi) * sum((-1)^k*x^(2k+1)/k!/(2k+1), k=0..infinity) Assumes x is neither NaN nor infinite nor zero. Assumes also that e*x^2 <= n (target precision). */ static int mpfr_erf_0 (mpfr_ptr res, mpfr_srcptr x, double xf2, mpfr_rnd_t rnd_mode) { mpfr_prec_t n, m; mpfr_exp_t nuk, sigmak; double tauk; mpfr_t y, s, t, u; unsigned int k; int log2tauk; int inex; MPFR_GROUP_DECL (group); MPFR_ZIV_DECL (loop); n = MPFR_PREC (res); /* target precision */ /* initial working precision */ m = n + (mpfr_prec_t) (xf2 / LOG2) + 8 + MPFR_INT_CEIL_LOG2 (n); MPFR_GROUP_INIT_4(group, m, y, s, t, u); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_mul (y, x, x, MPFR_RNDU); /* err <= 1 ulp */ mpfr_set_ui (s, 1, MPFR_RNDN); mpfr_set_ui (t, 1, MPFR_RNDN); tauk = 0.0; for (k = 1; ; k++) { mpfr_mul (t, y, t, MPFR_RNDU); mpfr_div_ui (t, t, k, MPFR_RNDU); mpfr_div_ui (u, t, 2 * k + 1, MPFR_RNDU); sigmak = MPFR_GET_EXP (s); if (k % 2) mpfr_sub (s, s, u, MPFR_RNDN); else mpfr_add (s, s, u, MPFR_RNDN); sigmak -= MPFR_GET_EXP(s); nuk = MPFR_GET_EXP(u) - MPFR_GET_EXP(s); if ((nuk < - (mpfr_exp_t) m) && ((double) k >= xf2)) break; /* tauk <- 1/2 + tauk * 2^sigmak + (1+8k)*2^nuk */ tauk = 0.5 + mul_2exp (tauk, sigmak) + mul_2exp (1.0 + 8.0 * (double) k, nuk); } mpfr_mul (s, x, s, MPFR_RNDU); MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); mpfr_const_pi (t, MPFR_RNDZ); mpfr_sqrt (t, t, MPFR_RNDZ); mpfr_div (s, s, t, MPFR_RNDN); tauk = 4.0 * tauk + 11.0; /* final ulp-error on s */ log2tauk = __gmpfr_ceil_log2 (tauk); if (MPFR_LIKELY (MPFR_CAN_ROUND (s, m - log2tauk, n, rnd_mode))) break; /* Actualisation of the precision */ MPFR_ZIV_NEXT (loop, m); MPFR_GROUP_REPREC_4 (group, m, y, s, t, u); } MPFR_ZIV_FREE (loop); inex = mpfr_set (res, s, rnd_mode); MPFR_GROUP_CLEAR (group); return inex; }