int mpfr_const_euler_internal (mpfr_t x, mpfr_rnd_t rnd) { mpfr_prec_t prec = MPFR_PREC(x), m, log2m; mpfr_t y, z; unsigned long n; int inexact; MPFR_ZIV_DECL (loop); log2m = MPFR_INT_CEIL_LOG2 (prec); m = prec + 2 * log2m + 23; mpfr_init2 (y, m); mpfr_init2 (z, m); MPFR_ZIV_INIT (loop, m); for (;;) { mpfr_exp_t exp_S, err; /* since prec >= 1, we have m >= 24 here, which ensures n >= 9 below */ n = 1 + (unsigned long) ((double) m * LOG2 / 2.0); MPFR_ASSERTD (n >= 9); mpfr_const_euler_S2 (y, n); /* error <= 3 ulps */ exp_S = MPFR_EXP(y); mpfr_set_ui (z, n, MPFR_RNDN); mpfr_log (z, z, MPFR_RNDD); /* error <= 1 ulp */ mpfr_sub (y, y, z, MPFR_RNDN); /* S'(n) - log(n) */ /* the error is less than 1/2 + 3*2^(exp_S-EXP(y)) + 2^(EXP(z)-EXP(y)) <= 1/2 + 2^(exp_S+2-EXP(y)) + 2^(EXP(z)-EXP(y)) <= 1/2 + 2^(1+MAX(exp_S+2,EXP(z))-EXP(y)) */ err = 1 + MAX(exp_S + 2, MPFR_EXP(z)) - MPFR_EXP(y); err = (err >= -1) ? err + 1 : 0; /* error <= 2^err ulp(y) */ exp_S = MPFR_EXP(y); mpfr_const_euler_R (z, n); /* err <= ulp(1/2) = 2^(-m) */ mpfr_sub (y, y, z, MPFR_RNDN); /* err <= 1/2 ulp(y) + 2^(-m) + 2^(err + exp_S - EXP(y)) ulp(y). Since the result is between 0.5 and 1, ulp(y) = 2^(-m). So we get 3/2*ulp(y) + 2^(err + exp_S - EXP(y)) ulp(y). 3/2 + 2^e <= 2^(e+1) for e>=1, and <= 2^2 otherwise */ err = err + exp_S - MPFR_EXP(y); err = (err >= 1) ? err + 1 : 2; if (MPFR_LIKELY (MPFR_CAN_ROUND (y, m - err, prec, rnd))) break; MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (y, m); mpfr_set_prec (z, m); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (x, y, rnd); mpfr_clear (y); mpfr_clear (z); return inexact; /* always inexact */ }
/* Input: s - a floating-point number >= 1/2. rnd_mode - a rounding mode. Assumes s is neither NaN nor Infinite. Output: z - Zeta(s) rounded to the precision of z with direction rnd_mode */ static int mpfr_zeta_pos (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode) { mpfr_t b, c, z_pre, f, s1; double beta, sd, dnep; mpfr_t *tc1; mp_prec_t precz, precs, d, dint; int p, n, l, add; int inex; MPFR_GROUP_DECL (group); MPFR_ZIV_DECL (loop); MPFR_ASSERTD (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0); precz = MPFR_PREC (z); precs = MPFR_PREC (s); /* Zeta(x) = 1+1/2^x+1/3^x+1/4^x+1/5^x+O(1/6^x) so with 2^(EXP(x)-1) <= x < 2^EXP(x) So for x > 2^3, k^x > k^8, so 2/k^x < 2/k^8 Zeta(x) = 1 + 1/2^x*(1+(2/3)^x+(2/4)^x+...) = 1 + 1/2^x*(1+sum((2/k)^x,k=3..infinity)) <= 1 + 1/2^x*(1+sum((2/k)^8,k=3..infinity)) And sum((2/k)^8,k=3..infinity) = -257+128*Pi^8/4725 ~= 0.0438035 So Zeta(x) <= 1 + 1/2^x*2 for x >= 8 The error is < 2^(-x+1) <= 2^(-2^(EXP(x)-1)+1) */ if (MPFR_GET_EXP (s) > 3) { mp_exp_t err; err = MPFR_GET_EXP (s) - 1; if (err > (mp_exp_t) (sizeof (mp_exp_t)*CHAR_BIT-2)) err = MPFR_EMAX_MAX; else err = ((mp_exp_t)1) << err; err = 1 - (-err+1); /* GET_EXP(one) - (-err+1) = err :) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (z, __gmpfr_one, err, 0, 1, rnd_mode, {}); } d = precz + MPFR_INT_CEIL_LOG2(precz) + 10; /* we want that s1 = s-1 is exact, i.e. we should have PREC(s1) >= EXP(s) */ dint = (mpfr_uexp_t) MPFR_GET_EXP (s); mpfr_init2 (s1, MAX (precs, dint)); inex = mpfr_sub (s1, s, __gmpfr_one, GMP_RNDN); MPFR_ASSERTD (inex == 0); /* case s=1 */ if (MPFR_IS_ZERO (s1)) { MPFR_SET_INF (z); MPFR_SET_POS (z); MPFR_ASSERTD (inex == 0); goto clear_and_return; } MPFR_GROUP_INIT_4 (group, MPFR_PREC_MIN, b, c, z_pre, f); MPFR_ZIV_INIT (loop, d); for (;;) { /* Principal loop: we compute, in z_pre, an approximation of Zeta(s), that we send to can_round */ if (MPFR_GET_EXP (s1) <= -(mp_exp_t) ((mpfr_prec_t) (d-3)/2)) /* Branch 1: when s-1 is very small, one uses the approximation Zeta(s)=1/(s-1)+gamma, where gamma is Euler's constant */ { dint = MAX (d + 3, precs); MPFR_TRACE (printf ("branch 1\ninternal precision=%d\n", dint)); MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f); mpfr_div (z_pre, __gmpfr_one, s1, GMP_RNDN); mpfr_const_euler (f, GMP_RNDN); mpfr_add (z_pre, z_pre, f, GMP_RNDN); } else /* Branch 2 */ { size_t size; MPFR_TRACE (printf ("branch 2\n")); /* Computation of parameters n, p and working precision */ dnep = (double) d * LOG2; sd = mpfr_get_d (s, GMP_RNDN); /* beta = dnep + 0.61 + sd * log (6.2832 / sd); but a larger value is ok */ #define LOG6dot2832 1.83787940484160805532 beta = dnep + 0.61 + sd * (LOG6dot2832 - LOG2 * __gmpfr_floor_log2 (sd)); if (beta <= 0.0) { p = 0; /* n = 1 + (int) (exp ((dnep - LOG2) / sd)); */ n = 1 + (int) __gmpfr_ceil_exp2 ((d - 1.0) / sd); } else { p = 1 + (int) beta / 2; n = 1 + (int) ((sd + 2.0 * (double) p - 1.0) / 6.2832); } MPFR_TRACE (printf ("\nn=%d\np=%d\n",n,p)); /* add = 4 + floor(1.5 * log(d) / log (2)). We should have add >= 10, which is always fulfilled since d = precz + 11 >= 12, thus ceil(log2(d)) >= 4 */ add = 4 + (3 * MPFR_INT_CEIL_LOG2 (d)) / 2; MPFR_ASSERTD(add >= 10); dint = d + add; if (dint < precs) dint = precs; MPFR_TRACE (printf("internal precision=%d\n",dint)); size = (p + 1) * sizeof(mpfr_t); tc1 = (mpfr_t*) (*__gmp_allocate_func) (size); for (l=1; l<=p; l++) mpfr_init2 (tc1[l], dint); MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f); MPFR_TRACE (printf ("precision of z =%d\n", precz)); /* Computation of the coefficients c_k */ mpfr_zeta_c (p, tc1); /* Computation of the 3 parts of the fonction Zeta. */ mpfr_zeta_part_a (z_pre, s, n); mpfr_zeta_part_b (b, s, n, p, tc1); /* s1 = s-1 is already computed above */ mpfr_div (c, __gmpfr_one, s1, GMP_RNDN); mpfr_ui_pow (f, n, s1, GMP_RNDN); mpfr_div (c, c, f, GMP_RNDN); MPFR_TRACE (MPFR_DUMP (c)); mpfr_add (z_pre, z_pre, c, GMP_RNDN); mpfr_add (z_pre, z_pre, b, GMP_RNDN); for (l=1; l<=p; l++) mpfr_clear (tc1[l]); (*__gmp_free_func) (tc1, size); /* End branch 2 */ } MPFR_TRACE (MPFR_DUMP (z_pre)); if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, d-3, precz, rnd_mode))) break; MPFR_ZIV_NEXT (loop, d); } MPFR_ZIV_FREE (loop); inex = mpfr_set (z, z_pre, rnd_mode); MPFR_GROUP_CLEAR (group); clear_and_return: mpfr_clear (s1); return inex; }
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; /* initialise 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); }
int mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { int inexact; long xint; mpfr_t xfrac; 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_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) { if (MPFR_IS_POS (x)) MPFR_SET_INF (y); else MPFR_SET_ZERO (y); MPFR_SET_POS (y); MPFR_RET (0); } else /* 2^0 = 1 */ { MPFR_ASSERTD (MPFR_IS_ZERO(x)); return mpfr_set_ui (y, 1, rnd_mode); } } /* since the smallest representable non-zero float is 1/2*2^__gmpfr_emin, if x < __gmpfr_emin - 1, the result is either 1/2*2^__gmpfr_emin or 0 */ MPFR_ASSERTN (MPFR_EMIN_MIN >= LONG_MIN + 2); if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emin - 1) < 0)) { mpfr_rnd_t rnd2 = rnd_mode; /* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */ if (rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0) rnd2 = MPFR_RNDZ; return mpfr_underflow (y, rnd2, 1); } MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX); if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax) >= 0)) return mpfr_overflow (y, rnd_mode, 1); /* We now know that emin - 1 <= x < emax. */ MPFR_SAVE_EXPO_MARK (expo); /* 2^x = 1 + x*log(2) + O(x^2) for x near zero, and for |x| <= 1 we have |2^x - 1| <= x < 2^EXP(x). If x > 0 we must round away from 0 (dir=1); if x < 0 we must round toward 0 (dir=0). */ MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, - MPFR_GET_EXP (x), 0, MPFR_IS_POS (x), rnd_mode, expo, {}); xint = mpfr_get_si (x, MPFR_RNDZ); mpfr_init2 (xfrac, MPFR_PREC (x)); mpfr_sub_si (xfrac, x, xint, MPFR_RNDN); /* exact */ if (MPFR_IS_ZERO (xfrac)) { mpfr_set_ui (y, 1, MPFR_RNDN); inexact = 0; } else { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (loop); /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 5 + MPFR_INT_CEIL_LOG2 (Ny); /* initialize of intermediary variable */ mpfr_init2 (t, Nt); /* First computation */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute exp(x*ln(2))*/ mpfr_const_log2 (t, MPFR_RNDU); /* ln(2) */ mpfr_mul (t, xfrac, t, MPFR_RNDU); /* xfrac * ln(2) */ err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */ mpfr_exp (t, t, MPFR_RNDN); /* exp(xfrac * ln(2)) */ if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) 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_mode); mpfr_clear (t); } mpfr_clear (xfrac); MPFR_CLEAR_FLAGS (); mpfr_mul_2si (y, y, xint, MPFR_RNDN); /* exact or overflow */ /* Note: We can have an overflow only when t was rounded up to 2. */ MPFR_ASSERTD (MPFR_IS_PURE_FP (y) || inexact > 0); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
/* Don't need to save / restore exponent range: the cache does it */ int mpfr_const_log2_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode) { unsigned long n = MPFR_PREC (x); mpfr_prec_t w; /* working precision */ unsigned long N; mpz_t *T, *P, *Q; mpfr_t t, q; int inexact; int ok = 1; /* ensures that the 1st try will give correct rounding */ unsigned long lgN, i; MPFR_GROUP_DECL(group); MPFR_TMP_DECL(marker); MPFR_ZIV_DECL(loop); MPFR_LOG_FUNC ( ("rnd_mode=%d", rnd_mode), ("x[%Pu]=%.*Rg inex=%d", mpfr_get_prec(x), mpfr_log_prec, x, inexact)); if (n < 1253) w = n + 10; /* ensures correct rounding for the four rounding modes, together with N = w / 3 + 1 (see below). */ else if (n < 2571) w = n + 11; /* idem */ else if (n < 3983) w = n + 12; else if (n < 4854) w = n + 13; else if (n < 26248) w = n + 14; else { w = n + 15; ok = 0; } MPFR_TMP_MARK(marker); MPFR_GROUP_INIT_2(group, w, t, q); MPFR_ZIV_INIT (loop, w); for (;;) { N = w / 3 + 1; /* Warning: do not change that (even increasing N!) without checking correct rounding in the above ranges for n. */ /* the following are needed for error analysis (see algorithms.tex) */ MPFR_ASSERTD(w >= 3 && N >= 2); lgN = MPFR_INT_CEIL_LOG2 (N) + 1; T = (mpz_t *) MPFR_TMP_ALLOC (3 * lgN * sizeof (mpz_t)); P = T + lgN; Q = T + 2*lgN; for (i = 0; i < lgN; i++) { mpz_init (T[i]); mpz_init (P[i]); mpz_init (Q[i]); } S (T, P, Q, 0, N, 0); mpfr_set_z (t, T[0], MPFR_RNDN); mpfr_set_z (q, Q[0], MPFR_RNDN); mpfr_div (t, t, q, MPFR_RNDN); for (i = 0; i < lgN; i++) { mpz_clear (T[i]); mpz_clear (P[i]); mpz_clear (Q[i]); } if (MPFR_LIKELY (ok != 0 || mpfr_can_round (t, w - 2, MPFR_RNDN, rnd_mode, n))) break; MPFR_ZIV_NEXT (loop, w); MPFR_GROUP_REPREC_2(group, w, t, q); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (x, t, rnd_mode); MPFR_GROUP_CLEAR(group); MPFR_TMP_FREE(marker); return inexact; }
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact ie, iff x = 0 */ int mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode) { mp_prec_t prec, m; int neg, reduce; mpfr_t c, xr; mpfr_srcptr xx; mp_exp_t err, expx; MPFR_ZIV_DECL (loop); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN(x) || MPFR_IS_INF(x)) { MPFR_SET_NAN (y); MPFR_SET_NAN (z); MPFR_RET_NAN; } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, x); /* y = 0, thus exact, but z is inexact in case of underflow or overflow */ return mpfr_set_ui (z, 1, rnd_mode); } } MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode), ("sin[%#R]=%R cos[%#R]=%R", y, y, z, z)); prec = MAX (MPFR_PREC (y), MPFR_PREC (z)); m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13; expx = MPFR_GET_EXP (x); mpfr_init (c); mpfr_init (xr); MPFR_ZIV_INIT (loop, m); for (;;) { /* the following is copied from sin.c */ if (expx >= 2) /* reduce the argument */ { reduce = 1; mpfr_set_prec (c, expx + m - 1); mpfr_set_prec (xr, m); mpfr_const_pi (c, GMP_RNDN); mpfr_mul_2ui (c, c, 1, GMP_RNDN); mpfr_remainder (xr, x, c, GMP_RNDN); mpfr_div_2ui (c, c, 1, GMP_RNDN); if (MPFR_SIGN (xr) > 0) mpfr_sub (c, c, xr, GMP_RNDZ); else mpfr_add (c, c, xr, GMP_RNDZ); if (MPFR_IS_ZERO(xr) || MPFR_EXP(xr) < (mp_exp_t) 3 - (mp_exp_t) m || MPFR_EXP(c) < (mp_exp_t) 3 - (mp_exp_t) m) goto next_step; xx = xr; } else /* the input argument is already reduced */ { reduce = 0; xx = x; } neg = MPFR_IS_NEG (xx); /* gives sign of sin(x) */ mpfr_set_prec (c, m); mpfr_cos (c, xx, GMP_RNDZ); /* If no argument reduction was performed, the error is at most ulp(c), otherwise it is at most ulp(c) + 2^(2-m). Since |c| < 1, we have ulp(c) <= 2^(-m), thus the error is bounded by 2^(3-m) in that later case. */ if (reduce == 0) err = m; else err = MPFR_GET_EXP (c) + (mp_exp_t) (m - 3); if (!mpfr_can_round (c, err, GMP_RNDN, rnd_mode, MPFR_PREC (z) + (rnd_mode == GMP_RNDN))) goto next_step; mpfr_set (z, c, rnd_mode); mpfr_sqr (c, c, GMP_RNDU); mpfr_ui_sub (c, 1, c, GMP_RNDN); err = 2 + (- MPFR_GET_EXP (c)) / 2; mpfr_sqrt (c, c, GMP_RNDN); if (neg) MPFR_CHANGE_SIGN (c); /* the absolute error on c is at most 2^(err-m), which we must put in the form 2^(EXP(c)-err). If there was an argument reduction, we need to add 2^(2-m); since err >= 2, the error is bounded by 2^(err+1-m) in that case. */ err = MPFR_GET_EXP (c) + (mp_exp_t) m - (err + reduce); if (mpfr_can_round (c, err, GMP_RNDN, rnd_mode, MPFR_PREC (y) + (rnd_mode == GMP_RNDN))) break; /* check for huge cancellation */ if (err < (mp_exp_t) MPFR_PREC (y)) m += MPFR_PREC (y) - err; /* Check if near 1 */ if (MPFR_GET_EXP (c) == 1 && MPFR_MANT (c)[MPFR_LIMB_SIZE (c)-1] == MPFR_LIMB_HIGHBIT) m += m; next_step: MPFR_ZIV_NEXT (loop, m); mpfr_set_prec (c, m); } MPFR_ZIV_FREE (loop); mpfr_set (y, c, rnd_mode); mpfr_clear (c); mpfr_clear (xr); MPFR_RET (1); /* Always inexact */ }
int mpfr_log1p (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode) { int comp, inexact; mp_exp_t ex; MPFR_SAVE_EXPO_DECL (expo); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } /* check for inf or -inf (result is not defined) */ else if (MPFR_IS_INF (x)) { if (MPFR_IS_POS (x)) { MPFR_SET_INF (y); MPFR_SET_POS (y); MPFR_RET (0); } else { MPFR_SET_NAN (y); MPFR_RET_NAN; } } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); /* log1p(+/- 0) = +/- 0 */ MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } } ex = MPFR_GET_EXP (x); if (ex < 0) /* -0.5 < x < 0.5 */ { /* For x > 0, abs(log(1+x)-x) < x^2/2. For x > -0.5, abs(log(1+x)-x) < x^2. */ if (MPFR_IS_POS (x)) MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, - ex - 1, 0, 0, rnd_mode, {}); else MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, - ex, 0, 1, rnd_mode, {}); } comp = mpfr_cmp_si (x, -1); /* log1p(x) is undefined for x < -1 */ if (MPFR_UNLIKELY(comp <= 0)) { if (comp == 0) /* x=0: log1p(-1)=-inf (division by zero) */ { MPFR_SET_INF (y); MPFR_SET_NEG (y); MPFR_RET (0); } MPFR_SET_NAN (y); MPFR_RET_NAN; } MPFR_SAVE_EXPO_MARK (expo); /* 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 */ MPFR_ZIV_DECL (loop); /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 6; /* if |x| is smaller than 2^(-e), we will loose about e bits in log(1+x) */ if (MPFR_EXP(x) < 0) Nt += -MPFR_EXP(x); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); /* First computation of log1p */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute log1p */ inexact = mpfr_add_ui (t, x, 1, GMP_RNDN); /* 1+x */ /* if inexact = 0, then t = x+1, and the result is simply log(t) */ if (inexact == 0) { inexact = mpfr_log (y, t, rnd_mode); goto end; } mpfr_log (t, t, GMP_RNDN); /* log(1+x) */ /* the error is bounded by (1/2+2^(1-EXP(t))*ulp(t) (cf algorithms.tex) if EXP(t)>=2, then error <= ulp(t) if EXP(t)<=1, then error <= 2^(2-EXP(t))*ulp(t) */ err = Nt - MAX (0, 2 - MPFR_GET_EXP (t)); if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* increase the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } inexact = mpfr_set (y, t, rnd_mode); end: MPFR_ZIV_FREE (loop); mpfr_clear (t); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
int mpfr_tanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode) { /****** Declaration ******/ mpfr_t x; int inexact; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); /* Special value checking */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt))) { if (MPFR_IS_NAN (xt)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (xt)) { /* tanh(inf) = 1 && tanh(-inf) = -1 */ return mpfr_set_si (y, MPFR_INT_SIGN (xt), rnd_mode); } else /* tanh (0) = 0 and xt is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO(xt)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, xt); MPFR_RET (0); } } /* tanh(x) = x - x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 0, rnd_mode, {}); MPFR_TMP_INIT_ABS (x, xt); MPFR_SAVE_EXPO_MARK (expo); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, te; mpfr_exp_t d; /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */ mpfr_prec_t Nt; /* working precision */ long int err; /* error */ int sign = MPFR_SIGN (xt); MPFR_ZIV_DECL (loop); MPFR_GROUP_DECL (group); /* First check for BIG overflow of exp(2*x): For x > 0, exp(2*x) > 2^(2*x) If 2 ^(2*x) > 2^emax or x>emax/2, there is an overflow */ if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax/2) >= 0)) { /* initialise of intermediary variables since 'set_one' label assumes the variables have been initialize */ MPFR_GROUP_INIT_2 (group, MPFR_PREC_MIN, t, te); goto set_one; } /* Compute the precision of intermediary variable */ /* The optimal number of bits: see algorithms.tex */ Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 4; /* if x is small, there will be a cancellation in exp(2x)-1 */ if (MPFR_GET_EXP (x) < 0) Nt += -MPFR_GET_EXP (x); /* initialise of intermediary variable */ MPFR_GROUP_INIT_2 (group, Nt, t, te); MPFR_ZIV_INIT (loop, Nt); for (;;) { /* tanh = (exp(2x)-1)/(exp(2x)+1) */ mpfr_mul_2ui (te, x, 1, MPFR_RNDN); /* 2x */ /* since x > 0, we can only have an overflow */ mpfr_exp (te, te, MPFR_RNDN); /* exp(2x) */ if (MPFR_UNLIKELY (MPFR_IS_INF (te))) { set_one: inexact = MPFR_FROM_SIGN_TO_INT (sign); mpfr_set4 (y, __gmpfr_one, MPFR_RNDN, sign); if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG_SIGN (sign))) { inexact = -inexact; mpfr_nexttozero (y); } break; } d = MPFR_GET_EXP (te); /* For Error calculation */ mpfr_add_ui (t, te, 1, MPFR_RNDD); /* exp(2x) + 1*/ mpfr_sub_ui (te, te, 1, MPFR_RNDU); /* exp(2x) - 1*/ d = d - MPFR_GET_EXP (te); mpfr_div (t, te, t, MPFR_RNDN); /* (exp(2x)-1)/(exp(2x)+1)*/ /* Calculation of the error */ d = MAX(3, d + 1); err = Nt - (d + 1); if (MPFR_LIKELY ((d <= Nt / 2) && MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) { inexact = mpfr_set4 (y, t, rnd_mode, sign); break; } /* if t=1, we still can round since |sinh(x)| < 1 */ if (MPFR_GET_EXP (t) == 1) goto set_one; /* Actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); MPFR_GROUP_REPREC_2 (group, Nt, t, te); } MPFR_ZIV_FREE (loop); MPFR_GROUP_CLEAR (group); } MPFR_SAVE_EXPO_FREE (expo); inexact = mpfr_check_range (y, inexact, rnd_mode); return inexact; }
int mpfr_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); } } }
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[%#R]=%R rnd=%d", x, x, rnd_mode), ("y[%#R]=%R inexact=%d", y, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } } /* 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_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m || MPFR_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); }
int mpfr_log (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode) { int inexact; mpfr_prec_t p, q; mpfr_t tmp1, tmp2; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); MPFR_GROUP_DECL(group); MPFR_LOG_FUNC (("a[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (a), mpfr_log_prec, a, rnd_mode), ("r[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (r), mpfr_log_prec, r, inexact)); /* Special cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a))) { /* If a is NaN, the result is NaN */ if (MPFR_IS_NAN (a)) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* check for infinity before zero */ else if (MPFR_IS_INF (a)) { if (MPFR_IS_NEG (a)) /* log(-Inf) = NaN */ { MPFR_SET_NAN (r); MPFR_RET_NAN; } else /* log(+Inf) = +Inf */ { MPFR_SET_INF (r); MPFR_SET_POS (r); MPFR_RET (0); } } else /* a is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (a)); MPFR_SET_INF (r); MPFR_SET_NEG (r); mpfr_set_divby0 (); MPFR_RET (0); /* log(0) is an exact -infinity */ } } /* If a is negative, the result is NaN */ else if (MPFR_UNLIKELY (MPFR_IS_NEG (a))) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* If a is 1, the result is 0 */ else if (MPFR_UNLIKELY (MPFR_GET_EXP (a) == 1 && mpfr_cmp_ui (a, 1) == 0)) { MPFR_SET_ZERO (r); MPFR_SET_POS (r); MPFR_RET (0); /* only "normal" case where the result is exact */ } q = MPFR_PREC (r); /* use initial precision about q+lg(q)+5 */ p = q + 5 + 2 * MPFR_INT_CEIL_LOG2 (q); /* % ~(mpfr_prec_t)GMP_NUMB_BITS ; m=q; while (m) { p++; m >>= 1; } */ /* if (MPFR_LIKELY(p % GMP_NUMB_BITS != 0)) p += GMP_NUMB_BITS - (p%GMP_NUMB_BITS); */ MPFR_SAVE_EXPO_MARK (expo); MPFR_GROUP_INIT_2 (group, p, tmp1, tmp2); MPFR_ZIV_INIT (loop, p); for (;;) { long m; mpfr_exp_t cancel; /* Calculus of m (depends on p) */ m = (p + 1) / 2 - MPFR_GET_EXP (a) + 1; mpfr_mul_2si (tmp2, a, m, MPFR_RNDN); /* s=a*2^m, err<=1 ulp */ mpfr_div (tmp1, __gmpfr_four, tmp2, MPFR_RNDN);/* 4/s, err<=2 ulps */ mpfr_agm (tmp2, __gmpfr_one, tmp1, MPFR_RNDN); /* AG(1,4/s),err<=3 ulps */ mpfr_mul_2ui (tmp2, tmp2, 1, MPFR_RNDN); /* 2*AG(1,4/s), err<=3 ulps */ mpfr_const_pi (tmp1, MPFR_RNDN); /* compute pi, err<=1ulp */ mpfr_div (tmp2, tmp1, tmp2, MPFR_RNDN); /* pi/2*AG(1,4/s), err<=5ulps */ mpfr_const_log2 (tmp1, MPFR_RNDN); /* compute log(2), err<=1ulp */ mpfr_mul_si (tmp1, tmp1, m, MPFR_RNDN); /* compute m*log(2),err<=2ulps */ mpfr_sub (tmp1, tmp2, tmp1, MPFR_RNDN); /* log(a), err<=7ulps+cancel */ if (MPFR_LIKELY (MPFR_IS_PURE_FP (tmp1) && MPFR_IS_PURE_FP (tmp2))) { cancel = MPFR_GET_EXP (tmp2) - MPFR_GET_EXP (tmp1); MPFR_LOG_MSG (("canceled bits=%ld\n", (long) cancel)); MPFR_LOG_VAR (tmp1); if (MPFR_UNLIKELY (cancel < 0)) cancel = 0; /* we have 7 ulps of error from the above roundings, 4 ulps from the 4/s^2 second order term, plus the canceled bits */ if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp1, p-cancel-4, q, rnd_mode))) break; /* VL: I think it is better to have an increment that it isn't too low; in particular, the increment must be positive even if cancel = 0 (can this occur?). */ p += cancel >= 8 ? cancel : 8; } else { /* TODO: find why this case can occur and what is best to do with it. */ p += 32; } MPFR_ZIV_NEXT (loop, p); MPFR_GROUP_REPREC_2 (group, p, tmp1, tmp2); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (r, tmp1, rnd_mode); /* We clean */ MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (r, inexact, rnd_mode); }
int mpfr_ui_pow_ui (mpfr_ptr x, unsigned long int y, unsigned long int n, mpfr_rnd_t rnd) { mpfr_exp_t err; unsigned long m; mpfr_t res; mpfr_prec_t prec; int size_n; int inexact; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); if (MPFR_UNLIKELY (n <= 1)) { if (n == 1) return mpfr_set_ui (x, y, rnd); /* y^1 = y */ else return mpfr_set_ui (x, 1, rnd); /* y^0 = 1 for any y */ } else if (MPFR_UNLIKELY (y <= 1)) { if (y == 1) return mpfr_set_ui (x, 1, rnd); /* 1^n = 1 for any n > 0 */ else return mpfr_set_ui (x, 0, rnd); /* 0^n = 0 for any n > 0 */ } for (size_n = 0, m = n; m; size_n++, m >>= 1); MPFR_SAVE_EXPO_MARK (expo); prec = MPFR_PREC (x) + 3 + size_n; mpfr_init2 (res, prec); MPFR_ZIV_INIT (loop, prec); for (;;) { int i = size_n; inexact = mpfr_set_ui (res, y, MPFR_RNDU); err = 1; /* now 2^(i-1) <= n < 2^i: i=1+floor(log2(n)) */ for (i -= 2; i >= 0; i--) { inexact |= mpfr_mul (res, res, res, MPFR_RNDU); err++; if (n & (1UL << i)) inexact |= mpfr_mul_ui (res, res, y, MPFR_RNDU); } /* since the loop is executed floor(log2(n)) times, we have err = 1+floor(log2(n)). Since prec >= MPFR_PREC(x) + 4 + floor(log2(n)), prec > err */ err = prec - err; if (MPFR_LIKELY (inexact == 0 || MPFR_CAN_ROUND (res, err, MPFR_PREC (x), rnd))) break; /* Actualisation of the precision */ MPFR_ZIV_NEXT (loop, prec); mpfr_set_prec (res, prec); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (x, res, rnd); mpfr_clear (res); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (x, inexact, rnd); }
int mpfr_log10 (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode) { int inexact; MPFR_SAVE_EXPO_DECL (expo); /* If a is NaN, the result is NaN */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a))) { if (MPFR_IS_NAN (a)) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* check for infinity before zero */ else if (MPFR_IS_INF (a)) { if (MPFR_IS_NEG (a)) /* log10(-Inf) = NaN */ { MPFR_SET_NAN (r); MPFR_RET_NAN; } else /* log10(+Inf) = +Inf */ { MPFR_SET_INF (r); MPFR_SET_POS (r); MPFR_RET (0); /* exact */ } } else /* a = 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (a)); MPFR_SET_INF (r); MPFR_SET_NEG (r); MPFR_RET (0); /* log10(0) is an exact -infinity */ } } /* If a is negative, the result is NaN */ if (MPFR_UNLIKELY (MPFR_IS_NEG (a))) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* If a is 1, the result is 0 */ if (mpfr_cmp_ui (a, 1) == 0) { MPFR_SET_ZERO (r); MPFR_SET_POS (r); MPFR_RET (0); /* result is exact */ } MPFR_SAVE_EXPO_MARK (expo); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, tt; MPFR_ZIV_DECL (loop); /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(r); /* Precision of output variable */ mpfr_prec_t Nt; /* Precision of the intermediary variable */ mpfr_exp_t err; /* Precision of error */ /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 4 + MPFR_INT_CEIL_LOG2 (Ny); /* initialise of intermediary variables */ mpfr_init2 (t, Nt); mpfr_init2 (tt, Nt); /* First computation of log10 */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute log10 */ mpfr_set_ui (t, 10, MPFR_RNDN); /* 10 */ mpfr_log (t, t, MPFR_RNDD); /* log(10) */ mpfr_log (tt, a, MPFR_RNDN); /* log(a) */ mpfr_div (t, tt, t, MPFR_RNDN); /* log(a)/log(10) */ /* estimation of the error */ err = Nt - 4; if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* log10(10^n) is exact: FIXME: Can we have 10^n exactly representable as a mpfr_t but n can't fit an unsigned long? */ if (MPFR_IS_POS (t) && mpfr_integer_p (t) && mpfr_fits_ulong_p (t, MPFR_RNDN) && !mpfr_ui_pow_ui (tt, 10, mpfr_get_ui (t, MPFR_RNDN), MPFR_RNDN) && mpfr_cmp (a, tt) == 0) break; /* actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); mpfr_set_prec (tt, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (r, t, rnd_mode); mpfr_clear (t); mpfr_clear (tt); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (r, inexact, rnd_mode); }
/* computes tan(x) = sign(x)*sqrt(1/cos(x)^2-1) */ int mpfr_tan (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode) { mp_prec_t precy, m; int inexact; mpfr_t s, c; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_GROUP_DECL (group); MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode), ("y[%#R]=%R inexact=%d", y, y, inexact)); if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(x))) { if (MPFR_IS_NAN(x) || MPFR_IS_INF(x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } else /* x is zero */ { MPFR_ASSERTD(MPFR_IS_ZERO(x)); MPFR_SET_ZERO(y); MPFR_SET_SAME_SIGN(y, x); MPFR_RET(0); } } /* tan(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 1, 1, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); /* Compute initial precision */ precy = MPFR_PREC (y); m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13; MPFR_ASSERTD (m >= 2); /* needed for the error analysis in algorithms.tex */ MPFR_GROUP_INIT_2 (group, m, s, c); MPFR_ZIV_INIT (loop, m); for (;;) { /* The only way to get an overflow is to get ~ Pi/2 But the result will be ~ 2^Prec(y). */ mpfr_sin_cos (s, c, x, GMP_RNDN); /* err <= 1/2 ulp on s and c */ mpfr_div (c, s, c, GMP_RNDN); /* err <= 4 ulps */ MPFR_ASSERTD (!MPFR_IS_SINGULAR (c)); if (MPFR_LIKELY (MPFR_CAN_ROUND (c, m - 2, precy, rnd_mode))) break; MPFR_ZIV_NEXT (loop, m); MPFR_GROUP_REPREC_2 (group, m, s, c); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, c, rnd_mode); MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
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_log2 (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode) { int inexact; MPFR_SAVE_EXPO_DECL (expo); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a))) { /* If a is NaN, the result is NaN */ if (MPFR_IS_NAN (a)) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* check for infinity before zero */ else if (MPFR_IS_INF (a)) { if (MPFR_IS_NEG (a)) /* log(-Inf) = NaN */ { MPFR_SET_NAN (r); MPFR_RET_NAN; } else /* log(+Inf) = +Inf */ { MPFR_SET_INF (r); MPFR_SET_POS (r); MPFR_RET (0); } } else /* a is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (a)); MPFR_SET_INF (r); MPFR_SET_NEG (r); MPFR_RET (0); /* log2(0) is an exact -infinity */ } } /* If a is negative, the result is NaN */ if (MPFR_UNLIKELY (MPFR_IS_NEG (a))) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* If a is 1, the result is 0 */ if (MPFR_UNLIKELY (mpfr_cmp_ui (a, 1) == 0)) { MPFR_SET_ZERO (r); MPFR_SET_POS (r); MPFR_RET (0); /* only "normal" case where the result is exact */ } /* If a is 2^N, log2(a) is exact*/ if (MPFR_UNLIKELY (mpfr_cmp_ui_2exp (a, 1, MPFR_GET_EXP (a) - 1) == 0)) return mpfr_set_si(r, MPFR_GET_EXP (a) - 1, rnd_mode); MPFR_SAVE_EXPO_MARK (expo); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, tt; /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(r); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (loop); /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 3 + MPFR_INT_CEIL_LOG2 (Ny); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); mpfr_init2 (tt, Nt); /* First computation of log2 */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute log2 */ mpfr_const_log2(t,MPFR_RNDD); /* log(2) */ mpfr_log(tt,a,MPFR_RNDN); /* log(a) */ mpfr_div(t,tt,t,MPFR_RNDN); /* log(a)/log(2) */ /* estimation of the error */ err = Nt-3; if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); mpfr_set_prec (tt, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (r, t, rnd_mode); mpfr_clear (t); mpfr_clear (tt); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (r, inexact, rnd_mode); }
/* Assumes that the exponent range has already been extended and if y is an integer, then the result is not exact in unbounded exponent range. */ int mpfr_pow_general (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode, int y_is_integer, mpfr_save_expo_t *expo) { mpfr_t t, u, k, absx; int neg_result = 0; int k_non_zero = 0; int check_exact_case = 0; int inexact; /* Declaration of the size variable */ mpfr_prec_t Nz = MPFR_PREC(z); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (ziv_loop); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode), ("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inexact)); /* We put the absolute value of x in absx, pointing to the significand of x to avoid allocating memory for the significand of absx. */ MPFR_ALIAS(absx, x, /*sign=*/ 1, /*EXP=*/ MPFR_EXP(x)); /* We will compute the absolute value of the result. So, let's invert the rounding mode if the result is negative. */ if (MPFR_IS_NEG (x) && is_odd (y)) { neg_result = 1; rnd_mode = MPFR_INVERT_RND (rnd_mode); } /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Nz + 5 + MPFR_INT_CEIL_LOG2 (Nz); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); MPFR_ZIV_INIT (ziv_loop, Nt); for (;;) { MPFR_BLOCK_DECL (flags1); /* compute exp(y*ln|x|), using MPFR_RNDU to get an upper bound, so that we can detect underflows. */ mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDD : MPFR_RNDU); /* ln|x| */ mpfr_mul (t, y, t, MPFR_RNDU); /* y*ln|x| */ if (k_non_zero) { MPFR_LOG_MSG (("subtract k * ln(2)\n", 0)); mpfr_const_log2 (u, MPFR_RNDD); mpfr_mul (u, u, k, MPFR_RNDD); /* Error on u = k * log(2): < k * 2^(-Nt) < 1. */ mpfr_sub (t, t, u, MPFR_RNDU); MPFR_LOG_MSG (("t = y * ln|x| - k * ln(2)\n", 0)); MPFR_LOG_VAR (t); } /* estimate of the error -- see pow function in algorithms.tex. The error on t is at most 1/2 + 3*2^(EXP(t)+1) ulps, which is <= 2^(EXP(t)+3) for EXP(t) >= -1, and <= 2 ulps for EXP(t) <= -2. Additional error if k_no_zero: treal = t * errk, with 1 - |k| * 2^(-Nt) <= exp(-|k| * 2^(-Nt)) <= errk <= 1, i.e., additional absolute error <= 2^(EXP(k)+EXP(t)-Nt). Total error <= 2^err1 + 2^err2 <= 2^(max(err1,err2)+1). */ err = MPFR_NOTZERO (t) && MPFR_GET_EXP (t) >= -1 ? MPFR_GET_EXP (t) + 3 : 1; if (k_non_zero) { if (MPFR_GET_EXP (k) > err) err = MPFR_GET_EXP (k); err++; } MPFR_BLOCK (flags1, mpfr_exp (t, t, MPFR_RNDN)); /* exp(y*ln|x|)*/ /* We need to test */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (t) || MPFR_UNDERFLOW (flags1))) { mpfr_prec_t Ntmin; MPFR_BLOCK_DECL (flags2); MPFR_ASSERTN (!k_non_zero); MPFR_ASSERTN (!MPFR_IS_NAN (t)); /* Real underflow? */ if (MPFR_IS_ZERO (t)) { /* Underflow. We computed rndn(exp(t)), where t >= y*ln|x|. Therefore rndn(|x|^y) = 0, and we have a real underflow on |x|^y. */ inexact = mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, MPFR_SIGN_POS); if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT | MPFR_FLAGS_UNDERFLOW); break; } /* Real overflow? */ if (MPFR_IS_INF (t)) { /* Note: we can probably use a low precision for this test. */ mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD); mpfr_mul (t, y, t, MPFR_RNDD); /* y * ln|x| */ MPFR_BLOCK (flags2, mpfr_exp (t, t, MPFR_RNDD)); /* t = lower bound on exp(y * ln|x|) */ if (MPFR_OVERFLOW (flags2)) { /* We have computed a lower bound on |x|^y, and it overflowed. Therefore we have a real overflow on |x|^y. */ inexact = mpfr_overflow (z, rnd_mode, MPFR_SIGN_POS); if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW); break; } } k_non_zero = 1; Ntmin = sizeof(mpfr_exp_t) * CHAR_BIT; if (Ntmin > Nt) { Nt = Ntmin; mpfr_set_prec (t, Nt); } mpfr_init2 (u, Nt); mpfr_init2 (k, Ntmin); mpfr_log2 (k, absx, MPFR_RNDN); mpfr_mul (k, y, k, MPFR_RNDN); mpfr_round (k, k); MPFR_LOG_VAR (k); /* |y| < 2^Ntmin, therefore |k| < 2^Nt. */ continue; } if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Nz, rnd_mode))) { inexact = mpfr_set (z, t, rnd_mode); break; } /* check exact power, except when y is an integer (since the exact cases for y integer have already been filtered out) */ if (check_exact_case == 0 && ! y_is_integer) { if (mpfr_pow_is_exact (z, absx, y, rnd_mode, &inexact)) break; check_exact_case = 1; } /* reactualisation of the precision */ MPFR_ZIV_NEXT (ziv_loop, Nt); mpfr_set_prec (t, Nt); if (k_non_zero) mpfr_set_prec (u, Nt); } MPFR_ZIV_FREE (ziv_loop); if (k_non_zero) { int inex2; long lk; /* The rounded result in an unbounded exponent range is z * 2^k. As * MPFR chooses underflow after rounding, the mpfr_mul_2si below will * correctly detect underflows and overflows. However, in rounding to * nearest, if z * 2^k = 2^(emin - 2), then the double rounding may * affect the result. We need to cope with that before overwriting z. * This can occur only if k < 0 (this test is necessary to avoid a * potential integer overflow). * If inexact >= 0, then the real result is <= 2^(emin - 2), so that * o(2^(emin - 2)) = +0 is correct. If inexact < 0, then the real * result is > 2^(emin - 2) and we need to round to 2^(emin - 1). */ MPFR_ASSERTN (MPFR_EXP_MAX <= LONG_MAX); lk = mpfr_get_si (k, MPFR_RNDN); /* Due to early overflow detection, |k| should not be much larger than * MPFR_EMAX_MAX, and as MPFR_EMAX_MAX <= MPFR_EXP_MAX/2 <= LONG_MAX/2, * an overflow should not be possible in mpfr_get_si (and lk is exact). * And one even has the following assertion. TODO: complete proof. */ MPFR_ASSERTD (lk > LONG_MIN && lk < LONG_MAX); /* Note: even in case of overflow (lk inexact), the code is correct. * Indeed, for the 3 occurrences of lk: * - The test lk < 0 is correct as sign(lk) = sign(k). * - In the test MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk, * if lk is inexact, then lk = LONG_MIN <= MPFR_EXP_MIN * (the minimum value of the mpfr_exp_t type), and * __gmpfr_emin - 1 - lk >= MPFR_EMIN_MIN - 1 - 2 * MPFR_EMIN_MIN * >= - MPFR_EMIN_MIN - 1 = MPFR_EMAX_MAX - 1. However, from the * choice of k, z has been chosen to be around 1, so that the * result of the test is false, as if lk were exact. * - In the mpfr_mul_2si (z, z, lk, rnd_mode), if lk is inexact, * then |lk| >= LONG_MAX >= MPFR_EXP_MAX, and as z is around 1, * mpfr_mul_2si underflows or overflows in the same way as if * lk were exact. * TODO: give a bound on |t|, then on |EXP(z)|. */ if (rnd_mode == MPFR_RNDN && inexact < 0 && lk < 0 && MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk && mpfr_powerof2_raw (z)) { /* Rounding to nearest, real result > z * 2^k = 2^(emin - 2), * underflow case: as the minimum precision is > 1, we will * obtain the correct result and exceptions by replacing z by * nextabove(z). */ MPFR_ASSERTN (MPFR_PREC_MIN > 1); mpfr_nextabove (z); } MPFR_CLEAR_FLAGS (); inex2 = mpfr_mul_2si (z, z, lk, rnd_mode); if (inex2) /* underflow or overflow */ { inexact = inex2; if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, __gmpfr_flags); } mpfr_clears (u, k, (mpfr_ptr) 0); } mpfr_clear (t); /* update the sign of the result if x was negative */ if (neg_result) { MPFR_SET_NEG(z); inexact = -inexact; } return inexact; }
int mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_prec_t K0, K, precy, m, k, l; int inexact, reduce = 0; mpfr_t r, s, xr, c; mpfr_exp_t exps, cancel = 0, expx; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_GROUP_DECL (group); MPFR_LOG_FUNC ( ("x[%Pu]=%*.Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%*.Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else { MPFR_ASSERTD (MPFR_IS_ZERO (x)); return mpfr_set_ui (y, 1, rnd_mode); } } MPFR_SAVE_EXPO_MARK (expo); /* cos(x) = 1-x^2/2 + ..., so error < 2^(2*EXP(x)-1) */ expx = MPFR_GET_EXP (x); MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, -2 * expx, 1, 0, rnd_mode, expo, {}); /* Compute initial precision */ precy = MPFR_PREC (y); if (precy >= MPFR_SINCOS_THRESHOLD) { MPFR_SAVE_EXPO_FREE (expo); return mpfr_cos_fast (y, x, rnd_mode); } K0 = __gmpfr_isqrt (precy / 3); m = precy + 2 * MPFR_INT_CEIL_LOG2 (precy) + 2 * K0; if (expx >= 3) { reduce = 1; /* As expx + m - 1 will silently be converted into mpfr_prec_t in the mpfr_init2 call, the assert below may be useful to avoid undefined behavior. */ MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX); mpfr_init2 (c, expx + m - 1); mpfr_init2 (xr, m); } MPFR_GROUP_INIT_2 (group, m, r, s); MPFR_ZIV_INIT (loop, m); for (;;) { /* If |x| >= 4, first reduce x cmod (2*Pi) into xr, using mpfr_remainder: let e = EXP(x) >= 3, and m the target precision: (1) c <- 2*Pi [precision e+m-1, nearest] (2) xr <- remainder (x, c) [precision m, nearest] We have |c - 2*Pi| <= 1/2ulp(c) = 2^(3-e-m) |xr - x - k c| <= 1/2ulp(xr) <= 2^(1-m) |k| <= |x|/(2*Pi) <= 2^(e-2) Thus |xr - x - 2kPi| <= |k| |c - 2Pi| + 2^(1-m) <= 2^(2-m). It follows |cos(xr) - cos(x)| <= 2^(2-m). */ if (reduce) { mpfr_const_pi (c, MPFR_RNDN); mpfr_mul_2ui (c, c, 1, MPFR_RNDN); /* 2Pi */ mpfr_remainder (xr, x, c, MPFR_RNDN); if (MPFR_IS_ZERO(xr)) goto ziv_next; /* now |xr| <= 4, thus r <= 16 below */ mpfr_mul (r, xr, xr, MPFR_RNDU); /* err <= 1 ulp */ } else mpfr_mul (r, x, x, MPFR_RNDU); /* err <= 1 ulp */ /* now |x| < 4 (or xr if reduce = 1), thus |r| <= 16 */ /* we need |r| < 1/2 for mpfr_cos2_aux, i.e., EXP(r) - 2K <= -1 */ K = K0 + 1 + MAX(0, MPFR_GET_EXP(r)) / 2; /* since K0 >= 0, if EXP(r) < 0, then K >= 1, thus EXP(r) - 2K <= -3; otherwise if EXP(r) >= 0, then K >= 1/2 + EXP(r)/2, thus EXP(r) - 2K <= -1 */ MPFR_SET_EXP (r, MPFR_GET_EXP (r) - 2 * K); /* Can't overflow! */ /* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */ l = mpfr_cos2_aux (s, r); /* l is the error bound in ulps on s */ MPFR_SET_ONE (r); for (k = 0; k < K; k++) { mpfr_sqr (s, s, MPFR_RNDU); /* err <= 2*olderr */ MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); /* Can't overflow */ mpfr_sub (s, s, r, MPFR_RNDN); /* err <= 4*olderr */ if (MPFR_IS_ZERO(s)) goto ziv_next; MPFR_ASSERTD (MPFR_GET_EXP (s) <= 1); } /* The absolute error on s is bounded by (2l+1/3)*2^(2K-m) 2l+1/3 <= 2l+1. If |x| >= 4, we need to add 2^(2-m) for the argument reduction by 2Pi: if K = 0, this amounts to add 4 to 2l+1/3, i.e., to add 2 to l; if K >= 1, this amounts to add 1 to 2*l+1/3. */ l = 2 * l + 1; if (reduce) l += (K == 0) ? 4 : 1; k = MPFR_INT_CEIL_LOG2 (l) + 2*K; /* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */ exps = MPFR_GET_EXP (s); if (MPFR_LIKELY (MPFR_CAN_ROUND (s, exps + m - k, precy, rnd_mode))) break; if (MPFR_UNLIKELY (exps == 1)) /* s = 1 or -1, and except x=0 which was already checked above, cos(x) cannot be 1 or -1, so we can round if the error is less than 2^(-precy) for directed rounding, or 2^(-precy-1) for rounding to nearest. */ { if (m > k && (m - k >= precy + (rnd_mode == MPFR_RNDN))) { /* If round to nearest or away, result is s = 1 or -1, otherwise it is round(nexttoward (s, 0)). However in order to have the inexact flag correctly set below, we set |s| to 1 - 2^(-m) in all cases. */ mpfr_nexttozero (s); break; } } if (exps < cancel) { m += cancel - exps; cancel = exps; } ziv_next: MPFR_ZIV_NEXT (loop, m); MPFR_GROUP_REPREC_2 (group, m, r, s); if (reduce) { mpfr_set_prec (xr, m); mpfr_set_prec (c, expx + m - 1); } } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, s, rnd_mode); MPFR_GROUP_CLEAR (group); if (reduce) { mpfr_clear (xr); mpfr_clear (c); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
int mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode) { mpfr_t x; int inexact; MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", xt, xt, rnd_mode), ("y[%#R]=%R inexact=%d", y, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt))) { if (MPFR_IS_NAN (xt)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (xt)) { MPFR_SET_INF (y); MPFR_SET_SAME_SIGN (y, xt); MPFR_RET (0); } else /* xt is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (xt)); MPFR_SET_ZERO (y); /* sinh(0) = 0 */ MPFR_SET_SAME_SIGN (y, xt); MPFR_RET (0); } } /* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1, rnd_mode, {}); MPFR_TMP_INIT_ABS (x, xt); { mpfr_t t, ti; mp_exp_t d; mp_prec_t Nt; /* Precision of the intermediary variable */ long int err; /* Precision of error */ MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_GROUP_DECL (group); MPFR_SAVE_EXPO_MARK (expo); /* compute the precision of intermediary variable */ Nt = MAX (MPFR_PREC (x), MPFR_PREC (y)); /* the optimal number of bits : see algorithms.ps */ Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4; /* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */ if (MPFR_GET_EXP (x) < 0) Nt -= 2*MPFR_GET_EXP (x); /* initialise of intermediary variables */ MPFR_GROUP_INIT_2 (group, Nt, t, ti); /* First computation of sinh */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute sinh */ mpfr_clear_flags (); mpfr_exp (t, x, GMP_RNDD); /* exp(x) */ /* exp(x) can overflow! */ /* BUG/TODO/FIXME: exp can overflow but sinh may be representable! */ if (MPFR_UNLIKELY (mpfr_overflow_p ())) { inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt)); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW); break; } d = MPFR_GET_EXP (t); mpfr_ui_div (ti, 1, t, GMP_RNDU); /* 1/exp(x) */ mpfr_sub (t, t, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */ mpfr_div_2ui (t, t, 1, GMP_RNDN); /* 1/2(exp(x) - 1/exp(x)) */ /* it may be that t is zero (in fact, it can only occur when te=1, and thus ti=1 too) */ if (MPFR_IS_ZERO (t)) err = Nt; /* double the precision */ else { /* calculation of the error */ d = d - MPFR_GET_EXP (t) + 2; /* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/ err = Nt - (MAX (d, 0) + 1); if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y), rnd_mode))) { inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt)); break; } } /* actualisation of the precision */ Nt += err; MPFR_ZIV_NEXT (loop, Nt); MPFR_GROUP_REPREC_2 (group, Nt, t, ti); } MPFR_ZIV_FREE (loop); MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); } return mpfr_check_range (y, inexact, rnd_mode); }
int mpfr_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); }
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6 from Abramowitz & Stegun). Assumes |z| > p log(2)/2, where p is the target precision (z can be negative only for jn). Return 0 if the expansion does not converge enough (the value 0 as inexact flag should not happen for normal input). */ static int FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r) { mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u; mpfr_prec_t w; long k; int inex, stop, diverge = 0; mpfr_exp_t err2, err; MPFR_ZIV_DECL (loop); mpfr_init (c); w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4; MPFR_ZIV_INIT (loop, w); for (;;) { mpfr_set_prec (c, w); mpfr_init2 (s, w); mpfr_init2 (P, w); mpfr_init2 (Q, w); mpfr_init2 (t, w); mpfr_init2 (iz, w); mpfr_init2 (err_t, 31); mpfr_init2 (err_s, 31); mpfr_init2 (err_u, 31); /* Approximate sin(z) and cos(z). In the following, err <= k means that the approximate value y and the true value x are related by y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */ mpfr_sin_cos (s, c, z, MPFR_RNDN); if (MPFR_IS_NEG(z)) mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */ /* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */ mpfr_add (t, s, c, MPFR_RNDN); mpfr_sub (c, s, c, MPFR_RNDN); mpfr_swap (s, t); /* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z), with total absolute error bounded by 2^(1-w). */ /* precompute 1/(8|z|) */ mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */ mpfr_div_2ui (iz, iz, 3, MPFR_RNDN); /* compute P and Q */ mpfr_set_ui (P, 1, MPFR_RNDN); mpfr_set_ui (Q, 0, MPFR_RNDN); mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */ mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */ mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */ for (k = 1, stop = 0; stop < 4; k++) { /* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */ mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */ mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */ mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */ mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */ /* the relative error on t is bounded by (1+u)^(5k)-1, which is bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u| for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */ mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD); mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */ /* the absolute error on t is bounded by err_t * 2^(-w) */ mpfr_abs (err_u, t, MPFR_RNDU); mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */ mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */ if (stop >= 2) { /* take into account the neglected terms: t * 2^w */ mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU); if (MPFR_IS_POS(t)) mpfr_add (err_s, err_s, t, MPFR_RNDU); else mpfr_sub (err_s, err_s, t, MPFR_RNDU); mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU); stop ++; } /* if k is odd, add to Q, otherwise to P */ else if (k & 1) { /* if k = 1 mod 4, add, otherwise subtract */ if ((k & 2) == 0) mpfr_add (Q, Q, t, MPFR_RNDN); else mpfr_sub (Q, Q, t, MPFR_RNDN); /* check if the next term is smaller than ulp(Q): if EXP(err_u) <= EXP(Q), since the current term is bounded by err_u * 2^(-w), it is bounded by ulp(Q) */ if (MPFR_EXP(err_u) <= MPFR_EXP(Q)) stop ++; else stop = 0; } else { /* if k = 0 mod 4, add, otherwise subtract */ if ((k & 2) == 0) mpfr_add (P, P, t, MPFR_RNDN); else mpfr_sub (P, P, t, MPFR_RNDN); /* check if the next term is smaller than ulp(P) */ if (MPFR_EXP(err_u) <= MPFR_EXP(P)) stop ++; else stop = 0; } mpfr_add (err_s, err_s, err_t, MPFR_RNDU); /* the sum of the rounding errors on P and Q is bounded by err_s * 2^(-w) */ /* stop when start to diverge */ if (stop < 2 && ((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) || (MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0))) { /* if we have to stop the series because it diverges, then increasing the precision will most probably fail, since we will stop to the same point, and thus compute a very similar approximation */ diverge = 1; stop = 2; /* force stop */ } } /* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */ /* Now combine: the sum of the rounding errors on P and Q is bounded by err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */ if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn Q * (sin + cos) + P (sin - cos) for yn */ { #ifdef MPFR_JN mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */ mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */ #else mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */ mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */ #endif err = MPFR_EXP(c); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); #ifdef MPFR_JN mpfr_sub (s, s, c, MPFR_RNDN); #else mpfr_add (s, s, c, MPFR_RNDN); #endif } else /* n odd: P * (sin - cos) + Q (cos + sin) for jn, Q * (sin - cos) - P (cos + sin) for yn */ { #ifdef MPFR_JN mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */ mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */ #else mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */ mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */ #endif err = MPFR_EXP(c); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); #ifdef MPFR_JN mpfr_add (s, s, c, MPFR_RNDN); #else mpfr_sub (s, c, s, MPFR_RNDN); #endif } if ((n & 2) != 0) mpfr_neg (s, s, MPFR_RNDN); if (MPFR_EXP(s) > err) err = MPFR_EXP(s); /* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c) + err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1) <= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w), since |c|, |old_s| <= 2. */ err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2; /* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */ err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2; /* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */ err2 = (err >= err2) ? err + 1 : err2 + 1; /* now the absolute error on s is bounded by 2^(err2 - w) */ /* multiply by sqrt(1/(Pi*z)) */ mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */ mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */ mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */ mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is bounded by 3*u*|c| for |u| <= 0.25 */ mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD); mpfr_abs (err_t, err_t, MPFR_RNDU); mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU); /* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */ err2 += MPFR_EXP(c); /* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */ mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| + |old_c| * 2^(err2 - w) */ /* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */ err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1; /* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */ /* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */ err = (err >= err2) ? err + 1 : err2 + 1; /* the absolute error on c is bounded by 2^(err - w) */ mpfr_clear (s); mpfr_clear (P); mpfr_clear (Q); mpfr_clear (t); mpfr_clear (iz); mpfr_clear (err_t); mpfr_clear (err_s); mpfr_clear (err_u); err -= MPFR_EXP(c); if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r))) break; if (diverge != 0) { mpfr_set (c, z, r); /* will force inex=0 below, which means the asymptotic expansion failed */ break; } MPFR_ZIV_NEXT (loop, w); } MPFR_ZIV_FREE (loop); inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r) : mpfr_neg (res, c, r); mpfr_clear (c); return inex; }
int mpfr_acos (mpfr_ptr acos, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp, arcc, tmp; mpfr_exp_t supplement; mpfr_prec_t prec; int sign, compared, inexact; 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), ("acos[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(acos), mpfr_log_prec, acos, inexact)); /* Singular cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (acos); MPFR_RET_NAN; } else /* necessarily x=0 */ { MPFR_ASSERTD(MPFR_IS_ZERO(x)); /* acos(0)=Pi/2 */ MPFR_SAVE_EXPO_MARK (expo); inexact = mpfr_const_pi (acos, rnd_mode); mpfr_div_2ui (acos, acos, 1, rnd_mode); /* exact */ MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (acos, inexact, rnd_mode); } } /* Set x_p=|x| */ sign = MPFR_SIGN (x); mpfr_init2 (xp, MPFR_PREC (x)); mpfr_abs (xp, x, MPFR_RNDN); /* Exact */ compared = mpfr_cmp_ui (xp, 1); if (MPFR_UNLIKELY (compared >= 0)) { mpfr_clear (xp); if (compared > 0) /* acos(x) = NaN for x > 1 */ { MPFR_SET_NAN(acos); MPFR_RET_NAN; } else { if (MPFR_IS_POS_SIGN (sign)) /* acos(+1) = +0 */ return mpfr_set_ui (acos, 0, rnd_mode); else /* acos(-1) = Pi */ return mpfr_const_pi (acos, rnd_mode); } } MPFR_SAVE_EXPO_MARK (expo); /* Compute the supplement */ mpfr_ui_sub (xp, 1, xp, MPFR_RNDD); if (MPFR_IS_POS_SIGN (sign)) supplement = 2 - 2 * MPFR_GET_EXP (xp); else supplement = 2 - MPFR_GET_EXP (xp); mpfr_clear (xp); prec = MPFR_PREC (acos); prec += MPFR_INT_CEIL_LOG2(prec) + 10 + supplement; /* VL: The following change concerning prec comes from r3145 "Optimize mpfr_acos by choosing a better initial precision." but it doesn't seem to be correct and leads to problems (assertion failure or very important inefficiency) with tiny arguments. Therefore, I've disabled it. */ /* If x ~ 2^-N, acos(x) ~ PI/2 - x - x^3/6 If Prec < 2*N, we can't round since x^3/6 won't be counted. */ #if 0 if (MPFR_PREC (acos) >= MPFR_PREC (x) && MPFR_GET_EXP (x) < 0) { mpfr_uexp_t pmin = (mpfr_uexp_t) (-2 * MPFR_GET_EXP (x)) + 5; MPFR_ASSERTN (pmin <= MPFR_PREC_MAX); if (prec < pmin) prec = pmin; } #endif mpfr_init2 (tmp, prec); mpfr_init2 (arcc, prec); MPFR_ZIV_INIT (loop, prec); for (;;) { /* acos(x) = Pi/2 - asin(x) = Pi/2 - atan(x/sqrt(1-x^2)) */ mpfr_sqr (tmp, x, MPFR_RNDN); mpfr_ui_sub (tmp, 1, tmp, MPFR_RNDN); mpfr_sqrt (tmp, tmp, MPFR_RNDN); mpfr_div (tmp, x, tmp, MPFR_RNDN); mpfr_atan (arcc, tmp, MPFR_RNDN); mpfr_const_pi (tmp, MPFR_RNDN); mpfr_div_2ui (tmp, tmp, 1, MPFR_RNDN); mpfr_sub (arcc, tmp, arcc, MPFR_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (arcc, prec - supplement, MPFR_PREC (acos), rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec); mpfr_set_prec (tmp, prec); mpfr_set_prec (arcc, prec); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (acos, arcc, rnd_mode); mpfr_clear (tmp); mpfr_clear (arcc); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (acos, inexact, rnd_mode); }
int mpfr_fac_ui (mpfr_ptr y, unsigned long int x, mpfr_rnd_t rnd_mode) { mpfr_t t; /* Variable of Intermediary Calculation*/ unsigned long i; int round, inexact; mpfr_prec_t Ny; /* Precision of output variable */ mpfr_prec_t Nt; /* Precision of Intermediary Calculation variable */ mpfr_prec_t err; /* Precision of error */ mpfr_rnd_t rnd; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); /***** test x = 0 and x == 1******/ if (MPFR_UNLIKELY (x <= 1)) return mpfr_set_ui (y, 1, rnd_mode); /* 0! = 1 and 1! = 1 */ MPFR_SAVE_EXPO_MARK (expo); /* Initialisation of the Precision */ Ny = MPFR_PREC (y); /* compute the size of intermediary variable */ Nt = Ny + 2 * MPFR_INT_CEIL_LOG2 (x) + 7; mpfr_init2 (t, Nt); /* initialise of intermediary variable */ rnd = MPFR_RNDZ; MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute factorial */ inexact = mpfr_set_ui (t, 1, rnd); for (i = 2 ; i <= x ; i++) { round = mpfr_mul_ui (t, t, i, rnd); /* assume the first inexact product gives the sign of difference: is that always correct? */ if (inexact == 0) inexact = round; } err = Nt - 1 - MPFR_INT_CEIL_LOG2 (Nt); round = !inexact || mpfr_can_round (t, err, rnd, MPFR_RNDZ, Ny + (rnd_mode == MPFR_RNDN)); if (MPFR_LIKELY (round)) { /* If inexact = 0, then t is exactly x!, so round is the correct inexact flag. Otherwise, t != x! since we rounded to zero or away. */ round = mpfr_set (y, t, rnd_mode); if (inexact == 0) { inexact = round; break; } else if ((inexact < 0 && round <= 0) || (inexact > 0 && round >= 0)) break; else /* inexact and round have opposite signs: we cannot compute the inexact flag. Restart using the symmetric rounding. */ rnd = (rnd == MPFR_RNDZ) ? MPFR_RNDU : MPFR_RNDZ; } MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }
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); }
/* Don't need to save/restore exponent range: the cache does it */ int mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode) { mpfr_t a, A, B, D, S; mpfr_prec_t px, p, cancel, k, kmax; MPFR_ZIV_DECL (loop); int inex; MPFR_LOG_FUNC (("rnd_mode=%d", rnd_mode), ("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex)); px = MPFR_PREC (x); /* we need 9*2^kmax - 4 >= px+2*kmax+8 */ for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++); p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */ mpfr_init2 (a, p); mpfr_init2 (A, p); mpfr_init2 (B, p); mpfr_init2 (D, p); mpfr_init2 (S, p); MPFR_ZIV_INIT (loop, p); for (;;) { mpfr_set_ui (a, 1, MPFR_RNDN); /* a = 1 */ mpfr_set_ui (A, 1, MPFR_RNDN); /* A = a^2 = 1 */ mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */ mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */ #define b B #define ap a #define Ap A #define Bp B for (k = 0; ; k++) { /* invariant: 1/2 <= B <= A <= a < 1 */ mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */ mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */ mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */ mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */ mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */ mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */ mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */ mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */ mpfr_sub (S, Ap, Bp, MPFR_RNDN); MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0); cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p; /* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */ mpfr_mul_2ui (S, S, k, MPFR_RNDN); mpfr_sub (D, D, S, MPFR_RNDN); /* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */ if (cancel + k >= p) break; } #undef b #undef ap #undef Ap #undef Bp mpfr_div (A, B, D, MPFR_RNDN); /* MPFR_ASSERTN(p >= 2 * k + 8); */ if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode))) break; p += kmax; MPFR_ZIV_NEXT (loop, p); mpfr_set_prec (a, p); mpfr_set_prec (A, p); mpfr_set_prec (B, p); mpfr_set_prec (D, p); mpfr_set_prec (S, p); } MPFR_ZIV_FREE (loop); inex = mpfr_set (x, A, rnd_mode); mpfr_clear (a); mpfr_clear (A); mpfr_clear (B); mpfr_clear (D); mpfr_clear (S); return inex; }
/* Use the reflection formula Digamma(1-x) = Digamma(x) + Pi * cot(Pi*x), i.e., Digamma(x) = Digamma(1-x) - Pi * cot(Pi*x). Assume x < 1/2. */ static int mpfr_digamma_reflection (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_prec_t p = MPFR_PREC(y) + 10, q; mpfr_t t, u, v; mpfr_exp_t e1, expv; int inex; MPFR_ZIV_DECL (loop); /* we want that 1-x is exact with precision q: if 0 < x < 1/2, then q = PREC(x)-EXP(x) is ok, otherwise if -1 <= x < 0, q = PREC(x)-EXP(x) is ok, otherwise for x < -1, PREC(x) is ok if EXP(x) <= PREC(x), otherwise we need EXP(x) */ if (MPFR_EXP(x) < 0) q = MPFR_PREC(x) + 1 - MPFR_EXP(x); else if (MPFR_EXP(x) <= MPFR_PREC(x)) q = MPFR_PREC(x) + 1; else q = MPFR_EXP(x); mpfr_init2 (u, q); MPFR_DBGRES(inex = mpfr_ui_sub (u, 1, x, MPFR_RNDN)); MPFR_ASSERTN(inex == 0); /* if x is half an integer, cot(Pi*x) = 0, thus Digamma(x) = Digamma(1-x) */ mpfr_mul_2exp (u, u, 1, MPFR_RNDN); inex = mpfr_integer_p (u); mpfr_div_2exp (u, u, 1, MPFR_RNDN); if (inex) { inex = mpfr_digamma (y, u, rnd_mode); goto end; } mpfr_init2 (t, p); mpfr_init2 (v, p); MPFR_ZIV_INIT (loop, p); for (;;) { mpfr_const_pi (v, MPFR_RNDN); /* v = Pi*(1+theta) for |theta|<=2^(-p) */ mpfr_mul (t, v, x, MPFR_RNDN); /* (1+theta)^2 */ e1 = MPFR_EXP(t) - (mpfr_exp_t) p + 1; /* bound for t: err(t) <= 2^e1 */ mpfr_cot (t, t, MPFR_RNDN); /* cot(t * (1+h)) = cot(t) - theta * (1 + cot(t)^2) with |theta|<=t*h */ if (MPFR_EXP(t) > 0) e1 = e1 + 2 * MPFR_EXP(t) + 1; else e1 = e1 + 1; /* now theta * (1 + cot(t)^2) <= 2^e1 */ e1 += (mpfr_exp_t) p - MPFR_EXP(t); /* error is now 2^e1 ulps */ mpfr_mul (t, t, v, MPFR_RNDN); e1 ++; mpfr_digamma (v, u, MPFR_RNDN); /* error <= 1/2 ulp */ expv = MPFR_EXP(v); mpfr_sub (v, v, t, MPFR_RNDN); if (MPFR_EXP(v) < MPFR_EXP(t)) e1 += MPFR_EXP(t) - MPFR_EXP(v); /* scale error for t wrt new v */ /* now take into account the 1/2 ulp error for v */ if (expv - MPFR_EXP(v) - 1 > e1) e1 = expv - MPFR_EXP(v) - 1; else e1 ++; e1 ++; /* rounding error for mpfr_sub */ if (MPFR_CAN_ROUND (v, p - e1, MPFR_PREC(y), rnd_mode)) break; MPFR_ZIV_NEXT (loop, p); mpfr_set_prec (t, p); mpfr_set_prec (v, p); } MPFR_ZIV_FREE (loop); inex = mpfr_set (y, v, rnd_mode); mpfr_clear (t); mpfr_clear (v); end: mpfr_clear (u); return inex; }
/* agm(x,y) is between x and y, so we don't need to save exponent range */ int mpfr_agm (mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, mp_rnd_t rnd_mode) { int compare, inexact; mp_size_t s; mp_prec_t p, q; mp_limb_t *up, *vp, *tmpp; mpfr_t u, v, tmp; unsigned long n; /* number of iterations */ unsigned long err = 0; MPFR_ZIV_DECL (loop); MPFR_TMP_DECL(marker); MPFR_LOG_FUNC (("op2[%#R]=%R op1[%#R]=%R rnd=%d", op2,op2,op1,op1,rnd_mode), ("r[%#R]=%R inexact=%d", r, r, inexact)); /* Deal with special values */ if (MPFR_ARE_SINGULAR (op1, op2)) { /* If a or b is NaN, the result is NaN */ if (MPFR_IS_NAN(op1) || MPFR_IS_NAN(op2)) { MPFR_SET_NAN(r); MPFR_RET_NAN; } /* now one of a or b is Inf or 0 */ /* If a and b is +Inf, the result is +Inf. Otherwise if a or b is -Inf or 0, the result is NaN */ else if (MPFR_IS_INF(op1) || MPFR_IS_INF(op2)) { if (MPFR_IS_STRICTPOS(op1) && MPFR_IS_STRICTPOS(op2)) { MPFR_SET_INF(r); MPFR_SET_SAME_SIGN(r, op1); MPFR_RET(0); /* exact */ } else { MPFR_SET_NAN(r); MPFR_RET_NAN; } } else /* a and b are neither NaN nor Inf, and one is zero */ { /* If a or b is 0, the result is +0 since a sqrt is positive */ MPFR_ASSERTD (MPFR_IS_ZERO (op1) || MPFR_IS_ZERO (op2)); MPFR_SET_POS (r); MPFR_SET_ZERO (r); MPFR_RET (0); /* exact */ } } MPFR_CLEAR_FLAGS (r); /* If a or b is negative (excluding -Infinity), the result is NaN */ if (MPFR_UNLIKELY(MPFR_IS_NEG(op1) || MPFR_IS_NEG(op2))) { MPFR_SET_NAN(r); MPFR_RET_NAN; } /* Precision of the following calculus */ q = MPFR_PREC(r); p = q + MPFR_INT_CEIL_LOG2(q) + 15; MPFR_ASSERTD (p >= 7); /* see algorithms.tex */ s = (p - 1) / BITS_PER_MP_LIMB + 1; /* b (op2) and a (op1) are the 2 operands but we want b >= a */ compare = mpfr_cmp (op1, op2); if (MPFR_UNLIKELY( compare == 0 )) { mpfr_set (r, op1, rnd_mode); MPFR_RET (0); /* exact */ } else if (compare > 0) { mpfr_srcptr t = op1; op1 = op2; op2 = t; } /* Now b(=op2) >= a (=op1) */ MPFR_TMP_MARK(marker); /* Main loop */ MPFR_ZIV_INIT (loop, p); for (;;) { mp_prec_t eq; /* Init temporary vars */ MPFR_TMP_INIT (up, u, p, s); MPFR_TMP_INIT (vp, v, p, s); MPFR_TMP_INIT (tmpp, tmp, p, s); /* Calculus of un and vn */ mpfr_mul (u, op1, op2, GMP_RNDN); /* Faster since PREC(op) < PREC(u) */ mpfr_sqrt (u, u, GMP_RNDN); mpfr_add (v, op1, op2, GMP_RNDN); /* add with !=prec is still good*/ mpfr_div_2ui (v, v, 1, GMP_RNDN); n = 1; while (mpfr_cmp2 (u, v, &eq) != 0 && eq <= p - 2) { mpfr_add (tmp, u, v, GMP_RNDN); mpfr_div_2ui (tmp, tmp, 1, GMP_RNDN); /* See proof in algorithms.tex */ if (4*eq > p) { mpfr_t w; /* tmp = U(k) */ mpfr_init2 (w, (p + 1) / 2); mpfr_sub (w, v, u, GMP_RNDN); /* e = V(k-1)-U(k-1) */ mpfr_sqr (w, w, GMP_RNDN); /* e = e^2 */ mpfr_div_2ui (w, w, 4, GMP_RNDN); /* e*= (1/2)^2*1/4 */ mpfr_div (w, w, tmp, GMP_RNDN); /* 1/4*e^2/U(k) */ mpfr_sub (v, tmp, w, GMP_RNDN); err = MPFR_GET_EXP (tmp) - MPFR_GET_EXP (v); /* 0 or 1 */ mpfr_clear (w); break; } mpfr_mul (u, u, v, GMP_RNDN); mpfr_sqrt (u, u, GMP_RNDN); mpfr_swap (v, tmp); n ++; } /* the error on v is bounded by (18n+51) ulps, or twice if there was an exponent loss in the final subtraction */ err += MPFR_INT_CEIL_LOG2(18 * n + 51); /* 18n+51 should not overflow since n is about log(p) */ /* we should have n+2 <= 2^(p/4) [see algorithms.tex] */ if (MPFR_LIKELY (MPFR_INT_CEIL_LOG2(n + 2) <= p / 4 && MPFR_CAN_ROUND (v, p - err, q, rnd_mode))) break; /* Stop the loop */ /* Next iteration */ MPFR_ZIV_NEXT (loop, p); s = (p - 1) / BITS_PER_MP_LIMB + 1; } MPFR_ZIV_FREE (loop); /* Setting of the result */ inexact = mpfr_set (r, v, rnd_mode); /* Let's clean */ MPFR_TMP_FREE(marker); return inexact; /* agm(u,v) can be exact for u, v rational only for u=v. Proof (due to Nicolas Brisebarre): it suffices to consider u=1 and v<1. Then 1/AGM(1,v) = 2F1(1/2,1/2,1;1-v^2), and a theorem due to G.V. Chudnovsky states that for x a non-zero algebraic number with |x|<1, then 2F1(1/2,1/2,1;x) and 2F1(-1/2,1/2,1;x) are algebraically independent over Q. */ }
/* 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; }
/* We use the reflection formula Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t)) in order to treat the case x <= 1, i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x) */ int mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp, GammaTrial, tmp, tmp2; mpz_t fact; mpfr_prec_t realprec; int compared, is_integer; int inex = 0; /* 0 means: result gamma not set yet */ MPFR_GROUP_DECL (group); MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("gamma[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex)); /* Trivial cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) { if (MPFR_IS_NEG (x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } else { MPFR_SET_INF (gamma); MPFR_SET_POS (gamma); MPFR_RET (0); /* exact */ } } else /* x is zero */ { MPFR_ASSERTD(MPFR_IS_ZERO(x)); MPFR_SET_INF(gamma); MPFR_SET_SAME_SIGN(gamma, x); MPFR_SET_DIVBY0 (); MPFR_RET (0); /* exact */ } } /* Check for tiny arguments, where gamma(x) ~ 1/x - euler + .... We know from "Bound on Runs of Zeros and Ones for Algebraic Functions", Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal number of consecutive zeroes or ones after the round bit is n-1 for an input of n bits. But we need a more precise lower bound. Assume x has n bits, and 1/x is near a floating-point number y of n+1 bits. We can write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits. Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e). Two cases can happen: (i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y are themselves powers of two, i.e., x is a power of two; (ii) or X*Y is at distance at least one from 2^(f-e), thus |xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n). Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means that the distance |y-1/x| >= 2^(-2n) ufp(y). Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1, if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y), and round(1/x) with precision >= 2n+2 gives the correct result. If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1). A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)). */ if (MPFR_GET_EXP (x) + 2 <= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma))) { int sign = MPFR_SIGN (x); /* retrieve sign before possible override */ int special; MPFR_BLOCK_DECL (flags); MPFR_SAVE_EXPO_MARK (expo); /* for overflow cases, see below; this needs to be done before x possibly gets overridden. */ special = MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX && MPFR_IS_POS_SIGN (sign) && MPFR_IS_LIKE_RNDD (rnd_mode, sign) && mpfr_powerof2_raw (x); MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode)); if (inex == 0) /* x is a power of two */ { /* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */ if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign)) inex = 1; else { mpfr_nextbelow (gamma); inex = -1; } } else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) { /* Overflow in the division 1/x. This is a real overflow, except in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to the "- euler", the rounded value in unbounded exponent range is 0.111...11 * 2^emax (not an overflow). */ if (!special) MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags); } MPFR_SAVE_EXPO_FREE (expo); /* Note: an overflow is possible with an infinite result; in this case, the overflow flag will automatically be restored by mpfr_check_range. */ return mpfr_check_range (gamma, inex, rnd_mode); } is_integer = mpfr_integer_p (x); /* gamma(x) for x a negative integer gives NaN */ if (is_integer && MPFR_IS_NEG(x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } compared = mpfr_cmp_ui (x, 1); if (compared == 0) return mpfr_set_ui (gamma, 1, rnd_mode); /* if x is an integer that fits into an unsigned long, use mpfr_fac_ui if argument is not too large. If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)), so for u <= M(p), fac_ui should be faster. We approximate here M(p) by p*log(p)^2, which is not a bad guess. Warning: since the generic code does not handle exact cases, we want all cases where gamma(x) is exact to be treated here. */ if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN)) { unsigned long int u; mpfr_prec_t p = MPFR_PREC(gamma); u = mpfr_get_ui (x, MPFR_RNDN); if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN)) /* bits_fac: lower bound on the number of bits of m, where gamma(x) = (u-1)! = m*2^e with m odd. */ return mpfr_fac_ui (gamma, u - 1, rnd_mode); /* if bits_fac(...) > p (resp. p+1 for rounding to nearest), then gamma(x) cannot be exact in precision p (resp. p+1). FIXME: remove the test u < 44787929UL after changing bits_fac to return a mpz_t or mpfr_t. */ } MPFR_SAVE_EXPO_MARK (expo); /* check for overflow: according to (6.1.37) in Abramowitz & Stegun, gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi) >= 2 * (x/e)^x / x for x >= 1 */ if (compared > 0) { mpfr_t yp; mpfr_exp_t expxp; MPFR_BLOCK_DECL (flags); /* quick test for the default exponent range */ if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25) { MPFR_SAVE_EXPO_FREE (expo); return mpfr_gamma_aux (gamma, x, rnd_mode); } /* 1/e rounded down to 53 bits */ #define EXPM1_STR "0.010111100010110101011000110110001011001110111100111" mpfr_init2 (xp, 53); mpfr_init2 (yp, 53); mpfr_set_str_binary (xp, EXPM1_STR); mpfr_mul (xp, x, xp, MPFR_RNDZ); mpfr_sub_ui (yp, x, 2, MPFR_RNDZ); mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */ mpfr_set_str_binary (yp, EXPM1_STR); mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */ mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */ mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */ MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ)); expxp = MPFR_GET_EXP (xp); mpfr_clear (xp); mpfr_clear (yp); MPFR_SAVE_EXPO_FREE (expo); return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ? mpfr_overflow (gamma, rnd_mode, 1) : mpfr_gamma_aux (gamma, x, rnd_mode); } /* now compared < 0 */ /* check for underflow: for x < 1, gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x). Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have |gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))| <= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|. To avoid an underflow in ((2-x)/e)^x, we compute the logarithm. */ if (MPFR_IS_NEG(x)) { int underflow = 0, sgn, ck; mpfr_prec_t w; mpfr_init2 (xp, 53); mpfr_init2 (tmp, 53); mpfr_init2 (tmp2, 53); /* we want an upper bound for x * [log(2-x)-1]. since x < 0, we need a lower bound on log(2-x) */ mpfr_ui_sub (xp, 2, x, MPFR_RNDD); mpfr_log (xp, xp, MPFR_RNDD); mpfr_sub_ui (xp, xp, 1, MPFR_RNDD); mpfr_mul (xp, xp, x, MPFR_RNDU); /* we need an upper bound on 1/|sin(Pi*(2-x))|, thus a lower bound on |sin(Pi*(2-x))|. If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p) thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u, assuming u <= 1, thus <= u + 3Pi(2-x)u */ w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */ w += 17; /* to get tmp2 small enough */ mpfr_set_prec (tmp, w); mpfr_set_prec (tmp2, w); MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN)); MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */ mpfr_const_pi (tmp2, MPFR_RNDN); mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */ mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */ sgn = mpfr_sgn (tmp); mpfr_abs (tmp, tmp, MPFR_RNDN); mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */ mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */ mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU); /* if tmp2<|tmp|, we get a lower bound */ if (mpfr_cmp (tmp2, tmp) < 0) { mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */ mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */ mpfr_log2 (tmp, tmp, MPFR_RNDU); mpfr_add (xp, tmp, xp, MPFR_RNDU); /* The assert below checks that expo.saved_emin - 2 always fits in a long. FIXME if we want to allow mpfr_exp_t to be a long long, for instance. */ MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN); underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0; } mpfr_clear (xp); mpfr_clear (tmp); mpfr_clear (tmp2); if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */ { MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn); } } realprec = MPFR_PREC (gamma); /* we want both 1-x and 2-x to be exact */ { mpfr_prec_t w; w = mpfr_gamma_1_minus_x_exact (x); if (realprec < w) realprec = w; w = mpfr_gamma_2_minus_x_exact (x); if (realprec < w) realprec = w; } realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20; MPFR_ASSERTD(realprec >= 5); MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20, xp, tmp, tmp2, GammaTrial); mpz_init (fact); MPFR_ZIV_INIT (loop, realprec); for (;;) { mpfr_exp_t err_g; int ck; MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial); /* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */ ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */ MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */ mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */ mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */ mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */ err_g = MPFR_GET_EXP(GammaTrial); mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */ /* If tmp is +Inf, we compute exp(lngamma(x)). */ if (mpfr_inf_p (tmp)) { inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode); if (inex) goto end; else goto ziv_next; } err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial); /* let g0 the true value of Pi*(2-x), g the computed value. We have g = g0 + h with |h| <= |(1+u^2)-1|*g. Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g. The relative error is thus bounded by |(1+u^2)-1|*g/sin(g) <= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4. With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */ ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */ MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */ mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */ mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN); /* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u + (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2. For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <= 0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4 <= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */ mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN); /* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u]. For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2 <= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4. (1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u) = 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3 + (18+9*2^err_g)*u^4 <= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3 <= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2 <= 1 + (23 + 10*2^err_g)*u. The final error is thus bounded by (23 + 10*2^err_g) ulps, which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */ err_g = (err_g <= 2) ? 6 : err_g + 4; if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g, MPFR_PREC(gamma), rnd_mode))) break; ziv_next: MPFR_ZIV_NEXT (loop, realprec); } end: MPFR_ZIV_FREE (loop); if (inex == 0) inex = mpfr_set (gamma, GammaTrial, rnd_mode); MPFR_GROUP_CLEAR (group); mpz_clear (fact); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (gamma, inex, rnd_mode); }
int mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp; int compared, inexact; mpfr_prec_t prec; mpfr_exp_t xp_exp; 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), ("asin[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (asin), mpfr_log_prec, asin, inexact)); /* Special cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (asin); MPFR_RET_NAN; } else /* x = 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (asin); MPFR_SET_SAME_SIGN (asin, x); MPFR_RET (0); /* exact result */ } } /* asin(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (asin, x, -2 * MPFR_GET_EXP (x), 2, 1, rnd_mode, {}); /* Set x_p=|x| (x is a normal number) */ mpfr_init2 (xp, MPFR_PREC (x)); inexact = mpfr_abs (xp, x, MPFR_RNDN); MPFR_ASSERTD (inexact == 0); compared = mpfr_cmp_ui (xp, 1); MPFR_SAVE_EXPO_MARK (expo); if (MPFR_UNLIKELY (compared >= 0)) { mpfr_clear (xp); if (compared > 0) /* asin(x) = NaN for |x| > 1 */ { MPFR_SAVE_EXPO_FREE (expo); MPFR_SET_NAN (asin); MPFR_RET_NAN; } else /* x = 1 or x = -1 */ { if (MPFR_IS_POS (x)) /* asin(+1) = Pi/2 */ inexact = mpfr_const_pi (asin, rnd_mode); else /* asin(-1) = -Pi/2 */ { inexact = -mpfr_const_pi (asin, MPFR_INVERT_RND(rnd_mode)); MPFR_CHANGE_SIGN (asin); } mpfr_div_2ui (asin, asin, 1, rnd_mode); } } else { /* Compute exponent of 1 - ABS(x) */ mpfr_ui_sub (xp, 1, xp, MPFR_RNDD); MPFR_ASSERTD (MPFR_GET_EXP (xp) <= 0); MPFR_ASSERTD (MPFR_GET_EXP (x) <= 0); xp_exp = 2 - MPFR_GET_EXP (xp); /* Set up initial prec */ prec = MPFR_PREC (asin) + 10 + xp_exp; /* use asin(x) = atan(x/sqrt(1-x^2)) */ MPFR_ZIV_INIT (loop, prec); for (;;) { mpfr_set_prec (xp, prec); mpfr_sqr (xp, x, MPFR_RNDN); mpfr_ui_sub (xp, 1, xp, MPFR_RNDN); mpfr_sqrt (xp, xp, MPFR_RNDN); mpfr_div (xp, x, xp, MPFR_RNDN); mpfr_atan (xp, xp, MPFR_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (xp, prec - xp_exp, MPFR_PREC (asin), rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (asin, xp, rnd_mode); mpfr_clear (xp); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (asin, inexact, rnd_mode); }