long double mpfr_get_ld (mpfr_srcptr x, mpfr_rnd_t rnd_mode) { if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) return (long double) mpfr_get_d (x, rnd_mode); else /* now x is a normal non-zero number */ { long double r; /* result */ long double m; double s; /* part of result */ mpfr_exp_t sh; /* exponent shift, so that x/2^sh is in the double range */ mpfr_t y, z; int sign; /* first round x to the target long double precision, so that all subsequent operations are exact (this avoids double rounding problems) */ mpfr_init2 (y, MPFR_LDBL_MANT_DIG); mpfr_init2 (z, IEEE_DBL_MANT_DIG); mpfr_set (y, x, rnd_mode); sh = MPFR_GET_EXP (y); sign = MPFR_SIGN (y); MPFR_SET_EXP (y, 0); MPFR_SET_POS (y); r = 0.0; do { s = mpfr_get_d (y, MPFR_RNDN); /* high part of y */ r += (long double) s; mpfr_set_d (z, s, MPFR_RNDN); /* exact */ mpfr_sub (y, y, z, MPFR_RNDN); /* exact */ } while (!MPFR_IS_ZERO (y)); mpfr_clear (z); mpfr_clear (y); /* we now have to multiply back by 2^sh */ MPFR_ASSERTD (r > 0); if (sh != 0) { /* An overflow may occurs (example: 0.5*2^1024) */ while (r < 1.0) { r += r; sh--; } if (sh > 0) m = 2.0; else { m = 0.5; sh = -sh; } for (;;) { if (sh % 2) r = r * m; sh >>= 1; if (sh == 0) break; m = m * m; } } if (sign < 0) r = -r; return r; } }
/* Compute the alternating series s = S(z) = \sum_{k=0}^infty B_{2k} (z))^{2k+1} / (2k+1)! with 0 < z <= log(2) to the precision of s rounded in the direction rnd_mode. Return the maximum index of the truncature which is useful for determinating the relative error. */ static int li2_series (mpfr_t sum, mpfr_srcptr z, mpfr_rnd_t rnd_mode) { int i, Bm, Bmax; mpfr_t s, u, v, w; mpfr_prec_t sump, p; mp_exp_t se, err; mpz_t *B; MPFR_ZIV_DECL (loop); /* The series converges for |z| < 2 pi, but in mpfr_li2 the argument is reduced so that 0 < z <= log(2). Here is additionnal check that z is (nearly) correct */ MPFR_ASSERTD (MPFR_IS_STRICTPOS (z)); MPFR_ASSERTD (mpfr_cmp_d (z, 0.6953125) <= 0); sump = MPFR_PREC (sum); /* target precision */ p = sump + MPFR_INT_CEIL_LOG2 (sump) + 4; /* the working precision */ mpfr_init2 (s, p); mpfr_init2 (u, p); mpfr_init2 (v, p); mpfr_init2 (w, p); B = bernoulli ((mpz_t *) 0, 0); Bm = Bmax = 1; MPFR_ZIV_INIT (loop, p); for (;;) { mpfr_sqr (u, z, GMP_RNDU); mpfr_set (v, z, GMP_RNDU); mpfr_set (s, z, GMP_RNDU); se = MPFR_GET_EXP (s); err = 0; for (i = 1;; i++) { if (i >= Bmax) B = bernoulli (B, Bmax++); /* B_2i * (2i+1)!, exact */ mpfr_mul (v, u, v, GMP_RNDU); mpfr_div_ui (v, v, 2 * i, GMP_RNDU); mpfr_div_ui (v, v, 2 * i, GMP_RNDU); mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU); mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU); /* here, v_2i = v_{2i-2} / (2i * (2i+1))^2 */ mpfr_mul_z (w, v, B[i], GMP_RNDN); /* here, w_2i = v_2i * B_2i * (2i+1)! with error(w_2i) < 2^(5 * i + 8) ulp(w_2i) (see algorithms.tex) */ mpfr_add (s, s, w, GMP_RNDN); err = MAX (err + se, 5 * i + 8 + MPFR_GET_EXP (w)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); se = MPFR_GET_EXP (s); if (MPFR_GET_EXP (w) <= se - (mp_exp_t) p) break; } /* the previous value of err is the rounding error, the truncation error is less than EXP(z) - 6 * i - 5 (see algorithms.tex) */ err = MAX (err, MPFR_GET_EXP (z) - 6 * i - 5) + 1; if (MPFR_CAN_ROUND (s, (mp_exp_t) p - err, sump, rnd_mode)) break; MPFR_ZIV_NEXT (loop, p); mpfr_set_prec (s, p); mpfr_set_prec (u, p); mpfr_set_prec (v, p); mpfr_set_prec (w, p); } MPFR_ZIV_FREE (loop); mpfr_set (sum, s, rnd_mode); Bm = Bmax; while (Bm--) mpz_clear (B[Bm]); (*__gmp_free_func) (B, Bmax * sizeof (mpz_t)); mpfr_clears (s, u, v, w, (mpfr_ptr) 0); /* Let K be the returned value. 1. As we compute an alternating series, the truncation error has the same sign as the next term w_{K+2} which is positive iff K%4 == 0. 2. Assume that error(z) <= (1+t) z', where z' is the actual value, then error(s) <= 2 * (K+1) * t (see algorithms.tex). */ return 2 * i; }
int mpfr_round_raw_generic( #if flag == 0 mp_limb_t *yp, #endif const mp_limb_t *xp, mpfr_prec_t xprec, int neg, mpfr_prec_t yprec, mpfr_rnd_t rnd_mode #if use_inexp != 0 , int *inexp #endif ) { mp_size_t xsize, nw; mp_limb_t himask, lomask, sb; int rw; #if flag == 0 int carry; #endif #if use_inexp == 0 int *inexp; #endif if (use_inexp) MPFR_ASSERTD(inexp != ((int*) 0)); MPFR_ASSERTD(neg == 0 || neg == 1); if (flag && !use_inexp && (xprec <= yprec || MPFR_IS_LIKE_RNDZ (rnd_mode, neg))) return 0; xsize = (xprec-1)/GMP_NUMB_BITS + 1; nw = yprec / GMP_NUMB_BITS; rw = yprec & (GMP_NUMB_BITS - 1); if (MPFR_UNLIKELY(xprec <= yprec)) { /* No rounding is necessary. */ /* if yp=xp, maybe an overlap: MPN_COPY_DECR is ok when src <= dst */ if (MPFR_LIKELY(rw)) nw++; MPFR_ASSERTD(nw >= 1); MPFR_ASSERTD(nw >= xsize); if (use_inexp) *inexp = 0; #if flag == 0 MPN_COPY_DECR(yp + (nw - xsize), xp, xsize); MPN_ZERO(yp, nw - xsize); #endif return 0; } if (use_inexp || !MPFR_IS_LIKE_RNDZ(rnd_mode, neg)) { mp_size_t k = xsize - nw - 1; if (MPFR_LIKELY(rw)) { nw++; lomask = MPFR_LIMB_MASK (GMP_NUMB_BITS - rw); himask = ~lomask; } else { lomask = ~(mp_limb_t) 0; himask = ~(mp_limb_t) 0; } MPFR_ASSERTD(k >= 0); sb = xp[k] & lomask; /* First non-significant bits */ /* Rounding to nearest ? */ if (MPFR_LIKELY( rnd_mode == MPFR_RNDN) ) { /* Rounding to nearest */ mp_limb_t rbmask = MPFR_LIMB_ONE << (GMP_NUMB_BITS - 1 - rw); if (sb & rbmask) /* rounding bit */ sb &= ~rbmask; /* it is 1, clear it */ else { /* Rounding bit is 0, behave like rounding to 0 */ goto rnd_RNDZ; } while (MPFR_UNLIKELY(sb == 0) && k > 0) sb = xp[--k]; /* rounding to nearest, with rounding bit = 1 */ if (MPFR_UNLIKELY(sb == 0)) /* Even rounding. */ { /* sb == 0 && rnd_mode == MPFR_RNDN */ sb = xp[xsize - nw] & (himask ^ (himask << 1)); if (sb == 0) { if (use_inexp) *inexp = 2*MPFR_EVEN_INEX*neg-MPFR_EVEN_INEX; /* ((neg!=0)^(sb!=0)) ? MPFR_EVEN_INEX : -MPFR_EVEN_INEX;*/ /* Since neg = 0 or 1 and sb=0*/ #if flag == 1 return 0 /*sb != 0 && rnd_mode != MPFR_RNDZ */; #else MPN_COPY_INCR(yp, xp + xsize - nw, nw); yp[0] &= himask; return 0; #endif } else { /* sb != 0 && rnd_mode == MPFR_RNDN */ if (use_inexp) *inexp = MPFR_EVEN_INEX-2*MPFR_EVEN_INEX*neg; /*((neg!=0)^(sb!=0))? MPFR_EVEN_INEX : -MPFR_EVEN_INEX; */ /*Since neg= 0 or 1 and sb != 0 */ goto rnd_RNDN_add_one_ulp; } } else /* sb != 0 && rnd_mode == MPFR_RNDN*/ { if (use_inexp) /* *inexp = (neg == 0) ? 1 : -1; but since neg = 0 or 1 */ *inexp = 1-2*neg; rnd_RNDN_add_one_ulp: #if flag == 1 return 1; /*sb != 0 && rnd_mode != MPFR_RNDZ;*/ #else carry = mpn_add_1 (yp, xp + xsize - nw, nw, rw ? MPFR_LIMB_ONE << (GMP_NUMB_BITS - rw) : MPFR_LIMB_ONE); yp[0] &= himask; return carry; #endif } } /* Rounding to Zero ? */ else if (MPFR_IS_LIKE_RNDZ(rnd_mode, neg)) { /* rnd_mode == MPFR_RNDZ */ rnd_RNDZ: while (MPFR_UNLIKELY(sb == 0) && k > 0) sb = xp[--k]; if (use_inexp) /* rnd_mode == MPFR_RNDZ and neg = 0 or 1 */ /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/ *inexp = MPFR_UNLIKELY(sb == 0) ? 0 : (2*neg-1); #if flag == 1 return 0; /*sb != 0 && rnd_mode != MPFR_RNDZ;*/ #else MPN_COPY_INCR(yp, xp + xsize - nw, nw); yp[0] &= himask; return 0; #endif } else { /* rnd_mode = Away */ while (MPFR_UNLIKELY(sb == 0) && k > 0) sb = xp[--k]; if (MPFR_UNLIKELY(sb == 0)) { /* sb = 0 && rnd_mode != MPFR_RNDZ */ if (use_inexp) /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/ *inexp = 0; #if flag == 1 return 0; #else MPN_COPY_INCR(yp, xp + xsize - nw, nw); yp[0] &= himask; return 0; #endif } else { /* sb != 0 && rnd_mode != MPFR_RNDZ */ if (use_inexp) /* (neg != 0) ^ (rnd_mode != MPFR_RNDZ)) ? 1 : -1);*/ *inexp = 1-2*neg; #if flag == 1 return 1; #else carry = mpn_add_1(yp, xp + xsize - nw, nw, rw ? MPFR_LIMB_ONE << (GMP_NUMB_BITS - rw) : 1); yp[0] &= himask; return carry; #endif } } } else { /* Roundind mode = Zero / No inexact flag */ #if flag == 1 return 0 /*sb != 0 && rnd_mode != MPFR_RNDZ*/; #else if (MPFR_LIKELY(rw)) { nw++; himask = ~MPFR_LIMB_MASK (GMP_NUMB_BITS - rw); } else himask = ~(mp_limb_t) 0; MPN_COPY_INCR(yp, xp + xsize - nw, nw); yp[0] &= himask; return 0; #endif } }
int mpfr_cmp2 (mpfr_srcptr b, mpfr_srcptr c, mpfr_prec_t *cancel) { mp_limb_t *bp, *cp, bb, cc = 0, lastc = 0, dif, high_dif = 0; mp_size_t bn, cn; mpfr_uexp_t diff_exp; mpfr_prec_t res = 0; int sign; /* b=c should not happen, since cmp2 is called only from agm (with different variables), and from sub1 (if same b=c, then sub1sp would be called instead */ MPFR_ASSERTD (b != c); /* the cases b=0 or c=0 are also treated apart in agm and sub (which calls sub1) */ MPFR_ASSERTD (MPFR_IS_PURE_FP(b)); MPFR_ASSERTD (MPFR_IS_PURE_FP(c)); if (MPFR_GET_EXP (b) >= MPFR_GET_EXP (c)) { sign = 1; diff_exp = (mpfr_uexp_t) MPFR_GET_EXP (b) - MPFR_GET_EXP (c); bp = MPFR_MANT(b); cp = MPFR_MANT(c); bn = (MPFR_PREC(b) - 1) / GMP_NUMB_BITS; cn = (MPFR_PREC(c) - 1) / GMP_NUMB_BITS; /* # of limbs of c minus 1 */ if (MPFR_UNLIKELY( diff_exp == 0 )) { while (bn >= 0 && cn >= 0 && bp[bn] == cp[cn]) { bn--; cn--; res += GMP_NUMB_BITS; } if (MPFR_UNLIKELY (bn < 0)) { if (MPFR_LIKELY (cn < 0)) /* b = c */ return 0; bp = cp; bn = cn; cn = -1; sign = -1; } if (MPFR_UNLIKELY (cn < 0)) /* c discards exactly the upper part of b */ { unsigned int z; MPFR_ASSERTD (bn >= 0); while (bp[bn] == 0) { if (--bn < 0) /* b = c */ return 0; res += GMP_NUMB_BITS; } count_leading_zeros(z, bp[bn]); /* bp[bn] <> 0 */ *cancel = res + z; return sign; } MPFR_ASSERTD (bn >= 0); MPFR_ASSERTD (cn >= 0); MPFR_ASSERTD (bp[bn] != cp[cn]); if (bp[bn] < cp[cn]) { mp_limb_t *tp; mp_size_t tn; tp = bp; bp = cp; cp = tp; tn = bn; bn = cn; cn = tn; sign = -1; } } } /* MPFR_EXP(b) >= MPFR_EXP(c) */ else /* MPFR_EXP(b) < MPFR_EXP(c) */ { sign = -1; diff_exp = (mpfr_uexp_t) MPFR_GET_EXP (c) - MPFR_GET_EXP (b); bp = MPFR_MANT(c); cp = MPFR_MANT(b); bn = (MPFR_PREC(c) - 1) / GMP_NUMB_BITS; cn = (MPFR_PREC(b) - 1) / GMP_NUMB_BITS; } /* now we have removed the identical upper limbs of b and c (can happen only when diff_exp = 0), and after the possible swap, we have |b| > |c|: bp[bn] > cc, bn >= 0, cn >= 0, diff_exp = EXP(b) - EXP(c). */ if (MPFR_LIKELY (diff_exp < GMP_NUMB_BITS)) { cc = cp[cn] >> diff_exp; /* warning: a shift by GMP_NUMB_BITS may give wrong results */ if (diff_exp) lastc = cp[cn] << (GMP_NUMB_BITS - diff_exp); cn--; }
/* Compute the real part of the dilogarithm defined by Li2(x) = -\Int_{t=0}^x log(1-t)/t dt */ int mpfr_li2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { int inexact; mp_exp_t err; mpfr_prec_t yp, m; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode), ("y[%#R]=%R", y)); 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_NEG (y); MPFR_SET_INF (y); MPFR_RET (0); } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_SAME_SIGN (y, x); MPFR_SET_ZERO (y); MPFR_RET (0); } } /* Li2(x) = x + x^2/4 + x^3/9 + ..., more precisely for 0 < x <= 1/2 we have |Li2(x) - x| < x^2/2 <= 2^(2EXP(x)-1) and for -1/2 <= x < 0 we have |Li2(x) - x| < x^2/4 <= 2^(2EXP(x)-2) */ if (MPFR_IS_POS (x)) MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 1, 1, rnd_mode, {}); else MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 2, 0, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); yp = MPFR_PREC (y); m = yp + MPFR_INT_CEIL_LOG2 (yp) + 13; if (MPFR_LIKELY ((mpfr_cmp_ui (x, 0) > 0) && (mpfr_cmp_d (x, 0.5) <= 0))) /* 0 < x <= 1/2: Li2(x) = S(-log(1-x))-log^2(1-x)/4 */ { mpfr_t s, u; mp_exp_t expo_l; int k; mpfr_init2 (u, m); mpfr_init2 (s, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_ui_sub (u, 1, x, GMP_RNDN); mpfr_log (u, u, GMP_RNDU); if (MPFR_IS_ZERO(u)) goto next_m; mpfr_neg (u, u, GMP_RNDN); /* u = -log(1-x) */ expo_l = MPFR_GET_EXP (u); k = li2_series (s, u, GMP_RNDU); err = 1 + MPFR_INT_CEIL_LOG2 (k + 1); mpfr_sqr (u, u, GMP_RNDU); mpfr_div_2ui (u, u, 2, GMP_RNDU); /* u = log^2(1-x) / 4 */ mpfr_sub (s, s, u, GMP_RNDN); /* error(s) <= (0.5 + 2^(d-EXP(s)) + 2^(3 + MAX(1, - expo_l) - EXP(s))) ulp(s) */ err = MAX (err, MAX (1, - expo_l) - 1) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; next_m: MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (u, m); mpfr_set_prec (s, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clear (u); mpfr_clear (s); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else if (!mpfr_cmp_ui (x, 1)) /* Li2(1)= pi^2 / 6 */ { mpfr_t u; mpfr_init2 (u, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_const_pi (u, GMP_RNDU); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_ui (u, u, 6, GMP_RNDN); err = m - 4; /* error(u) <= 19/2 ulp(u) */ if (MPFR_CAN_ROUND (u, err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (u, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, u, rnd_mode); mpfr_clear (u); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else if (mpfr_cmp_ui (x, 2) >= 0) /* x >= 2: Li2(x) = -S(-log(1-1/x))-log^2(x)/2+log^2(1-1/x)/4+pi^2/3 */ { int k; mp_exp_t expo_l; mpfr_t s, u, xx; if (mpfr_cmp_ui (x, 38) >= 0) { inexact = mpfr_li2_asympt_pos (y, x, rnd_mode); if (inexact != 0) goto end_of_case_gt2; } mpfr_init2 (u, m); mpfr_init2 (s, m); mpfr_init2 (xx, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_ui_div (xx, 1, x, GMP_RNDN); mpfr_neg (xx, xx, GMP_RNDN); mpfr_log1p (u, xx, GMP_RNDD); mpfr_neg (u, u, GMP_RNDU); /* u = -log(1-1/x) */ expo_l = MPFR_GET_EXP (u); k = li2_series (s, u, GMP_RNDN); mpfr_neg (s, s, GMP_RNDN); err = MPFR_INT_CEIL_LOG2 (k + 1) + 1; /* error(s) <= 2^err ulp(s) */ mpfr_sqr (u, u, GMP_RNDN); mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u= log^2(1-1/x)/4 */ mpfr_add (s, s, u, GMP_RNDN); err = MAX (err, 3 + MAX (1, -expo_l) + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */ err += MPFR_GET_EXP (s); mpfr_log (u, x, GMP_RNDU); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_2ui (u, u, 1, GMP_RNDN); /* u = log^2(x)/2 */ mpfr_sub (s, s, u, GMP_RNDN); err = MAX (err, 3 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */ err += MPFR_GET_EXP (s); mpfr_const_pi (u, GMP_RNDU); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_ui (u, u, 3, GMP_RNDN); /* u = pi^2/3 */ mpfr_add (s, s, u, GMP_RNDN); err = MAX (err, 2) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */ if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (u, m); mpfr_set_prec (s, m); mpfr_set_prec (xx, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clears (s, u, xx, (mpfr_ptr) 0); end_of_case_gt2: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else if (mpfr_cmp_ui (x, 1) > 0) /* 2 > x > 1: Li2(x) = S(log(x))+log^2(x)/4-log(x)log(x-1)+pi^2/6 */ { int k; mp_exp_t e1, e2; mpfr_t s, u, v, xx; mpfr_init2 (s, m); mpfr_init2 (u, m); mpfr_init2 (v, m); mpfr_init2 (xx, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_log (v, x, GMP_RNDU); k = li2_series (s, v, GMP_RNDN); e1 = MPFR_GET_EXP (s); mpfr_sqr (u, v, GMP_RNDN); mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(x)/4 */ mpfr_add (s, s, u, GMP_RNDN); mpfr_sub_ui (xx, x, 1, GMP_RNDN); mpfr_log (u, xx, GMP_RNDU); e2 = MPFR_GET_EXP (u); mpfr_mul (u, v, u, GMP_RNDN); /* u = log(x) * log(x-1) */ mpfr_sub (s, s, u, GMP_RNDN); mpfr_const_pi (u, GMP_RNDU); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_ui (u, u, 6, GMP_RNDN); /* u = pi^2/6 */ mpfr_add (s, s, u, GMP_RNDN); /* error(s) <= (31 + (k+1) * 2^(1-e1) + 2^(1-e2)) ulp(s) see algorithms.tex */ err = MAX (MPFR_INT_CEIL_LOG2 (k + 1) + 1 - e1, 1 - e2); err = 2 + MAX (5, err); if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (s, m); mpfr_set_prec (u, m); mpfr_set_prec (v, m); mpfr_set_prec (xx, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clears (s, u, v, xx, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else if (mpfr_cmp_ui_2exp (x, 1, -1) > 0) /* 1/2 < x < 1 */ /* 1 > x > 1/2: Li2(x) = -S(-log(x))+log^2(x)/4-log(x)log(1-x)+pi^2/6 */ { int k; mpfr_t s, u, v, xx; mpfr_init2 (s, m); mpfr_init2 (u, m); mpfr_init2 (v, m); mpfr_init2 (xx, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_log (u, x, GMP_RNDD); mpfr_neg (u, u, GMP_RNDN); k = li2_series (s, u, GMP_RNDN); mpfr_neg (s, s, GMP_RNDN); err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s); mpfr_ui_sub (xx, 1, x, GMP_RNDN); mpfr_log (v, xx, GMP_RNDU); mpfr_mul (v, v, u, GMP_RNDN); /* v = - log(x) * log(1-x) */ mpfr_add (s, s, v, GMP_RNDN); err = MAX (err, 1 - MPFR_GET_EXP (v)); err = 2 + MAX (3, err) - MPFR_GET_EXP (s); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(x)/4 */ mpfr_add (s, s, u, GMP_RNDN); err = MAX (err, 2 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err) + MPFR_GET_EXP (s); mpfr_const_pi (u, GMP_RNDU); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_ui (u, u, 6, GMP_RNDN); /* u = pi^2/6 */ mpfr_add (s, s, u, GMP_RNDN); err = MAX (err, 3) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err); if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (s, m); mpfr_set_prec (u, m); mpfr_set_prec (v, m); mpfr_set_prec (xx, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clears (s, u, v, xx, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else if (mpfr_cmp_si (x, -1) >= 0) /* 0 > x >= -1: Li2(x) = -S(log(1-x))-log^2(1-x)/4 */ { int k; mp_exp_t expo_l; mpfr_t s, u, xx; mpfr_init2 (s, m); mpfr_init2 (u, m); mpfr_init2 (xx, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_neg (xx, x, GMP_RNDN); mpfr_log1p (u, xx, GMP_RNDN); k = li2_series (s, u, GMP_RNDN); mpfr_neg (s, s, GMP_RNDN); expo_l = MPFR_GET_EXP (u); err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s); mpfr_sqr (u, u, GMP_RNDN); mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(1-x)/4 */ mpfr_sub (s, s, u, GMP_RNDN); err = MAX (err, - expo_l); err = 2 + MAX (err, 3); if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (s, m); mpfr_set_prec (u, m); mpfr_set_prec (xx, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clears (s, u, xx, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } else /* x < -1: Li2(x) = S(log(1-1/x))-log^2(-x)/4-log(1-x)log(-x)/2+log^2(1-x)/4-pi^2/6 */ { int k; mpfr_t s, u, v, w, xx; if (mpfr_cmp_si (x, -7) <= 0) { inexact = mpfr_li2_asympt_neg (y, x, rnd_mode); if (inexact != 0) goto end_of_case_ltm1; } mpfr_init2 (s, m); mpfr_init2 (u, m); mpfr_init2 (v, m); mpfr_init2 (w, m); mpfr_init2 (xx, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_ui_div (xx, 1, x, GMP_RNDN); mpfr_neg (xx, xx, GMP_RNDN); mpfr_log1p (u, xx, GMP_RNDN); k = li2_series (s, u, GMP_RNDN); mpfr_ui_sub (xx, 1, x, GMP_RNDN); mpfr_log (u, xx, GMP_RNDU); mpfr_neg (xx, x, GMP_RNDN); mpfr_log (v, xx, GMP_RNDU); mpfr_mul (w, v, u, GMP_RNDN); mpfr_div_2ui (w, w, 1, GMP_RNDN); /* w = log(-x) * log(1-x) / 2 */ mpfr_sub (s, s, w, GMP_RNDN); err = 1 + MAX (3, MPFR_INT_CEIL_LOG2 (k+1) + 1 - MPFR_GET_EXP (s)) + MPFR_GET_EXP (s); mpfr_sqr (w, v, GMP_RNDN); mpfr_div_2ui (w, w, 2, GMP_RNDN); /* w = log^2(-x) / 4 */ mpfr_sub (s, s, w, GMP_RNDN); err = MAX (err, 3 + MPFR_GET_EXP(w)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err) + MPFR_GET_EXP (s); mpfr_sqr (w, u, GMP_RNDN); mpfr_div_2ui (w, w, 2, GMP_RNDN); /* w = log^2(1-x) / 4 */ mpfr_add (s, s, w, GMP_RNDN); err = MAX (err, 3 + MPFR_GET_EXP (w)) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err) + MPFR_GET_EXP (s); mpfr_const_pi (w, GMP_RNDU); mpfr_sqr (w, w, GMP_RNDN); mpfr_div_ui (w, w, 6, GMP_RNDN); /* w = pi^2 / 6 */ mpfr_sub (s, s, w, GMP_RNDN); err = MAX (err, 3) - MPFR_GET_EXP (s); err = 2 + MAX (-1, err) + MPFR_GET_EXP (s); if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode)) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (s, m); mpfr_set_prec (u, m); mpfr_set_prec (v, m); mpfr_set_prec (w, m); mpfr_set_prec (xx, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); mpfr_clears (s, u, v, w, xx, (mpfr_ptr) 0); end_of_case_ltm1: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); } MPFR_ASSERTN (0); /* should never reach this point */ }
/* Since MPFR-3.0, return the usual inexact value. The erange flag is set if an error occurred in the conversion (y is NaN, +Inf, or -Inf that have no equivalent in mpf) */ int mpfr_get_f (mpf_ptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode) { int inex; mp_size_t sx, sy; mpfr_prec_t precx, precy; mp_limb_t *xp; int sh; if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(y))) { if (MPFR_IS_ZERO(y)) { mpf_set_ui (x, 0); return 0; } else if (MPFR_IS_NAN (y)) { MPFR_SET_ERANGE (); return 0; } else /* y is plus infinity (resp. minus infinity), set x to the maximum value (resp. the minimum value) in precision PREC(x) */ { int i; mp_limb_t *xp; MPFR_SET_ERANGE (); /* To this day, [mp_exp_t] and mp_size_t are #defined as the same type */ EXP (x) = MP_SIZE_T_MAX; sx = PREC (x); SIZ (x) = sx; xp = PTR (x); for (i = 0; i < sx; i++) xp[i] = MP_LIMB_T_MAX; if (MPFR_IS_POS (y)) return -1; else { mpf_neg (x, x); return +1; } } } sx = PREC(x); /* number of limbs of the mantissa of x */ precy = MPFR_PREC(y); precx = (mpfr_prec_t) sx * GMP_NUMB_BITS; sy = MPFR_LIMB_SIZE (y); xp = PTR (x); /* since mpf numbers are represented in base 2^GMP_NUMB_BITS, we loose -EXP(y) % GMP_NUMB_BITS bits in the most significant limb */ sh = MPFR_GET_EXP(y) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (precy + sh <= precx) /* we can copy directly */ { mp_size_t ds; MPFR_ASSERTN (sx >= sy); ds = sx - sy; if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp + ds, MPFR_MANT(y), sy, sh); MPFR_ASSERTN (ds > 0 || out == 0); if (ds > 0) xp[--ds] = out; } else MPN_COPY (xp + ds, MPFR_MANT (y), sy); if (ds > 0) MPN_ZERO (xp, ds); EXP(x) = (MPFR_GET_EXP(y) + sh) / GMP_NUMB_BITS; inex = 0; } else /* we have to round to precx - sh bits */ { mpfr_t z; mp_size_t sz; /* Recall that precx = (mpfr_prec_t) sx * GMP_NUMB_BITS, thus removing sh bits (sh < GMP_NUMB_BITSS) won't reduce the number of limbs. */ mpfr_init2 (z, precx - sh); sz = MPFR_LIMB_SIZE (z); MPFR_ASSERTN (sx == sz); inex = mpfr_set (z, y, rnd_mode); /* warning, sh may change due to rounding, but then z is a power of two, thus we can safely ignore its last bit which is 0 */ sh = MPFR_GET_EXP(z) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp, MPFR_MANT(z), sz, sh); /* If sh hasn't changed, it is the number of the non-significant bits in the lowest limb of z. Therefore out == 0. */ MPFR_ASSERTD (out == 0); (void) out; /* avoid a warning */ } else MPN_COPY (xp, MPFR_MANT(z), sz); EXP(x) = (MPFR_GET_EXP(z) + sh) / GMP_NUMB_BITS; mpfr_clear (z); } /* set size and sign */ SIZ(x) = (MPFR_FROM_SIGN_TO_INT(MPFR_SIGN(y)) < 0) ? -sx : sx; return inex; }
int mpfr_rint (mpfr_ptr r, mpfr_srcptr u, mpfr_rnd_t rnd_mode) { int sign; int rnd_away; mpfr_exp_t exp; if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(u) )) { if (MPFR_IS_NAN(u)) { MPFR_SET_NAN(r); MPFR_RET_NAN; } MPFR_SET_SAME_SIGN(r, u); if (MPFR_IS_INF(u)) { MPFR_SET_INF(r); MPFR_RET(0); /* infinity is exact */ } else /* now u is zero */ { MPFR_ASSERTD(MPFR_IS_ZERO(u)); MPFR_SET_ZERO(r); MPFR_RET(0); /* zero is exact */ } } MPFR_SET_SAME_SIGN (r, u); /* Does nothing if r==u */ sign = MPFR_INT_SIGN (u); exp = MPFR_GET_EXP (u); rnd_away = rnd_mode == MPFR_RNDD ? sign < 0 : rnd_mode == MPFR_RNDU ? sign > 0 : rnd_mode == MPFR_RNDZ ? 0 : rnd_mode == MPFR_RNDA ? 1 : -1; /* round to nearest-even (RNDN) or nearest-away (RNDNA) */ /* rnd_away: 1 if round away from zero, 0 if round to zero, -1 if not decided yet. */ if (MPFR_UNLIKELY (exp <= 0)) /* 0 < |u| < 1 ==> round |u| to 0 or 1 */ { /* Note: in the MPFR_RNDN mode, 0.5 must be rounded to 0. */ if (rnd_away != 0 && (rnd_away > 0 || (exp == 0 && (rnd_mode == MPFR_RNDNA || !mpfr_powerof2_raw (u))))) { mp_limb_t *rp; mp_size_t rm; rp = MPFR_MANT(r); rm = (MPFR_PREC(r) - 1) / GMP_NUMB_BITS; rp[rm] = MPFR_LIMB_HIGHBIT; MPN_ZERO(rp, rm); MPFR_SET_EXP (r, 1); /* |r| = 1 */ MPFR_RET(sign > 0 ? 2 : -2); } else { MPFR_SET_ZERO(r); /* r = 0 */ MPFR_RET(sign > 0 ? -2 : 2); } } else /* exp > 0, |u| >= 1 */ { mp_limb_t *up, *rp; mp_size_t un, rn, ui; int sh, idiff; int uflags; /* * uflags will contain: * _ 0 if u is an integer representable in r, * _ 1 if u is an integer not representable in r, * _ 2 if u is not an integer. */ up = MPFR_MANT(u); rp = MPFR_MANT(r); un = MPFR_LIMB_SIZE(u); rn = MPFR_LIMB_SIZE(r); MPFR_UNSIGNED_MINUS_MODULO (sh, MPFR_PREC (r)); MPFR_SET_EXP (r, exp); /* Does nothing if r==u */ if ((exp - 1) / GMP_NUMB_BITS >= un) { ui = un; idiff = 0; uflags = 0; /* u is an integer, representable or not in r */ } else { mp_size_t uj; ui = (exp - 1) / GMP_NUMB_BITS + 1; /* #limbs of the int part */ MPFR_ASSERTD (un >= ui); uj = un - ui; /* lowest limb of the integer part */ idiff = exp % GMP_NUMB_BITS; /* #int-part bits in up[uj] or 0 */ uflags = idiff == 0 || (up[uj] << idiff) == 0 ? 0 : 2; if (uflags == 0) while (uj > 0) if (up[--uj] != 0) { uflags = 2; break; } } if (ui > rn) { /* More limbs in the integer part of u than in r. Just round u with the precision of r. */ MPFR_ASSERTD (rp != up && un > rn); MPN_COPY (rp, up + (un - rn), rn); /* r != u */ if (rnd_away < 0) { /* This is a rounding to nearest mode (MPFR_RNDN or MPFR_RNDNA). Decide the rounding direction here. */ if (rnd_mode == MPFR_RNDN && (rp[0] & (MPFR_LIMB_ONE << sh)) == 0) { /* halfway cases rounded toward zero */ mp_limb_t a, b; /* a: rounding bit and some of the following bits */ /* b: boundary for a (weight of the rounding bit in a) */ if (sh != 0) { a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1); b = MPFR_LIMB_ONE << (sh - 1); } else { a = up[un - rn - 1]; b = MPFR_LIMB_HIGHBIT; } rnd_away = a > b; if (a == b) { mp_size_t i; for (i = un - rn - 1 - (sh == 0); i >= 0; i--) if (up[i] != 0) { rnd_away = 1; break; } } } else /* halfway cases rounded away from zero */ rnd_away = /* rounding bit */ ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) || (sh == 0 && (up[un - rn - 1] & MPFR_LIMB_HIGHBIT) != 0)); } if (uflags == 0) { /* u is an integer; determine if it is representable in r */ if (sh != 0 && rp[0] << (GMP_NUMB_BITS - sh) != 0) uflags = 1; /* u is not representable in r */ else { mp_size_t i; for (i = un - rn - 1; i >= 0; i--) if (up[i] != 0) { uflags = 1; /* u is not representable in r */ break; } } } } else /* ui <= rn */ { mp_size_t uj, rj; int ush; uj = un - ui; /* lowest limb of the integer part in u */ rj = rn - ui; /* lowest limb of the integer part in r */ if (MPFR_LIKELY (rp != up)) MPN_COPY(rp + rj, up + uj, ui); /* Ignore the lowest rj limbs, all equal to zero. */ rp += rj; rn = ui; /* number of fractional bits in whole rp[0] */ ush = idiff == 0 ? 0 : GMP_NUMB_BITS - idiff; if (rj == 0 && ush < sh) { /* If u is an integer (uflags == 0), we need to determine if it is representable in r, i.e. if its sh - ush bits in the non-significant part of r are all 0. */ if (uflags == 0 && (rp[0] & ((MPFR_LIMB_ONE << sh) - (MPFR_LIMB_ONE << ush))) != 0) uflags = 1; /* u is an integer not representable in r */ } else /* The integer part of u fits in r, we'll round to it. */ sh = ush; if (rnd_away < 0) { /* This is a rounding to nearest mode. Decide the rounding direction here. */ if (uj == 0 && sh == 0) rnd_away = 0; /* rounding bit = 0 (not represented in u) */ else if (rnd_mode == MPFR_RNDN && (rp[0] & (MPFR_LIMB_ONE << sh)) == 0) { /* halfway cases rounded toward zero */ mp_limb_t a, b; /* a: rounding bit and some of the following bits */ /* b: boundary for a (weight of the rounding bit in a) */ if (sh != 0) { a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1); b = MPFR_LIMB_ONE << (sh - 1); } else { MPFR_ASSERTD (uj >= 1); /* see above */ a = up[uj - 1]; b = MPFR_LIMB_HIGHBIT; } rnd_away = a > b; if (a == b) { mp_size_t i; for (i = uj - 1 - (sh == 0); i >= 0; i--) if (up[i] != 0) { rnd_away = 1; break; } } } else /* halfway cases rounded away from zero */ rnd_away = /* rounding bit */ ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) || (sh == 0 && (MPFR_ASSERTD (uj >= 1), up[uj - 1] & MPFR_LIMB_HIGHBIT) != 0)); } /* Now we can make the low rj limbs to 0 */ MPN_ZERO (rp-rj, rj); } if (sh != 0) rp[0] &= MP_LIMB_T_MAX << sh; /* If u is a representable integer, there is no rounding. */ if (uflags == 0) MPFR_RET(0); MPFR_ASSERTD (rnd_away >= 0); /* rounding direction is defined */ if (rnd_away && mpn_add_1(rp, rp, rn, MPFR_LIMB_ONE << sh)) { if (exp == __gmpfr_emax) return mpfr_overflow(r, rnd_mode, MPFR_SIGN(r)) >= 0 ? uflags : -uflags; else { MPFR_SET_EXP(r, exp + 1); rp[rn-1] = MPFR_LIMB_HIGHBIT; } } MPFR_RET (rnd_away ^ (sign < 0) ? uflags : -uflags); } /* exp > 0, |u| >= 1 */ }
int mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode) { int inexact; mpfr_t x, t, te; mpfr_prec_t Nx, Ny, Nt; mpfr_exp_t err; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); /* Special 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); } } /* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */ if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0)) { if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt)) { MPFR_SET_INF (y); MPFR_SET_SAME_SIGN (y, xt); MPFR_SET_DIVBY0 (); MPFR_RET (0); } MPFR_SET_NAN (y); MPFR_RET_NAN; } /* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); /* Compute initial precision */ Nx = MPFR_PREC (xt); MPFR_TMP_INIT_ABS (x, xt); Ny = MPFR_PREC (y); Nt = MAX (Nx, Ny); /* the optimal number of bits : see algorithms.ps */ Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4; /* initialize of intermediary variable */ mpfr_init2 (t, Nt); mpfr_init2 (te, Nt); /* First computation of cosh */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute atanh */ mpfr_ui_sub (te, 1, x, MPFR_RNDU); /* (1-xt)*/ mpfr_add_ui (t, x, 1, MPFR_RNDD); /* (xt+1)*/ mpfr_div (t, t, te, MPFR_RNDN); /* (1+xt)/(1-xt)*/ mpfr_log (t, t, MPFR_RNDN); /* ln((1+xt)/(1-xt))*/ mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/ /* error estimate: see algorithms.tex */ /* FIXME: this does not correspond to the value in algorithms.tex!!! */ /* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/ err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1); if (MPFR_LIKELY (MPFR_IS_ZERO (t) || MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* reactualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); mpfr_set_prec (te, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt)); mpfr_clear(t); mpfr_clear(te); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
/* set f to the rational q */ int mpfr_set_q (mpfr_ptr f, mpq_srcptr q, mpfr_rnd_t rnd) { mpz_srcptr num, den; mpfr_t n, d; int inexact; int cn, cd; long shift; mp_size_t sn, sd; MPFR_SAVE_EXPO_DECL (expo); num = mpq_numref (q); den = mpq_denref (q); /* NAN and INF for mpq are not really documented, but could be found */ if (MPFR_UNLIKELY (mpz_sgn (num) == 0)) { if (MPFR_UNLIKELY (mpz_sgn (den) == 0)) { MPFR_SET_NAN (f); MPFR_RET_NAN; } else { MPFR_SET_ZERO (f); MPFR_SET_POS (f); MPFR_RET (0); } } if (MPFR_UNLIKELY (mpz_sgn (den) == 0)) { MPFR_SET_INF (f); MPFR_SET_SIGN (f, mpz_sgn (num)); MPFR_RET (0); } MPFR_SAVE_EXPO_MARK (expo); cn = set_z (n, num, &sn); cd = set_z (d, den, &sd); sn -= sd; if (MPFR_UNLIKELY (sn > MPFR_EMAX_MAX / GMP_NUMB_BITS)) { MPFR_SAVE_EXPO_FREE (expo); inexact = mpfr_overflow (f, rnd, MPFR_SIGN (f)); goto end; } if (MPFR_UNLIKELY (sn < MPFR_EMIN_MIN / GMP_NUMB_BITS -1)) { MPFR_SAVE_EXPO_FREE (expo); if (rnd == MPFR_RNDN) rnd = MPFR_RNDZ; inexact = mpfr_underflow (f, rnd, MPFR_SIGN (f)); goto end; } inexact = mpfr_div (f, n, d, rnd); shift = GMP_NUMB_BITS*sn+cn-cd; MPFR_ASSERTD (shift == GMP_NUMB_BITS*sn+cn-cd); cd = mpfr_mul_2si (f, f, shift, rnd); MPFR_SAVE_EXPO_FREE (expo); if (MPFR_UNLIKELY (cd != 0)) inexact = cd; else inexact = mpfr_check_range (f, inexact, rnd); end: mpfr_clear (d); mpfr_clear (n); MPFR_RET (inexact); }
size_t mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op, mpfr_rnd_t rnd_mode) { char *s, *s0; size_t l; mpfr_exp_t e; int err; MPFR_ASSERTN (base >= 2 && base <= 62); /* when stream=NULL, output to stdout */ if (stream == NULL) stream = stdout; if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (op))) { if (MPFR_IS_NAN (op)) OUT_STR_RET ("@NaN@"); else if (MPFR_IS_INF (op)) OUT_STR_RET (MPFR_IS_POS (op) ? "@Inf@" : "-@Inf@"); else { MPFR_ASSERTD (MPFR_IS_ZERO (op)); OUT_STR_RET (MPFR_IS_POS (op) ? "0" : "-0"); } } s = mpfr_get_str (NULL, &e, base, n_digits, op, rnd_mode); s0 = s; /* for op=3.1416 we have s = "31416" and e = 1 */ l = strlen (s) + 1; /* size of allocated block returned by mpfr_get_str - may be incorrect, as only an upper bound? */ /* outputs possible sign and significand */ err = (*s == '-' && fputc (*s++, stream) == EOF) || fputc (*s++, stream) == EOF /* leading digit */ || fputc ((unsigned char) MPFR_DECIMAL_POINT, stream) == EOF || fputs (s, stream) == EOF; /* trailing significand */ mpfr_free_func (s0, l); if (MPFR_UNLIKELY (err)) return 0; e--; /* due to the leading digit */ /* outputs exponent */ if (e) { int r; MPFR_ASSERTN(e >= LONG_MIN); MPFR_ASSERTN(e <= LONG_MAX); r = fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), (long) e); if (MPFR_UNLIKELY (r < 0)) return 0; l += r; } return l; }
int mpfr_sin (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t c, xr; mpfr_srcptr xx; mpfr_exp_t expx, err; mpfr_prec_t precy, m; int inexact, sign, reduce; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } } /* sin(x) = x - x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 2, 0, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); /* Compute initial precision */ precy = MPFR_PREC (y); if (precy >= MPFR_SINCOS_THRESHOLD) return mpfr_sin_fast (y, x, rnd_mode); m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13; expx = MPFR_GET_EXP (x); mpfr_init (c); mpfr_init (xr); MPFR_ZIV_INIT (loop, m); for (;;) { /* first perform argument reduction modulo 2*Pi (if needed), also helps to determine the sign of sin(x) */ if (expx >= 2) /* If Pi < x < 4, we need to reduce too, to determine the sign of sin(x). For 2 <= |x| < Pi, we could avoid the reduction. */ { reduce = 1; /* As expx + m - 1 will silently be converted into mpfr_prec_t in the mpfr_set_prec call, the assert below may be useful to avoid undefined behavior. */ MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX); mpfr_set_prec (c, expx + m - 1); mpfr_set_prec (xr, m); mpfr_const_pi (c, MPFR_RNDN); mpfr_mul_2ui (c, c, 1, MPFR_RNDN); mpfr_remainder (xr, x, c, MPFR_RNDN); /* The analysis is similar to that of cos.c: |xr - x - 2kPi| <= 2^(2-m). Thus we can decide the sign of sin(x) if xr is at distance at least 2^(2-m) of both 0 and +/-Pi. */ mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* Since c approximates Pi with an error <= 2^(2-expx-m) <= 2^(-m), it suffices to check that c - |xr| >= 2^(2-m). */ if (MPFR_SIGN (xr) > 0) mpfr_sub (c, c, xr, MPFR_RNDZ); else mpfr_add (c, c, xr, MPFR_RNDZ); if (MPFR_IS_ZERO(xr) || MPFR_GET_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m || MPFR_IS_ZERO(c) || MPFR_GET_EXP(c) < (mpfr_exp_t) 3 - (mpfr_exp_t) m) goto ziv_next; /* |xr - x - 2kPi| <= 2^(2-m), thus |sin(xr) - sin(x)| <= 2^(2-m) */ xx = xr; } else /* the input argument is already reduced */ { reduce = 0; xx = x; } sign = MPFR_SIGN(xx); /* now that the argument is reduced, precision m is enough */ mpfr_set_prec (c, m); mpfr_cos (c, xx, MPFR_RNDZ); /* can't be exact */ mpfr_nexttoinf (c); /* now c = cos(x) rounded away */ mpfr_mul (c, c, c, MPFR_RNDU); /* away */ mpfr_ui_sub (c, 1, c, MPFR_RNDZ); mpfr_sqrt (c, c, MPFR_RNDZ); if (MPFR_IS_NEG_SIGN(sign)) MPFR_CHANGE_SIGN(c); /* Warning: c may be 0! */ if (MPFR_UNLIKELY (MPFR_IS_ZERO (c))) { /* Huge cancellation: increase prec a lot! */ m = MAX (m, MPFR_PREC (x)); m = 2 * m; } else { /* the absolute error on c is at most 2^(3-m-EXP(c)), plus 2^(2-m) if there was an argument reduction. Since EXP(c) <= 1, 3-m-EXP(c) >= 2-m, thus the error is at most 2^(3-m-EXP(c)) in case of argument reduction. */ err = 2 * MPFR_GET_EXP (c) + (mpfr_exp_t) m - 3 - (reduce != 0); if (MPFR_CAN_ROUND (c, err, precy, rnd_mode)) break; /* check for huge cancellation (Near 0) */ if (err < (mpfr_exp_t) MPFR_PREC (y)) m += MPFR_PREC (y) - err; /* Check if near 1 */ if (MPFR_GET_EXP (c) == 1) m += m; } ziv_next: /* Else generic increase */ MPFR_ZIV_NEXT (loop, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, c, rnd_mode); /* inexact cannot be 0, since this would mean that c was representable within the target precision, but in that case mpfr_can_round will fail */ mpfr_clear (c); mpfr_clear (xr); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity), and return e such that the absolute error is bound by 2^e ulp(y) */ static mpfr_exp_t mpfr_eint_aux (mpfr_t y, mpfr_srcptr x) { mpfr_t eps; /* dynamic (absolute) error bound on t */ mpfr_t erru, errs; mpz_t m, s, t, u; mpfr_exp_t e, sizeinbase; mpfr_prec_t w = MPFR_PREC(y); unsigned long k; MPFR_GROUP_DECL (group); /* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x) where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2 thus |R(x)/x| <= |x|/2 thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */ if (MPFR_GET_EXP(x) <= - (mpfr_exp_t) w) { mpfr_set (y, x, MPFR_RNDN); return 0; } mpz_init (s); /* initializes to 0 */ mpz_init (t); mpz_init (u); mpz_init (m); MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs); e = mpfr_get_z_2exp (m, x); /* x = m * 2^e */ MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x)); if (MPFR_PREC (x) > w) { e += MPFR_PREC (x) - w; mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w); } /* remove trailing zeroes from m: this will speed up much cases where x is a small integer divided by a power of 2 */ k = mpz_scan1 (m, 0); mpz_tdiv_q_2exp (m, m, k); e += k; /* initialize t to 2^w */ mpz_set_ui (t, 1); mpz_mul_2exp (t, t, w); mpfr_set_ui (eps, 0, MPFR_RNDN); /* eps[0] = 0 */ mpfr_set_ui (errs, 0, MPFR_RNDN); for (k = 1;; k++) { /* let eps[k] be the absolute error on t[k]: since t[k] = trunc(t[k-1]*m*2^e/k), we have eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k = 1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k = 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */ mpfr_mul_2ui (eps, eps, w - 1, MPFR_RNDU); mpfr_add_z (eps, eps, t, MPFR_RNDU); MPFR_MPZ_SIZEINBASE2 (sizeinbase, m); mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, MPFR_RNDU); mpfr_div_ui (eps, eps, k, MPFR_RNDU); mpfr_add_ui (eps, eps, 1, MPFR_RNDU); mpz_mul (t, t, m); if (e < 0) mpz_tdiv_q_2exp (t, t, -e); else mpz_mul_2exp (t, t, e); mpz_tdiv_q_ui (t, t, k); mpz_tdiv_q_ui (u, t, k); mpz_add (s, s, u); /* the absolute error on u is <= 1 + eps[k]/k */ mpfr_div_ui (erru, eps, k, MPFR_RNDU); mpfr_add_ui (erru, erru, 1, MPFR_RNDU); /* and that on s is the sum of all errors on u */ mpfr_add (errs, errs, erru, MPFR_RNDU); /* we are done when t is smaller than errs */ if (mpz_sgn (t) == 0) sizeinbase = 0; else MPFR_MPZ_SIZEINBASE2 (sizeinbase, t); if (sizeinbase < MPFR_GET_EXP (errs)) break; } /* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...) <= (|t|+eps)/k*|x|/(k-|x|) */ mpz_abs (t, t); mpfr_add_z (eps, eps, t, MPFR_RNDU); mpfr_div_ui (eps, eps, k, MPFR_RNDU); mpfr_abs (erru, x, MPFR_RNDU); /* |x| */ mpfr_mul (eps, eps, erru, MPFR_RNDU); mpfr_ui_sub (erru, k, erru, MPFR_RNDD); if (MPFR_IS_NEG (erru)) { /* the truncated series does not converge, return fail */ e = w; } else { mpfr_div (eps, eps, erru, MPFR_RNDU); mpfr_add (errs, errs, eps, MPFR_RNDU); mpfr_set_z (y, s, MPFR_RNDN); mpfr_div_2ui (y, y, w, MPFR_RNDN); /* errs was an absolute error bound on s. We must convert it to an error in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must divide the error by 2^(EXP(y)-PREC(y)), but since we divided also y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */ e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y); } MPFR_GROUP_CLEAR (group); mpz_clear (s); mpz_clear (t); mpz_clear (u); mpz_clear (m); return e; }