/* 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. If x < 0, assumes y is an integer. */ 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 (in which case y not an integer was already filtered out). */ if (MPFR_IS_NEG (x)) { MPFR_ASSERTD (y_is_integer); if (mpfr_odd_p (y)) { neg_result = 1; rnd_mode = MPFR_INVERT_RND (rnd_mode); } } /* Compute the precision of intermediary variable. */ /* The increment 9 + MPFR_INT_CEIL_LOG2 (Nz) gives few Ziv failures in binary64 and binary128 formats: mfv5 -p53 -e1 mpfr_pow: 5903 / 6469.59 / 6686 mfv5 -p113 -e1 mpfr_pow: 10913 / 11989.46 / 12321 */ Nt = Nz + 9 + MPFR_INT_CEIL_LOG2 (Nz); /* initialize 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: * (a) if the precision of z is > 1, we will obtain the correct * result and exceptions by replacing z by nextabove(z). * (b) if the precision of z is 1, we first copy z to zcopy of * precision 2 bits and perform nextabove(zcopy). */ if (MPFR_PREC(z) >= 2) mpfr_nextabove (z); else { mpfr_t zcopy; mpfr_init2 (zcopy, MPFR_PREC(z) + 1); mpfr_set (zcopy, z, MPFR_RNDZ); mpfr_nextabove (zcopy); inex2 = mpfr_mul_2si (z, zcopy, lk, rnd_mode); mpfr_clear (zcopy); goto under_over; } } MPFR_CLEAR_FLAGS (); inex2 = mpfr_mul_2si (z, z, lk, rnd_mode); under_over: 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_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 main (void) { int j, k; mpfr_t x, y, z, t, y2, z2, t2; tests_start_mpfr (); mpfr_inits2 (SIZEX, x, y, z, t, y2, z2, t2, (mpfr_ptr) 0); mpfr_set_str1 (x, "0.5"); mpfr_ceil(y, x); if (mpfr_cmp_ui (y, 1)) { printf ("Error in mpfr_ceil for x=0.5: expected 1.0, got "); mpfr_print_binary(y); putchar('\n'); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_ceil(y, x); if (mpfr_cmp_ui(y,0)) { printf ("Error in mpfr_ceil for x=0.0: expected 0.0, got "); mpfr_print_binary(y); putchar('\n'); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_ceil(y, x); if (mpfr_cmp_ui(y,1)) { printf ("Error in mpfr_ceil for x=1.0: expected 1.0, got "); mpfr_print_binary(y); putchar('\n'); exit (1); } for (j=0;j<1000;j++) { mpfr_urandomb (x, RANDS); MPFR_EXP (x) = 2; for (k = 2; k <= SIZEX; k++) { mpfr_set_prec(y, k); mpfr_set_prec(y2, k); mpfr_set_prec(z, k); mpfr_set_prec(z2, k); mpfr_set_prec(t, k); mpfr_set_prec(t2, k); mpfr_floor(y, x); mpfr_set(y2, x, MPFR_RNDD); mpfr_trunc(z, x); mpfr_set(z2, x, MPFR_RNDZ); mpfr_ceil(t, x); mpfr_set(t2, x, MPFR_RNDU); if (!mpfr_eq(y, y2, k)) { printf("Error in floor, x = "); mpfr_print_binary(x); printf("\n"); printf("floor(x) = "); mpfr_print_binary(y); printf("\n"); printf("round(x, RNDD) = "); mpfr_print_binary(y2); printf("\n"); exit(1); } if (!mpfr_eq(z, z2, k)) { printf("Error in trunc, x = "); mpfr_print_binary(x); printf("\n"); printf("trunc(x) = "); mpfr_print_binary(z); printf("\n"); printf("round(x, RNDZ) = "); mpfr_print_binary(z2); printf("\n"); exit(1); } if (!mpfr_eq(y, y2, k)) { printf("Error in ceil, x = "); mpfr_print_binary(x); printf("\n"); printf("ceil(x) = "); mpfr_print_binary(t); printf("\n"); printf("round(x, RNDU) = "); mpfr_print_binary(t2); printf("\n"); exit(1); } MPFR_EXP(x)++; } } mpfr_clears (x, y, z, t, y2, z2, t2, (mpfr_ptr) 0); tests_end_mpfr (); return 0; }
/* Set iop to the integral part of op and fop to its fractional part */ int mpfr_modf (mpfr_ptr iop, mpfr_ptr fop, mpfr_srcptr op, mpfr_rnd_t rnd_mode) { mpfr_exp_t ope; mpfr_prec_t opq; int inexi, inexf; MPFR_LOG_FUNC (("op[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (op), mpfr_log_prec, op, rnd_mode), ("iop[%Pu]=%.*Rg fop[%Pu]=%.*Rg", mpfr_get_prec (iop), mpfr_log_prec, iop, mpfr_get_prec (fop), mpfr_log_prec, fop)); MPFR_ASSERTN (iop != fop); if ( MPFR_UNLIKELY (MPFR_IS_SINGULAR (op)) ) { if (MPFR_IS_NAN (op)) { MPFR_SET_NAN (iop); MPFR_SET_NAN (fop); MPFR_RET_NAN; } MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_SAME_SIGN (fop, op); if (MPFR_IS_INF (op)) { MPFR_SET_INF (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } else /* op is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (op)); MPFR_SET_ZERO (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } } ope = MPFR_GET_EXP (op); opq = MPFR_PREC (op); if (ope <= 0) /* 0 < |op| < 1 */ { inexf = (fop != op) ? mpfr_set (fop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_ZERO (iop); MPFR_RET (INEX(0, inexf)); } else if (ope >= opq) /* op has no fractional part */ { inexi = (iop != op) ? mpfr_set (iop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (fop, op); MPFR_SET_ZERO (fop); MPFR_RET (INEX(inexi, 0)); } else /* op has both integral and fractional parts */ { if (iop != op) { inexi = mpfr_rint_trunc (iop, op, rnd_mode); inexf = mpfr_frac (fop, op, rnd_mode); } else { MPFR_ASSERTN (fop != op); inexf = mpfr_frac (fop, op, rnd_mode); inexi = mpfr_rint_trunc (iop, op, rnd_mode); } MPFR_RET (INEX(inexi, inexf)); } }
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); }
void check64 (void) { mpfr_t x, t, u; mpfr_init (x); mpfr_init (t); mpfr_init (u); mpfr_set_prec (x, 29); mpfr_set_str_raw (x, "1.1101001000101111011010010110e-3"); mpfr_set_prec (t, 58); mpfr_set_str_raw (t, "0.11100010011111001001100110010111110110011000000100101E-1"); mpfr_set_prec (u, 29); mpfr_add (u, x, t, GMP_RNDD); mpfr_set_str_raw (t, "1.0101011100001000011100111110e-1"); if (mpfr_cmp (u, t)) { fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=29, prec(t)=58\n"); printf ("expected "); mpfr_out_str (stdout, 2, 29, t, GMP_RNDN); putchar ('\n'); printf ("got "); mpfr_out_str (stdout, 2, 29, u, GMP_RNDN); putchar ('\n'); exit(1); } mpfr_set_prec (x, 4); mpfr_set_str_raw (x, "-1.0E-2"); mpfr_set_prec (t, 2); mpfr_set_str_raw (t, "-1.1e-2"); mpfr_set_prec (u, 2); mpfr_add (u, x, t, GMP_RNDN); if (MPFR_MANT(u)[0] << 2) { fprintf (stderr, "result not normalized for prec=2\n"); mpfr_print_binary (u); putchar ('\n'); exit (1); } mpfr_set_str_raw (t, "-1.0e-1"); if (mpfr_cmp (u, t)) { fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=4, prec(t)=2\n"); printf ("expected -1.0e-1\n"); printf ("got "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN); putchar ('\n'); exit (1); } mpfr_set_prec (x, 8); mpfr_set_str_raw (x, "-0.10011010"); /* -77/128 */ mpfr_set_prec (t, 4); mpfr_set_str_raw (t, "-1.110e-5"); /* -7/128 */ mpfr_set_prec (u, 4); mpfr_add (u, x, t, GMP_RNDN); /* should give -5/8 */ mpfr_set_str_raw (t, "-1.010e-1"); if (mpfr_cmp (u, t)) { fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=8, prec(t)=4\n"); printf ("expected -1.010e-1\n"); printf ("got "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN); putchar ('\n'); exit (1); } mpfr_set_prec (x, 112); mpfr_set_prec (t, 98); mpfr_set_prec (u, 54); mpfr_set_str_raw (x, "-0.11111100100000000011000011100000101101010001000111E-401"); mpfr_set_str_raw (t, "0.10110000100100000101101100011111111011101000111000101E-464"); mpfr_add (u, x, t, GMP_RNDN); if (mpfr_cmp (u, x)) { fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=112, prec(t)=98\n"); exit (1); } mpfr_set_prec (x, 92); mpfr_set_prec (t, 86); mpfr_set_prec (u, 53); mpfr_set_d (x, -5.03525136761487735093e-74, GMP_RNDN); mpfr_set_d (t, 8.51539046314262304109e-91, GMP_RNDN); mpfr_add (u, x, t, GMP_RNDN); if (mpfr_get_d1 (u) != -5.0352513676148773509283672e-74) { fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=92, prec(t)=86\n"); exit (1); } mpfr_set_prec(x, 53); mpfr_set_prec(t, 76); mpfr_set_prec(u, 76); mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32"); mpfr_set_str_raw(t, "-0.1011000101110010000101111111011111010001110011110111100110101011110010011111"); mpfr_sub(u, x, t, GMP_RNDU); mpfr_set_str_raw(t, "0.1011000101110010000101111111011100111111101010011011110110101011101000000100"); if (mpfr_cmp(u,t)) { printf("expect "); mpfr_print_binary(t); putchar('\n'); fprintf (stderr, "mpfr_add failed for precisions 53-76\n"); exit(1); } mpfr_set_prec(x, 53); mpfr_set_prec(t, 108); mpfr_set_prec(u, 108); mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32"); mpfr_set_str_raw(t, "-0.101100010111001000010111111101111101000111001111011110011010101111001001111000111011001110011000000000111111"); mpfr_sub(u, x, t, GMP_RNDU); mpfr_set_str_raw(t, "0.101100010111001000010111111101110011111110101001101111011010101110100000001011000010101110011000000000111111"); if (mpfr_cmp(u,t)) { printf("expect "); mpfr_print_binary(t); putchar('\n'); fprintf(stderr, "mpfr_add failed for precisions 53-108\n"); exit(1); } mpfr_set_prec(x, 97); mpfr_set_prec(t, 97); mpfr_set_prec(u, 97); mpfr_set_str_raw(x, "0.1111101100001000000001011000110111101000001011111000100001000101010100011111110010000000000000000E-39"); mpfr_set_ui(t, 1, GMP_RNDN); mpfr_add(u, x, t, GMP_RNDN); mpfr_set_str_raw(x, "0.1000000000000000000000000000000000000000111110110000100000000101100011011110100000101111100010001E1"); if (mpfr_cmp(u,x)) { fprintf(stderr, "mpfr_add failed for precision 97\n"); exit(1); } mpfr_set_prec(x, 128); mpfr_set_prec(t, 128); mpfr_set_prec(u, 128); mpfr_set_str_raw(x, "0.10101011111001001010111011001000101100111101000000111111111011010100001100011101010001010111111101111010100110111111100101100010E-4"); mpfr_set(t, x, GMP_RNDN); mpfr_sub(u, x, t, GMP_RNDN); mpfr_set_prec(x, 96); mpfr_set_prec(t, 96); mpfr_set_prec(u, 96); mpfr_set_str_raw(x, "0.111000000001110100111100110101101001001010010011010011100111100011010100011001010011011011000010E-4"); mpfr_set(t, x, GMP_RNDN); mpfr_sub(u, x, t, GMP_RNDN); mpfr_set_prec(x, 85); mpfr_set_prec(t, 85); mpfr_set_prec(u, 85); mpfr_set_str_raw(x, "0.1111101110100110110110100010101011101001100010100011110110110010010011101100101111100E-4"); mpfr_set_str_raw(t, "0.1111101110100110110110100010101001001000011000111000011101100101110100001110101010110E-4"); mpfr_sub(u, x, t, GMP_RNDU); mpfr_sub(x, x, t, GMP_RNDU); if (mpfr_cmp(x, u) != 0) { printf("Error in mpfr_sub: u=x-t and x=x-t give different results\n"); exit(1); } if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) { printf("Error in mpfr_sub: result is not msb-normalized (1)\n"); exit(1); } mpfr_set_prec(x, 65); mpfr_set_prec(t, 65); mpfr_set_prec(u, 65); mpfr_set_str_raw(x, "0.10011010101000110101010000000011001001001110001011101011111011101E623"); mpfr_set_str_raw(t, "0.10011010101000110101010000000011001001001110001011101011111011100E623"); mpfr_sub(u, x, t, GMP_RNDU); if (mpfr_get_d1 (u) != 9.4349060620538533806e167) { /* 2^558 */ printf("Error (1) in mpfr_sub\n"); exit(1); } mpfr_set_prec(x, 64); mpfr_set_prec(t, 64); mpfr_set_prec(u, 64); mpfr_set_str_raw(x, "0.1000011110101111011110111111000011101011101111101101101100000100E-220"); mpfr_set_str_raw(t, "0.1000011110101111011110111111000011101011101111101101010011111101E-220"); mpfr_add(u, x, t, GMP_RNDU); if ((MPFR_MANT(u)[0] & 1) != 1) { printf("error in mpfr_add with rnd_mode=GMP_RNDU\n"); printf("b= "); mpfr_print_binary(x); putchar('\n'); printf("c= "); mpfr_print_binary(t); putchar('\n'); printf("b+c="); mpfr_print_binary(u); putchar('\n'); exit(1); } /* bug found by Norbert Mueller, 14 Sep 2000 */ mpfr_set_prec(x, 56); mpfr_set_prec(t, 83); mpfr_set_prec(u, 10); mpfr_set_str_raw(x, "0.10001001011011001111101100110100000101111010010111010111E-7"); mpfr_set_str_raw(t, "0.10001001011011001111101100110100000101111010010111010111000000000111110110110000100E-7"); mpfr_sub(u, x, t, GMP_RNDU); /* array bound write found by Norbert Mueller, 26 Sep 2000 */ mpfr_set_prec(x, 109); mpfr_set_prec(t, 153); mpfr_set_prec(u, 95); mpfr_set_str_raw(x,"0.1001010000101011101100111000110001111111111111111111111111111111111111111111111111111111111111100000000000000E33"); mpfr_set_str_raw(t,"-0.100101000010101110110011100011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011100101101000000100100001100110111E33"); mpfr_add(u, x, t, GMP_RNDN); /* array bound writes found by Norbert Mueller, 27 Sep 2000 */ mpfr_set_prec(x, 106); mpfr_set_prec(t, 53); mpfr_set_prec(u, 23); mpfr_set_str_raw(x, "-0.1000011110101111111001010001000100001011000000000000000000000000000000000000000000000000000000000000000000E-59"); mpfr_set_str_raw(t, "-0.10000111101011111110010100010001101100011100110100000E-59"); mpfr_sub(u, x, t, GMP_RNDN); mpfr_set_prec(x, 177); mpfr_set_prec(t, 217); mpfr_set_prec(u, 160); mpfr_set_str_raw(x, "-0.111010001011010000111001001010010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E35"); mpfr_set_str_raw(t, "0.1110100010110100001110010010100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111011010011100001111001E35"); mpfr_add(u, x, t, GMP_RNDN); mpfr_set_prec(x, 214); mpfr_set_prec(t, 278); mpfr_set_prec(u, 207); mpfr_set_str_raw(x, "0.1000100110100110101101101101000000010000100111000001001110001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E66"); mpfr_set_str_raw(t, "-0.10001001101001101011011011010000000100001001110000010011100010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111011111001001100011E66"); mpfr_add(u, x, t, GMP_RNDN); mpfr_set_prec(x, 32); mpfr_set_prec(t, 247); mpfr_set_prec(u, 223); mpfr_set_str_raw(x, "0.10000000000000000000000000000000E1"); mpfr_set_str_raw(t, "0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100000100011110000101110110011101110100110110111111011010111100100000000000000000000000000E0"); mpfr_sub(u, x, t, GMP_RNDN); if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) { printf("Error in mpfr_sub: result is not msb-normalized (2)\n"); exit(1); } /* bug found by Nathalie Revol, 21 March 2001 */ mpfr_set_prec (x, 65); mpfr_set_prec (t, 65); mpfr_set_prec (u, 65); mpfr_set_str_raw (x, "0.11100100101101001100111011111111110001101001000011101001001010010E-35"); mpfr_set_str_raw (t, "0.10000000000000000000000000000000000001110010010110100110011110000E1"); mpfr_sub (u, t, x, GMP_RNDU); if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) { fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (3)\n"); exit (1); } /* bug found by Fabrice Rouillier, 27 Mar 2001 */ mpfr_set_prec (x, 107); mpfr_set_prec (t, 107); mpfr_set_prec (u, 107); mpfr_set_str_raw (x, "0.10111001001111010010001000000010111111011011011101000001001000101000000000000000000000000000000000000000000E315"); mpfr_set_str_raw (t, "0.10000000000000000000000000000000000101110100100101110110000001100101011111001000011101111100100100111011000E350"); mpfr_sub (u, x, t, GMP_RNDU); if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) { fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (4)\n"); exit (1); } /* checks that NaN flag is correctly reset */ mpfr_set_d (t, 1.0, GMP_RNDN); mpfr_set_d (u, 1.0, GMP_RNDN); mpfr_set_nan (x); mpfr_add (x, t, u, GMP_RNDN); if (mpfr_cmp_ui (x, 2)) { fprintf (stderr, "Error in mpfr_add: 1+1 gives %e\n", mpfr_get_d1 (x)); exit (1); } mpfr_clear(x); mpfr_clear(t); mpfr_clear(u); }
int main (int argc, char *argv[]) { mpfr_t x, y, z, ax; long int iy; mpfr_init (x); mpfr_init (ax); mpfr_init2 (y,sizeof(unsigned long int)*CHAR_BIT); mpfr_init (z); MPFR_SET_NAN(x); mpfr_random(y); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_NAN(z)) { printf ("evaluation of function in x=NAN does not return NAN"); exit (1); } MPFR_SET_NAN(y); mpfr_random(x); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_NAN(z)) { printf ("evaluation of function in y=NAN does not return NAN"); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_ZERO(y); mpfr_random(x); mpfr_pow (z, x,y, GMP_RNDN); if(mpfr_cmp_ui(z,1)!=0 && !(MPFR_IS_NAN(x))) { printf ("evaluation of function in y=0 does not return 1\n"); printf ("x ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_INF(y); if (MPFR_SIGN(y) < 0) MPFR_CHANGE_SIGN(y); mpfr_random(x); mpfr_set_prec (ax, MPFR_PREC(x)); mpfr_abs(ax,x,GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); if( !MPFR_IS_INF(z) && (mpfr_cmp_ui(ax,1) > 0) ) { printf ("evaluation of function in y=INF (|x|>1) does not return INF"); exit (1); } if( !MPFR_IS_ZERO(z) && (mpfr_cmp_ui(ax,1) < 0) ) { printf ("\nevaluation of function in y=INF (|x|<1) does not return 0"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_INF(y); if (MPFR_SIGN(y) > 0) MPFR_CHANGE_SIGN(y); mpfr_random(x); mpfr_set_prec (ax, MPFR_PREC(x)); mpfr_abs(ax,x,GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); if( !MPFR_IS_INF(z) && (mpfr_cmp_ui(ax,1) < 0) ) { printf ("evaluation of function in y=INF (for |x| <0) does not return INF"); exit (1); } if( !MPFR_IS_ZERO(z) && (mpfr_cmp_ui(ax,1) > 0) ) { printf ("evaluation of function in y=INF (for |x| >0) does not return 0"); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_INF(x); if (MPFR_SIGN(x) < 0) MPFR_CHANGE_SIGN(x); mpfr_random(y); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0)) { printf ("evaluation of function in INF does not return INF"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0)) { printf ("evaluation of function in INF does not return INF"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_INF(x); if (MPFR_SIGN(x) > 0) MPFR_CHANGE_SIGN(x); mpfr_random(y); if (random() % 2) mpfr_neg (y, y, GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in x=-INF does not return INF"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); if(mpfr_isinteger(y)) printf("y is an integer\n"); else printf("y is not an integer\n"); exit (1); } if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in x=-INF does not return 0"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); if(mpfr_isinteger(y)) printf("y is an integer\n"); else printf("y is not an integer\n"); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_INF(x); if (MPFR_SIGN(x) > 0) MPFR_CHANGE_SIGN(x); iy=random(); mpfr_random(y); if (random() % 2) iy=-iy; mpfr_set_d(y,iy,GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in x=-INF does not return INF"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); if(mpfr_isinteger(y)) printf("y is an integer\n"); else printf("y is not an integer\n"); exit (1); } if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in x=-INF does not return 0"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); if(mpfr_isinteger(y)) printf("y is an integer\n"); else printf("y is not an integer\n"); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); mpfr_set_ui(x,1,GMP_RNDN); MPFR_SET_INF(y); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_NAN(z)) { printf ("evaluation of function in x=1, y=INF does not return NAN"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } MPFR_CLEAR_FLAGS(z); MPFR_CLEAR_FLAGS(y); MPFR_CLEAR_FLAGS(x); MPFR_SET_ZERO(x); mpfr_random(y); if (random() % 2) mpfr_neg (y, y, GMP_RNDN); mpfr_pow (z, x,y, GMP_RNDN); if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && !(mpfr_isinteger(y))) { printf ("evaluation of function in y<0 does not return 0"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in y<0 (y integer) does not return INF"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y))) { printf ("evaluation of function in y<0 (y integer) does not return 0"); printf ("\nx ="); mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN); printf ("\n y ="); mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN); printf ("\n result ="); mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN); putchar('\n'); exit (1); } { mp_prec_t prec, yprec; mpfr_t t, s; mp_rnd_t rnd; int inexact, compare, compare2; unsigned int n, err; int p0=2; int p1=100; int N=100; mpfr_init (s); mpfr_init (t); /* generic test */ for (prec = p0; prec <= p1; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (s, sizeof(unsigned long int)*CHAR_BIT); mpfr_set_prec (z, prec); mpfr_set_prec (t, prec); yprec = prec + 10; for (n=0; n<N; n++) { mpfr_random (x); mpfr_random (s); if (random() % 2) mpfr_neg (s, s, GMP_RNDN); rnd = random () % 4; mpfr_set_prec (y, yprec); compare = mpfr_pow (y, x, s, rnd); err = (rnd == GMP_RNDN) ? yprec + 1 : yprec; if (mpfr_can_round (y, err, rnd, rnd, prec)) { mpfr_set (t, y, rnd); inexact = mpfr_pow (z,x, s, rnd); if (mpfr_cmp (t, z)) { printf ("results differ for x="); mpfr_out_str (stdout, 2, prec, x, GMP_RNDN); printf (" values of the exponential="); mpfr_out_str (stdout, 2, prec, s, GMP_RNDN); printf (" prec=%u rnd_mode=%s\n", (unsigned) prec, mpfr_print_rnd_mode (rnd)); printf ("got "); mpfr_out_str (stdout, 2, prec, z, GMP_RNDN); putchar ('\n'); printf ("expected "); mpfr_out_str (stdout, 2, prec, t, GMP_RNDN); putchar ('\n'); printf ("approx "); mpfr_print_binary (y); putchar ('\n'); exit (1); } compare2 = mpfr_cmp (t, y); /* if rounding to nearest, cannot know the sign of t - f(x) because of composed rounding: y = o(f(x)) and t = o(y) */ if ((rnd != GMP_RNDN) && (compare * compare2 >= 0)) compare = compare + compare2; else compare = inexact; /* cannot determine sign(t-f(x)) */ if (((inexact == 0) && (compare != 0)) || ((inexact > 0) && (compare <= 0)) || ((inexact < 0) && (compare >= 0))) { fprintf (stderr, "Wrong inexact flag for rnd=%s: expected %d, got %d\n", mpfr_print_rnd_mode (rnd), compare, inexact); printf ("x="); mpfr_print_binary (x); putchar ('\n'); printf ("y="); mpfr_print_binary (y); putchar ('\n'); printf ("t="); mpfr_print_binary (t); putchar ('\n'); exit (1); } } } } mpfr_clear (s); mpfr_clear (t); } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (ax); return 0; }
int main(){ double max; double tmp; double resDet; mpfr_t det; double mulTmp; mpfr_t tmp1; mpfr_t tmp2; mpfr_t logAbsDet; int i,j,k,maxRow,sign; char f_name[50]; double* buffer; mpfr_init(det); mpfr_init(tmp1); mpfr_init(tmp2); mpfr_init(logAbsDet); buffer = malloc(size*size*sizeof(double)); sprintf(f_name,"m5000x5000.bin"); FILE *datafile=fopen(f_name,"rb"); for(i=0;i<size;i++){ for(j=0;j<size;j++){ *(buffer+size*i+j)=0; } } for(i=0;i<size;i++){ for(j=0;j<size;j++){ fread(buffer+(size*i+j),sizeof(double),1,datafile); } } for(i=0;i<size;i++){ for(j=0;j<size;j++){ printf("%lf\t",*(buffer+(size*i+j))); } printf("\n"); } for(i=0;i<size-1;i++){ maxRow = i; max = *(buffer+(size*i+i)); for(j=i+1;j<size;j++){ if(fabs(max)<fabs(*(buffer+size*j+i))){ max = *(buffer+size*j+i); maxRow=j; } } if(fabs(max)<0.000001){ resDet =0; printf("det=%e\n",resDet); exit(1); } if(maxRow!=i){ sign++; for(j=i;j<size;j++){ tmp = *(buffer + size*i+j); *(buffer+size*i+j) = *(buffer + size*maxRow+j); *(buffer+size*maxRow+j) = tmp; } } for(j=i+1;j<size;j++){ mulTmp = *(buffer+size*j+i) / *(buffer+size*i+i); for(k=i;k<size;k++){ *(buffer+size*j+k) = *(buffer+size*j+k)-*(buffer + size*i+k)*mulTmp; } } } mpfr_set_d(tmp1,1.0,GMP_RNDN); for(i=0;i<size;i++){ mpfr_set_d(tmp2,*(buffer+size*i+i),GMP_RNDN); mpfr_mul(tmp1,tmp2,tmp1,GMP_RNDN); } if(sign%2==0){ mpfr_set(det,tmp1,GMP_RNDN); resDet=mpfr_get_d(det,GMP_RNDN); mpfr_log10(logAbsDet,det,GMP_RNDN); } else{ mpfr_neg(tmp1,tmp1,GMP_RNDN); mpfr_set(det,tmp1,GMP_RNDN); resDet=mpfr_get_d(det,GMP_RNDN); mpfr_log10(logAbsDet,det,GMP_RNDN); } //mpf_abs(absDet,det); // mpf_set(logAbsDet, mpfr_log10(absDet)); // mpfr_printf("det= %Fe\n",det); printf("det= %e\n",resDet); mpfr_printf("log(abs(det))= %Fe\n",logAbsDet); //gmp_printf("log(abs(det)= %e\n",logAbsDet); double END = clock(); printf("%f\n",END/CLOCKS_PER_SEC); mpfr_clear(det); mpfr_clear(tmp1); mpfr_clear(tmp2); mpfr_clear(logAbsDet); free(buffer); return 0; }
void externalPlot(char *library, mpfr_t a, mpfr_t b, mp_prec_t samplingPrecision, int random, node *func, int mode, mp_prec_t prec, char *name, int type) { void *descr; void (*myFunction)(mpfr_t, mpfr_t); char *error; mpfr_t x_h,x,y,temp,perturb,ulp,min_value; double xd, yd; FILE *file; gmp_randstate_t state; char *gplotname; char *dataname; char *outputname; gmp_randinit_default (state); if(samplingPrecision > prec) { sollyaFprintf(stderr, "Error: you must use a sampling precision lower than the current precision\n"); return; } descr = dlopen(library, RTLD_NOW); if (descr==NULL) { sollyaFprintf(stderr, "Error: the given library (%s) is not available (%s)!\n",library,dlerror()); return; } dlerror(); /* Clear any existing error */ myFunction = (void (*)(mpfr_t, mpfr_t)) dlsym(descr, "f"); if ((error = dlerror()) != NULL) { sollyaFprintf(stderr, "Error: the function f cannot be found in library %s (%s)\n",library,error); return; } if(name==NULL) { gplotname = (char *)safeCalloc(13 + strlen(PACKAGE_NAME), sizeof(char)); sprintf(gplotname,"/tmp/%s-%04d.p",PACKAGE_NAME,fileNumber); dataname = (char *)safeCalloc(15 + strlen(PACKAGE_NAME), sizeof(char)); sprintf(dataname,"/tmp/%s-%04d.dat",PACKAGE_NAME,fileNumber); outputname = (char *)safeCalloc(1, sizeof(char)); fileNumber++; if (fileNumber >= NUMBEROFFILES) fileNumber=0; } else { gplotname = (char *)safeCalloc(strlen(name)+3,sizeof(char)); sprintf(gplotname,"%s.p",name); dataname = (char *)safeCalloc(strlen(name)+5,sizeof(char)); sprintf(dataname,"%s.dat",name); outputname = (char *)safeCalloc(strlen(name)+5,sizeof(char)); if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sprintf(outputname,"%s.eps",name); } /* Beginning of the interesting part of the code */ file = fopen(gplotname, "w"); if (file == NULL) { sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",gplotname); sollyaFprintf(stderr,"\"%s\".\n",strerror(errno)); return; } sollyaFprintf(file, "# Gnuplot script generated by %s\n",PACKAGE_NAME); if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sollyaFprintf(file,"set terminal postscript eps color\nset out \"%s\"\n",outputname); sollyaFprintf(file, "set xrange [%1.50e:%1.50e]\n", mpfr_get_d(a, GMP_RNDD),mpfr_get_d(b, GMP_RNDU)); sollyaFprintf(file, "plot \"%s\" using 1:2 with dots t \"\"\n",dataname); fclose(file); file = fopen(dataname, "w"); if (file == NULL) { sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",dataname); sollyaFprintf(stderr,"\"%s\".\n",strerror(errno)); return; } mpfr_init2(x_h,samplingPrecision); mpfr_init2(perturb, prec); mpfr_init2(x,prec); mpfr_init2(y,prec); mpfr_init2(temp,prec); mpfr_init2(ulp,prec); mpfr_init2(min_value,53); mpfr_sub(min_value, b, a, GMP_RNDN); mpfr_div_2ui(min_value, min_value, 12, GMP_RNDN); mpfr_set(x_h,a,GMP_RNDD); while(mpfr_less_p(x_h,b)) { mpfr_set(x, x_h, GMP_RNDN); // exact if (mpfr_zero_p(x_h)) { mpfr_set(x_h, min_value, GMP_RNDU); } else { if (mpfr_cmpabs(x_h, min_value) < 0) mpfr_set_d(x_h, 0., GMP_RNDN); else mpfr_nextabove(x_h); } if(random) { mpfr_sub(ulp, x_h, x, GMP_RNDN); mpfr_urandomb(perturb, state); mpfr_mul(perturb, perturb, ulp, GMP_RNDN); mpfr_add(x, x, perturb, GMP_RNDN); } (*myFunction)(temp,x); evaluateFaithful(y, func, x,prec); mpfr_sub(temp, temp, y, GMP_RNDN); if(mode==RELATIVE) mpfr_div(temp, temp, y, GMP_RNDN); xd = mpfr_get_d(x, GMP_RNDN); if (xd >= MAX_VALUE_GNUPLOT) xd = MAX_VALUE_GNUPLOT; if (xd <= -MAX_VALUE_GNUPLOT) xd = -MAX_VALUE_GNUPLOT; sollyaFprintf(file, "%1.50e",xd); if (!mpfr_number_p(temp)) { if (verbosity >= 2) { changeToWarningMode(); sollyaPrintf("Information: function undefined or not evaluable in point %s = ",variablename); printValue(&x); sollyaPrintf("\nThis point will not be plotted.\n"); restoreMode(); } } yd = mpfr_get_d(temp, GMP_RNDN); if (yd >= MAX_VALUE_GNUPLOT) yd = MAX_VALUE_GNUPLOT; if (yd <= -MAX_VALUE_GNUPLOT) yd = -MAX_VALUE_GNUPLOT; sollyaFprintf(file, "\t%1.50e\n", yd); } fclose(file); /* End of the interesting part.... */ dlclose(descr); mpfr_clear(x); mpfr_clear(y); mpfr_clear(x_h); mpfr_clear(temp); mpfr_clear(perturb); mpfr_clear(ulp); mpfr_clear(min_value); if ((name==NULL) || (type==PLOTFILE)) { if (fork()==0) { daemon(1,1); execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL); perror("An error occurred when calling gnuplot "); exit(1); } else wait(NULL); } else { /* Case we have an output: no daemon */ if (fork()==0) { execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL); perror("An error occurred when calling gnuplot "); exit(1); } else { wait(NULL); if((type==PLOTPOSTSCRIPT)) { remove(gplotname); remove(dataname); } } } free(gplotname); free(dataname); free(outputname); return; }
int mpfr_acosh (mpfr_ptr y, mpfr_srcptr x , mp_rnd_t rnd_mode) { int inexact =0; int comp; if (MPFR_IS_NAN(x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } comp=mpfr_cmp_ui(x,1); if(comp < 0) { MPFR_SET_NAN(y); MPFR_RET_NAN; } MPFR_CLEAR_NAN(y); if(comp == 0) { MPFR_SET_ZERO(y); /* acosh(1) = 0 */ MPFR_SET_POS(y); MPFR_RET(0); } if (MPFR_IS_INF(x)) { MPFR_SET_INF(y); MPFR_SET_POS(y); MPFR_RET(0); } MPFR_CLEAR_INF(y); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, te,ti; /* Declaration of the size variable */ mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */ mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */ mp_prec_t Nt; /* Precision of the intermediary variable */ int err; /* Precision of error */ /* compute the precision of intermediary variable */ Nt=MAX(Nx,Ny); /* the optimal number of bits : see algorithms.ps */ Nt=Nt+4+_mpfr_ceil_log2(Nt); /* initialise of intermediary variable */ mpfr_init(t); mpfr_init(te); mpfr_init(ti); /* First computation of cosh */ do { /* reactualisation of the precision */ mpfr_set_prec(t,Nt); mpfr_set_prec(te,Nt); mpfr_set_prec(ti,Nt); /* compute acosh */ mpfr_mul(te,x,x,GMP_RNDD); /* (x^2) */ mpfr_sub_ui(ti,te,1,GMP_RNDD); /* (x^2-1) */ mpfr_sqrt(t,ti,GMP_RNDN); /* sqrt(x^2-1) */ mpfr_add(t,t,x,GMP_RNDN); /* sqrt(x^2-1)+x */ mpfr_log(t,t,GMP_RNDN); /* ln(sqrt(x^2-1)+x)*/ /* estimation of the error see- algorithms.ps*/ /*err=Nt-_mpfr_ceil_log2(0.5+pow(2,2-MPFR_EXP(t))+pow(2,1+MPFR_EXP(te)-MPFR_EXP(ti)-MPFR_EXP(t)));*/ err=Nt-(-1+2*MAX(2+MAX(2-MPFR_EXP(t),1+MPFR_EXP(te)-MPFR_EXP(ti)-MPFR_EXP(t)),0)); /* actualisation of the precision */ Nt += 10; } while ((err<0) ||!mpfr_can_round(t,err,GMP_RNDN,rnd_mode,Ny)); inexact = mpfr_set(y,t,rnd_mode); mpfr_clear(t); mpfr_clear(ti); mpfr_clear(te); } return inexact; }
int mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r) { int inex; unsigned long absn; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex)); absn = SAFE_ABS (unsigned long, n); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z))) { if (MPFR_IS_NAN (z)) { MPFR_SET_NAN (res); /* y(n,NaN) = NaN */ MPFR_RET_NAN; } /* y(n,z) tends to zero when z goes to +Inf, oscillating around 0. We choose to return +0 in that case. */ else if (MPFR_IS_INF (z)) { if (MPFR_SIGN(z) > 0) return mpfr_set_ui (res, 0, r); else /* y(n,-Inf) = NaN */ { MPFR_SET_NAN (res); MPFR_RET_NAN; } } else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise, when z goes to zero */ { MPFR_SET_INF(res); if (n >= 0 || ((unsigned long) n & 1) == 0) MPFR_SET_NEG(res); else MPFR_SET_POS(res); mpfr_set_divby0 (); MPFR_RET(0); } } /* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we assume does not happen for a rational z. */ if (MPFR_SIGN(z) < 0) { MPFR_SET_NAN (res); MPFR_RET_NAN; } /* now z is not singular, and z > 0 */ MPFR_SAVE_EXPO_MARK (expo); /* Deal with tiny arguments. We have: y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z), g(z) - 0.41*z^2 < y0(z)/log(z) < g(z) thus since log(z) is negative: g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z) and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2. Note: we use both the main term in log(z) and the constant term, because otherwise the relative error would be only in 1/log(|log(z)|). */ if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2)) { mpfr_t l, h, t, logz; mpfr_prec_t prec; int ok, inex2; prec = MPFR_PREC(res) + 10; mpfr_init2 (l, prec); mpfr_init2 (h, prec); mpfr_init2 (t, prec); mpfr_init2 (logz, prec); /* first enclose log(z) + euler - log(2) = log(z/2) + euler */ mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */ mpfr_set (h, logz, MPFR_RNDU); /* exact */ mpfr_nextabove (h); /* upper bound of log(z) */ mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */ mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */ mpfr_nextabove (t); /* upper bound of euler */ mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */ mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */ mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */ mpfr_nextbelow (t); /* lower bound of log(2) */ mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */ mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */ mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */ mpfr_nextbelow (t); /* lower bound of Pi */ mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */ mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */ mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */ /* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z) to h */ mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */ /* since logz is negative, a lower bound corresponds to an upper bound for its absolute value */ mpfr_neg (t, t, MPFR_RNDD); mpfr_div_2ui (t, t, 1, MPFR_RNDD); mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */ mpfr_add (h, h, t, MPFR_RNDU); inex = mpfr_prec_round (l, MPFR_PREC(res), r); inex2 = mpfr_prec_round (h, MPFR_PREC(res), r); /* we need h=l and inex=inex2 */ ok = (inex == inex2) && mpfr_equal_p (l, h); if (ok) mpfr_set (res, h, r); /* exact */ mpfr_clear (l); mpfr_clear (h); mpfr_clear (t); mpfr_clear (logz); if (ok) goto end; } /* small argument check for y1(z) = -2/Pi/z + O(log(z)): for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */ if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res)) { mpfr_t y; mpfr_prec_t prec; mpfr_exp_t err1; int ok; MPFR_BLOCK_DECL (flags); /* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1), then |y1(z)| > 2^emax */ prec = MPFR_PREC(res) + 10; mpfr_init2 (y, prec); mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u represents a quantity <= 1/2^prec */ mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */ MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ)); /* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */ if (MPFR_OVERFLOW (flags)) { mpfr_clear (y); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (res, r, -1); } mpfr_neg (y, y, MPFR_RNDN); /* (1+u)^6 can be written 1+7u [for another value of u], thus the error on 2/Pi/z is less than 7ulp(y). The truncation error is less than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y), otherwise it is less than 1/4+7/8 <= 2. */ if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */ err1 = 3; else /* ulp(y) <= 1/8 */ err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1; ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r); if (ok) inex = mpfr_set (res, y, r); mpfr_clear (y); if (ok) goto end; } /* we can use the asymptotic expansion as soon as z > p log(2)/2, but to get some margin we use it for z > p/2 */ if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0) { inex = mpfr_yn_asympt (res, n, z, r); if (inex != 0) goto end; } /* General case */ { mpfr_prec_t prec; mpfr_exp_t err1, err2, err3; mpfr_t y, s1, s2, s3; MPFR_ZIV_DECL (loop); mpfr_init (y); mpfr_init (s1); mpfr_init (s2); mpfr_init (s3); prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13; MPFR_ZIV_INIT (loop, prec); for (;;) { mpfr_set_prec (y, prec); mpfr_set_prec (s1, prec); mpfr_set_prec (s2, prec); mpfr_set_prec (s3, prec); mpfr_mul (y, z, z, MPFR_RNDN); mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */ /* store (z/2)^n temporarily in s2 */ mpfr_pow_ui (s2, z, absn, MPFR_RNDN); mpfr_div_2si (s2, s2, absn, MPFR_RNDN); /* compute S1 * (z/2)^(-n) */ if (n == 0) { mpfr_set_ui (s1, 0, MPFR_RNDN); err1 = 0; } else err1 = mpfr_yn_s1 (s1, y, absn - 1); mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */ /* See algorithms.tex: the relative error on s1 is bounded by (3n+3)*2^(e+1-prec). */ err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1; /* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */ /* compute (z/2)^n * S3 */ mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */ err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */ /* the error on s3 is bounded by 2^err3 ulps */ /* add s1+s3 */ err1 += MPFR_EXP(s1); mpfr_add (s1, s1, s3, MPFR_RNDN); /* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1)) + 2^err3*2^(EXP(s3) - EXP(s1)) */ err3 += MPFR_EXP(s3); err1 = (err3 > err1) ? err3 + 1 : err1 + 1; err1 -= MPFR_EXP(s1); err1 = (err1 >= 0) ? err1 + 1 : 1; /* now the error on s1 is bounded by 2^err1*ulp(s1) */ /* compute S2 */ mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */ mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */ mpfr_const_euler (s3, MPFR_RNDN); err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3); mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */ err2 -= MPFR_EXP(s2); mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */ mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */ mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */ err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see algorithms.tex */ /* add all three sums */ err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */ err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */ mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */ err2 = (err1 > err2) ? err1 + 1 : err2 + 1; err2 -= MPFR_EXP(s2); err2 = (err2 >= 0) ? err2 + 1 : 1; /* now the error on s2 is bounded by 2^err2*ulp(s2) */ mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */ mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by 2^(err2+1)*ulp(s2) */ err2 ++; if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r))) break; MPFR_ZIV_NEXT (loop, prec); } MPFR_ZIV_FREE (loop); /* Assume two's complement for the test n & 1 */ inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ? MPFR_SIGN (s2) : - MPFR_SIGN (s2)); mpfr_clear (y); mpfr_clear (s1); mpfr_clear (s2); mpfr_clear (s3); } end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (res, inex, r); }
int mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode) { mpfr_t z_pre, s1, y, p; double sd, eps, m1, c; long add; mpfr_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[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode), ("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, 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, MPFR_RNDN); /* Zeta(+Inf) = 1 */ MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */ MPFR_RET_NAN; } else /* s iz zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (s)); return mpfr_set_si_2exp (z, -1, -1, rnd_mode); } } /* 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_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z)) { int signs = MPFR_SIGN(s); MPFR_SAVE_EXPO_MARK (expo); mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */ if (rnd_mode == MPFR_RNDA) rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */ if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0) { mpfr_nextabove (z); /* z = -1/2 + epsilon */ inex = 1; } else if (rnd_mode == MPFR_RNDD && signs > 0) { mpfr_nextbelow (z); /* z = -1/2 - epsilon */ inex = -1; } else { if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */ inex = 1; else if (rnd_mode == MPFR_RNDD) inex = -1; /* s < 0: z = -1/2 */ else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */ inex = (signs > 0) ? 1 : -1; } MPFR_SAVE_EXPO_FREE (expo); 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_GET_EXP (s) - 1; if (mpfr_integer_p (tmp)) { MPFR_SET_ZERO (z); MPFR_SET_POS (z); MPFR_RET (0); } } /* Check for case s= 1 before changing the exponent range */ if (mpfr_cmp (s, __gmpfr_one) ==0) { MPFR_SET_INF (z); MPFR_SET_POS (z); mpfr_set_divby0 (); 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) */ { int overflow = 0; 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, MPFR_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, MPFR_RNDN);/* s1 = 1-s */ mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */ mpfr_gamma (y, s1, MPFR_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_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */ mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */ overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1; break; } mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */ mpfr_const_pi (p, MPFR_RNDD); mpfr_mul (y, s, p, MPFR_RNDN); mpfr_div_2ui (y, y, 1, MPFR_RNDN); /* s*Pi/2 */ mpfr_sin (y, y, MPFR_RNDN); /* sin(Pi*s/2) */ mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */ mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */ mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */ mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_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); if (overflow != 0) { inex = mpfr_overflow (z, rnd_mode, overflow); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW); } else 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); }
/* 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, mpfr_rnd_t rnd_mode) { mpfr_t b, c, z_pre, f, s1; double beta, sd, dnep; mpfr_t *tc1; mpfr_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) { mpfr_exp_t err; err = MPFR_GET_EXP (s) - 1; if (err > (mpfr_exp_t) (sizeof (mpfr_exp_t)*CHAR_BIT-2)) err = MPFR_EMAX_MAX; else err = ((mpfr_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, MPFR_RNDN); MPFR_ASSERTD (inex == 0); /* case s=1 should have already been handled */ MPFR_ASSERTD (!MPFR_IS_ZERO (s1)); 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) <= -(mpfr_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=%lu\n", (unsigned long) dint)); MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f); mpfr_div (z_pre, __gmpfr_one, s1, MPFR_RNDN); mpfr_const_euler (f, MPFR_RNDN); mpfr_add (z_pre, z_pre, f, MPFR_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, MPFR_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=%lu\n", (unsigned long) 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 = %lu\n", (unsigned long) 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, MPFR_RNDN); mpfr_ui_pow (f, n, s1, MPFR_RNDN); mpfr_div (c, c, f, MPFR_RNDN); MPFR_TRACE (MPFR_DUMP (c)); mpfr_add (z_pre, z_pre, c, MPFR_RNDN); mpfr_add (z_pre, z_pre, b, MPFR_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); mpfr_clear (s1); return inex; }
/* tgeneric(prec_min, prec_max, step, exp_max) checks rounding with random numbers: - with precision ranging from prec_min to prec_max with an increment of step, - with exponent between -exp_max and exp_max. It also checks parameter reuse (it is assumed here that either two mpc_t variables are equal or they are different, in the sense that the real part of one of them cannot be the imaginary part of the other). */ void tgeneric (mpc_function function, mpfr_prec_t prec_min, mpfr_prec_t prec_max, mpfr_prec_t step, mpfr_exp_t exp_max) { unsigned long ul1 = 0, ul2 = 0; long lo = 0; int i = 0; mpfr_t x1, x2, xxxx; mpc_t z1, z2, z3, z4, z5, zzzz, zzzz2; mpfr_rnd_t rnd_re, rnd_im, rnd2_re, rnd2_im; mpfr_prec_t prec; mpfr_exp_t exp_min; int special, special_cases; mpc_init2 (z1, prec_max); switch (function.type) { case C_CC: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (z4, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 8; break; case CCCC: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (z4, prec_max); mpc_init2 (z5, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 8; break; case FC: mpfr_init2 (x1, prec_max); mpfr_init2 (x2, prec_max); mpfr_init2 (xxxx, 4*prec_max); mpc_init2 (z2, prec_max); special_cases = 4; break; case CCF: case CFC: mpfr_init2 (x1, prec_max); mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 6; break; case CCI: case CCS: case CCU: case CUC: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 5; break; case CUUC: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 6; break; case CC_C: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (z4, prec_max); mpc_init2 (z5, prec_max); mpc_init2 (zzzz, 4*prec_max); mpc_init2 (zzzz2, 4*prec_max); special_cases = 4; break; case CC: default: mpc_init2 (z2, prec_max); mpc_init2 (z3, prec_max); mpc_init2 (zzzz, 4*prec_max); special_cases = 4; } exp_min = mpfr_get_emin (); if (exp_max <= 0 || exp_max > mpfr_get_emax ()) exp_max = mpfr_get_emax(); if (-exp_max > exp_min) exp_min = - exp_max; if (step < 1) step = 1; for (prec = prec_min, special = 0; prec <= prec_max || special <= special_cases; prec+=step, special += (prec > prec_max ? 1 : 0)) { /* In the end, test functions in special cases of purely real, purely imaginary or infinite arguments. */ /* probability of one zero part in 256th (25 is almost 10%) */ const unsigned int zero_probability = special != 0 ? 0 : 25; mpc_set_prec (z1, prec); test_default_random (z1, exp_min, exp_max, 128, zero_probability); switch (function.type) { case C_CC: mpc_set_prec (z2, prec); test_default_random (z2, exp_min, exp_max, 128, zero_probability); mpc_set_prec (z3, prec); mpc_set_prec (z4, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: mpfr_set_ui (mpc_realref (z2), 0, MPFR_RNDN); break; case 6: mpfr_set_inf (mpc_realref (z2), -1); break; case 7: mpfr_set_ui (mpc_imagref (z2), 0, MPFR_RNDN); break; case 8: mpfr_set_inf (mpc_imagref (z2), +1); break; } break; case CCCC: mpc_set_prec (z2, prec); test_default_random (z2, exp_min, exp_max, 128, zero_probability); mpc_set_prec (z3, prec); mpc_set_prec (z4, prec); mpc_set_prec (z5, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: mpfr_set_ui (mpc_realref (z2), 0, MPFR_RNDN); break; case 6: mpfr_set_inf (mpc_realref (z2), -1); break; case 7: mpfr_set_ui (mpc_imagref (z2), 0, MPFR_RNDN); break; case 8: mpfr_set_inf (mpc_imagref (z2), +1); break; } break; case FC: mpc_set_prec (z2, prec); mpfr_set_prec (x1, prec); mpfr_set_prec (x2, prec); mpfr_set_prec (xxxx, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; } break; case CCU: case CUC: mpc_set_prec (z2, 128); do { test_default_random (z2, 0, 64, 128, zero_probability); } while (!mpfr_fits_ulong_p (mpc_realref (z2), MPFR_RNDN)); ul1 = mpfr_get_ui (mpc_realref(z2), MPFR_RNDN); mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: ul1 = 0; break; } break; case CUUC: mpc_set_prec (z2, 128); do { test_default_random (z2, 0, 64, 128, zero_probability); } while (!mpfr_fits_ulong_p (mpc_realref (z2), MPFR_RNDN) ||!mpfr_fits_ulong_p (mpc_imagref (z2), MPFR_RNDN)); ul1 = mpfr_get_ui (mpc_realref(z2), MPFR_RNDN); ul2 = mpfr_get_ui (mpc_imagref(z2), MPFR_RNDN); mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: ul1 = 0; break; case 6: ul2 = 0; break; } break; case CCS: mpc_set_prec (z2, 128); do { test_default_random (z2, 0, 64, 128, zero_probability); } while (!mpfr_fits_slong_p (mpc_realref (z2), MPFR_RNDN)); lo = mpfr_get_si (mpc_realref(z2), MPFR_RNDN); mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: lo = 0; break; } break; case CCI: mpc_set_prec (z2, 128); do { test_default_random (z2, 0, 64, 128, zero_probability); } while (!mpfr_fits_slong_p (mpc_realref (z2), MPFR_RNDN)); i = (int)mpfr_get_si (mpc_realref(z2), MPFR_RNDN); mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: i = 0; break; } break; case CCF: case CFC: mpfr_set_prec (x1, prec); mpfr_set (x1, mpc_realref (z1), MPFR_RNDN); test_default_random (z1, exp_min, exp_max, 128, zero_probability); mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; case 5: mpfr_set_ui (x1, 0, MPFR_RNDN); break; case 6: mpfr_set_inf (x1, +1); break; } break; case CC_C: mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (z4, prec); mpc_set_prec (z5, prec); mpc_set_prec (zzzz, 4*prec); mpc_set_prec (zzzz2, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; } break; case CC: default: mpc_set_prec (z2, prec); mpc_set_prec (z3, prec); mpc_set_prec (zzzz, 4*prec); switch (special) { case 1: mpfr_set_ui (mpc_realref (z1), 0, MPFR_RNDN); break; case 2: mpfr_set_inf (mpc_realref (z1), +1); break; case 3: mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN); break; case 4: mpfr_set_inf (mpc_imagref (z1), -1); break; } } for (rnd_re = first_rnd_mode (); is_valid_rnd_mode (rnd_re); rnd_re = next_rnd_mode (rnd_re)) switch (function.type) { case C_CC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_c_cc (&function, z1, z2, z3, zzzz, z4, MPC_RND (rnd_re, rnd_im)); reuse_c_cc (&function, z1, z2, z3, z4); break; case CCCC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cccc (&function, z1, z2, z3, z4, zzzz, z5, MPC_RND (rnd_re, rnd_im)); reuse_cccc (&function, z1, z2, z3, z4, z5); break; case FC: tgeneric_fc (&function, z1, x1, xxxx, x2, rnd_re); reuse_fc (&function, z1, z2, x1); break; case CC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cc (&function, z1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_cc (&function, z1, z2, z3); break; case CC_C: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) for (rnd2_re = first_rnd_mode (); is_valid_rnd_mode (rnd2_re); rnd2_re = next_rnd_mode (rnd2_re)) for (rnd2_im = first_rnd_mode (); is_valid_rnd_mode (rnd2_im); rnd2_im = next_rnd_mode (rnd2_im)) tgeneric_cc_c (&function, z1, z2, z3, zzzz, zzzz2, z4, z5, MPC_RND (rnd_re, rnd_im), MPC_RND (rnd2_re, rnd2_im)); reuse_cc_c (&function, z1, z2, z3, z4, z5); break; case CFC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cfc (&function, x1, z1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_cfc (&function, z1, x1, z2, z3); break; case CCF: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_ccf (&function, z1, x1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_ccf (&function, z1, x1, z2, z3); break; case CCU: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_ccu (&function, z1, ul1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_ccu (&function, z1, ul1, z2, z3); break; case CUC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cuc (&function, ul1, z1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_cuc (&function, ul1, z1, z2, z3); break; case CCS: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_ccs (&function, z1, lo, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_ccs (&function, z1, lo, z2, z3); break; case CCI: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cci (&function, z1, i, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_cci (&function, z1, i, z2, z3); break; case CUUC: for (rnd_im = first_rnd_mode (); is_valid_rnd_mode (rnd_im); rnd_im = next_rnd_mode (rnd_im)) tgeneric_cuuc (&function, ul1, ul2, z1, z2, zzzz, z3, MPC_RND (rnd_re, rnd_im)); reuse_cuuc (&function, ul1, ul2, z1, z2, z3); break; default: printf ("tgeneric not yet implemented for this kind of" "function\n"); exit (1); } } mpc_clear (z1); switch (function.type) { case C_CC: mpc_clear (z2); mpc_clear (z3); mpc_clear (z4); mpc_clear (zzzz); break; case CCCC: mpc_clear (z2); mpc_clear (z3); mpc_clear (z4); mpc_clear (z5); mpc_clear (zzzz); break; case FC: mpc_clear (z2); mpfr_clear (x1); mpfr_clear (x2); mpfr_clear (xxxx); break; case CCF: case CFC: mpfr_clear (x1); mpc_clear (z2); mpc_clear (z3); mpc_clear (zzzz); break; case CC_C: mpc_clear (z2); mpc_clear (z3); mpc_clear (z4); mpc_clear (z5); mpc_clear (zzzz); mpc_clear (zzzz2); break; case CUUC: case CCI: case CCS: case CCU: case CUC: case CC: default: mpc_clear (z2); mpc_clear (z3); mpc_clear (zzzz); } }
void init_set(ElementType &result, const ElementType& a) const { init(result); mpfr_set(&result, &a, GMP_RNDN); }
int mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd) { int s_re; int s_im; int inex_re; int inex_im; int inex; inex_re = 0; inex_im = 0; s_re = mpfr_signbit (mpc_realref (op)); s_im = mpfr_signbit (mpc_imagref (op)); /* special values */ if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) { if (mpfr_nan_p (mpc_realref (op))) { mpfr_set_nan (mpc_realref (rop)); if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op))) { mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN); if (s_im) mpc_conj (rop, rop, MPC_RNDNN); } else mpfr_set_nan (mpc_imagref (rop)); } else { if (mpfr_inf_p (mpc_realref (op))) { inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd)); mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN); } else { mpfr_set_nan (mpc_realref (rop)); mpfr_set_nan (mpc_imagref (rop)); } } return MPC_INEX (inex_re, 0); } if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op))) { inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd)); mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN); if (s_im) mpc_conj (rop, rop, GMP_RNDN); return MPC_INEX (inex_re, 0); } /* pure real argument */ if (mpfr_zero_p (mpc_imagref (op))) { inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd)); mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN); if (s_im) mpc_conj (rop, rop, GMP_RNDN); return MPC_INEX (inex_re, 0); } /* pure imaginary argument */ if (mpfr_zero_p (mpc_realref (op))) { int cmp_1; if (s_im) cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1); else cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1); if (cmp_1 < 0) { /* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1 atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */ mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN); if (s_re) mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN); inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd)); } else if (cmp_1 == 0) { /* atan(+/-0+i) = NaN +i*inf atan(+/-0-i) = NaN -i*inf */ mpfr_set_nan (mpc_realref (rop)); mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1); } else { /* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1 atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */ mpfr_rnd_t rnd_im, rnd_away; mpfr_t y; mpfr_prec_t p, p_im; int ok; rnd_im = MPC_RND_IM (rnd); mpfr_init (y); p_im = mpfr_get_prec (mpc_imagref (rop)); p = p_im; /* a = o(1/y) with error(a) < 1 ulp(a) b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b) As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most, 2 bits of precision are lost. We round atanh(1/y) away from 0. */ do { p += mpc_ceil_log2 (p) + 2; mpfr_set_prec (y, p); rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD; inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away); /* FIXME: should we consider the case with unreasonably huge precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be representable while 1/Im(op) underflows ? This corresponds to |y| = 0.5*2^emin, in which case the result may be wrong. */ /* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */ inex_im |= mpfr_atanh (y, y, rnd_away); ok = inex_im == 0 || mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ, p_im + (rnd_im == GMP_RNDN)); } while (ok == 0); inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd)); inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im); mpfr_clear (y); } return MPC_INEX (inex_re, inex_im); } /* regular number argument */ { mpfr_t a, b, x, y; mpfr_prec_t prec, p; mpfr_exp_t err, expo; int ok = 0; mpfr_t minus_op_re; mpfr_exp_t op_re_exp, op_im_exp; mpfr_rnd_t rnd1, rnd2; mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0); /* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */ minus_op_re[0] = mpc_realref (op)[0]; MPFR_CHANGE_SIGN (minus_op_re); op_re_exp = mpfr_get_exp (mpc_realref (op)); op_im_exp = mpfr_get_exp (mpc_imagref (op)); prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */ /* a = o(1-y) error(a) < 1 ulp(a) b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b) = kb ulp(b) c = o(1+y) error(c) < 1 ulp(c) d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d) = kd ulp(d) e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)} + kd*2^{Exp(d)-Exp(e)}] ulp(e) error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)} + 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e) because |atan(u)| < |u| < [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c)) -Exp(e)}] ulp(e) f = e/2 exact */ /* p: working precision */ p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec : (prec - op_im_exp); rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU; rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD; do { p += mpc_ceil_log2 (p) + 2; mpfr_set_prec (a, p); mpfr_set_prec (b, p); mpfr_set_prec (x, p); /* x = upper bound for atan (x/(1-y)). Since atan is increasing, we need an upper bound on x/(1-y), i.e., a lower bound on 1-y for x positive, and an upper bound on 1-y for x negative */ mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1); if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and expo will be 1 or 2 below */ { MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0); /* check for intermediate underflow */ err = 2; /* ensures err will be expo below */ } else err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */ mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU); /* b = lower bound for atan (-x/(1+y)): for x negative, we need a lower bound on -x/(1+y), i.e., an upper bound on 1+y */ mpfr_add_ui (a, mpc_imagref(op), 1, rnd2); /* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0, and we can simply ignore the terms involving Exp(a) in the error */ if (mpfr_sgn (a) == 0) { MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0); /* check for intermediate underflow */ expo = err; /* will leave err unchanged below */ } else expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */ mpfr_atan2 (b, minus_op_re, a, GMP_RNDD); err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */ mpfr_sub (x, x, b, GMP_RNDU); err = 5 + op_re_exp - err - mpfr_get_exp (x); /* error is bounded by [1 + 2^err] ulp(e) */ err = err < 0 ? 1 : err + 1; mpfr_div_2ui (x, x, 1, GMP_RNDU); /* Note: using RND2=RNDD guarantees that if x is exactly representable on prec + ... bits, mpfr_can_round will return 0 */ ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD, prec + (MPC_RND_RE (rnd) == GMP_RNDN)); } while (ok == 0); /* Imaginary part Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */ prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */ /* a = o(1+y) error(a) < 1 ulp(a) b = o(a^2) error(b) < 5 ulp(b) c = o(x^2) error(c) < 1 ulp(c) d = o(b+c) error(d) < 7 ulp(d) e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e) f = o(1-y) error(f) < 1 ulp(f) g = o(f^2) error(g) < 5 ulp(g) h = o(c+f) error(h) < 7 ulp(h) i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i) j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)} + ki*2^{Exp(i)-Exp(j)}] ulp(j) error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)} + 7*2^{3-Exp(j)}] ulp(j) < [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1} + 7*2^{3-Exp(j)}] ulp(j) k = j/4 exact */ err = 2; p = prec; /* working precision */ do { p += mpc_ceil_log2 (p) + err; mpfr_set_prec (a, p); mpfr_set_prec (b, p); mpfr_set_prec (y, p); /* a = upper bound for log(x^2 + (1+y)^2) */ ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a); mpfr_sqr (a, a, GMP_RNDU); mpfr_sqr (y, mpc_realref (op), GMP_RNDU); mpfr_add (a, a, y, GMP_RNDU); mpfr_log (a, a, GMP_RNDU); /* b = lower bound for log(x^2 + (1-y)^2) */ mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */ mpfr_sqr (b, b, GMP_RNDZ); /* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is more efficient to reuse the value of y (x^2) above and subtract one ulp */ mpfr_nextbelow (y); mpfr_add (b, b, y, GMP_RNDZ); mpfr_log (b, b, GMP_RNDZ); mpfr_sub (y, a, b, GMP_RNDU); if (mpfr_zero_p (y)) /* FIXME: happens when x and y have very different magnitudes; could be handled more efficiently */ ok = 0; else { expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b)); expo = expo - mpfr_get_exp (y) + 1; err = 3 - mpfr_get_exp (y); /* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */ if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */ err = (err < 0) ? 1 : err + 2; else err = (expo < 0) ? 1 : expo + 2; mpfr_div_2ui (y, y, 2, GMP_RNDN); MPC_ASSERT (!mpfr_zero_p (y)); /* FIXME: underflow. Since the main term of the Taylor series in y=0 is 1/(x^2+1) * y, this means that y is very small and/or x very large; but then the mpfr_zero_p (y) above should be true. This needs a proof, or better yet, special code. */ ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD, prec + (MPC_RND_IM (rnd) == GMP_RNDN)); } } while (ok == 0); inex = mpc_set_fr_fr (rop, x, y, rnd); mpfr_clears (a, b, x, y, (mpfr_ptr) 0); return inex; } }
void set(ElementType &result, const ElementType& a) const { mpfr_set(&result, &a, GMP_RNDN); }
int mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd) { int inex; mpfr_t tmp, ump; mp_exp_t err, te; mp_prec_t prec; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd), ("y[%#R]=%R inexact=%d", y, y, inex)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { /* exp(NaN) = exp(-Inf) = NaN */ if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x))) { MPFR_SET_NAN (y); MPFR_RET_NAN; } /* eint(+inf) = +inf */ else if (MPFR_IS_INF (x)) { MPFR_SET_INF(y); MPFR_SET_POS(y); MPFR_RET(0); } else /* eint(+/-0) = -Inf */ { MPFR_SET_INF(y); MPFR_SET_NEG(y); MPFR_RET(0); } } /* eint(x) = NaN for x < 0 */ if (MPFR_IS_NEG(x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } MPFR_SAVE_EXPO_MARK (expo); /* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2). Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax, then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */ mpfr_init2 (tmp, 64); mpfr_init2 (ump, 64); mpfr_log (tmp, x, GMP_RNDU); mpfr_sub (ump, x, tmp, GMP_RNDD); mpfr_const_log2 (tmp, GMP_RNDU); mpfr_div (ump, ump, tmp, GMP_RNDD); /* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */ MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX); if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0) { mpfr_clear (tmp); mpfr_clear (ump); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (y, rnd, 1); } /* Init stuff */ prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6; /* eint() has a root 0.37250741078136663446..., so if x is near, already take more bits */ if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */ { double d; d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663; d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d); prec += -d; } mpfr_set_prec (tmp, prec); mpfr_set_prec (ump, prec); MPFR_ZIV_INIT (loop, prec); /* Initialize the ZivLoop controler */ for (;;) /* Infinite loop */ { /* We need that the smallest value of k!/x^k is smaller than 2^(-p). The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x for x>=1. */ if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec + 0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0) err = mpfr_eint_asympt (tmp, x); else { err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */ te = MPFR_GET_EXP(tmp); mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */ mpfr_add (tmp, tmp, ump, GMP_RNDN); /* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err) <= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp)) <= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */ err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp); err = MAX(0, err); te = MPFR_GET_EXP(tmp); mpfr_log (ump, x, GMP_RNDN); mpfr_add (tmp, tmp, ump, GMP_RNDN); /* same formula as above, except now EXP(ump) is not 0 */ err += te + 1; if (MPFR_LIKELY (!MPFR_IS_ZERO (ump))) err = MAX (MPFR_GET_EXP (ump), err); err = MAX(0, err - MPFR_GET_EXP (tmp)); } if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd))) break; MPFR_ZIV_NEXT (loop, prec); /* Increase used precision */ mpfr_set_prec (tmp, prec); mpfr_set_prec (ump, prec); } MPFR_ZIV_FREE (loop); /* Free the ZivLoop Controler */ inex = mpfr_set (y, tmp, rnd); /* Set y to the computed value */ mpfr_clear (tmp); mpfr_clear (ump); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inex, rnd); }
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[%#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 { 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_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); }
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity), and return e such that the absolute error is bound by 2^e ulp(y) */ static mp_exp_t mpfr_eint_aux (mpfr_t y, mpfr_srcptr x) { mpfr_t eps; /* dynamic (absolute) error bound on t */ mpfr_t erru, errs; mpz_t m, s, t, u; mp_exp_t e, sizeinbase; mp_prec_t w = MPFR_PREC(y); unsigned long k; MPFR_GROUP_DECL (group); /* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x) where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2 thus |R(x)/x| <= |x|/2 thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */ if (MPFR_GET_EXP(x) <= - (mp_exp_t) w) { mpfr_set (y, x, GMP_RNDN); return 0; } mpz_init (s); /* initializes to 0 */ mpz_init (t); mpz_init (u); mpz_init (m); MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs); e = mpfr_get_z_exp (m, x); /* x = m * 2^e */ MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x)); if (MPFR_PREC (x) > w) { e += MPFR_PREC (x) - w; mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w); } /* remove trailing zeroes from m: this will speed up much cases where x is a small integer divided by a power of 2 */ k = mpz_scan1 (m, 0); mpz_tdiv_q_2exp (m, m, k); e += k; /* initialize t to 2^w */ mpz_set_ui (t, 1); mpz_mul_2exp (t, t, w); mpfr_set_ui (eps, 0, GMP_RNDN); /* eps[0] = 0 */ mpfr_set_ui (errs, 0, GMP_RNDN); for (k = 1;; k++) { /* let eps[k] be the absolute error on t[k]: since t[k] = trunc(t[k-1]*m*2^e/k), we have eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k = 1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k = 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */ mpfr_mul_2ui (eps, eps, w - 1, GMP_RNDU); mpfr_add_z (eps, eps, t, GMP_RNDU); MPFR_MPZ_SIZEINBASE2 (sizeinbase, m); mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, GMP_RNDU); mpfr_div_ui (eps, eps, k, GMP_RNDU); mpfr_add_ui (eps, eps, 1, GMP_RNDU); mpz_mul (t, t, m); if (e < 0) mpz_tdiv_q_2exp (t, t, -e); else mpz_mul_2exp (t, t, e); mpz_tdiv_q_ui (t, t, k); mpz_tdiv_q_ui (u, t, k); mpz_add (s, s, u); /* the absolute error on u is <= 1 + eps[k]/k */ mpfr_div_ui (erru, eps, k, GMP_RNDU); mpfr_add_ui (erru, erru, 1, GMP_RNDU); /* and that on s is the sum of all errors on u */ mpfr_add (errs, errs, erru, GMP_RNDU); /* we are done when t is smaller than errs */ if (mpz_sgn (t) == 0) sizeinbase = 0; else MPFR_MPZ_SIZEINBASE2 (sizeinbase, t); if (sizeinbase < MPFR_GET_EXP (errs)) break; } /* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...) <= (|t|+eps)/k*|x|/(k-|x|) */ mpz_abs (t, t); mpfr_add_z (eps, eps, t, GMP_RNDU); mpfr_div_ui (eps, eps, k, GMP_RNDU); mpfr_abs (erru, x, GMP_RNDU); /* |x| */ mpfr_mul (eps, eps, erru, GMP_RNDU); mpfr_ui_sub (erru, k, erru, GMP_RNDD); if (MPFR_IS_NEG (erru)) { /* the truncated series does not converge, return fail */ e = w; } else { mpfr_div (eps, eps, erru, GMP_RNDU); mpfr_add (errs, errs, eps, GMP_RNDU); mpfr_set_z (y, s, GMP_RNDN); mpfr_div_2ui (y, y, w, GMP_RNDN); /* errs was an absolute error bound on s. We must convert it to an error in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must divide the error by 2^(EXP(y)-PREC(y)), but since we divided also y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */ e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y); } MPFR_GROUP_CLEAR (group); mpz_clear (s); mpz_clear (t); mpz_clear (u); mpz_clear (m); return e; }
int mpfr_log2 (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode) { int inexact; MPFR_SAVE_EXPO_DECL (expo); 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)); 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); /* 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); /* initialize 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; /* actualization 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); }
int mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mp_rnd_t rnd_mode) { mpfr_t xp; mpfr_t arcs; int signe, suplement; mpfr_t tmp; int Prec; int prec_asin; int good = 0; int realprec; int estimated_delta; int compared; /* Trivial cases */ if (MPFR_IS_NAN(x) || MPFR_IS_INF(x)) { MPFR_SET_NAN(asin); MPFR_RET_NAN; } /* Set x_p=|x| */ signe = MPFR_SIGN(x); mpfr_init2 (xp, MPFR_PREC(x)); mpfr_set (xp, x, rnd_mode); if (signe == -1) MPFR_CHANGE_SIGN(xp); compared = mpfr_cmp_ui (xp, 1); if (compared > 0) /* asin(x) = NaN for |x| > 1 */ { MPFR_SET_NAN(asin); mpfr_clear (xp); MPFR_RET_NAN; } if (compared == 0) /* x = 1 or x = -1 */ { if (signe > 0) /* asin(+1) = Pi/2 */ mpfr_const_pi (asin, rnd_mode); else /* asin(-1) = -Pi/2 */ { if (rnd_mode == GMP_RNDU) rnd_mode = GMP_RNDD; else if (rnd_mode == GMP_RNDD) rnd_mode = GMP_RNDU; mpfr_const_pi (asin, rnd_mode); mpfr_neg (asin, asin, rnd_mode); } MPFR_EXP(asin)--; mpfr_clear (xp); return 1; /* inexact */ } if (MPFR_IS_ZERO(x)) /* x = 0 */ { mpfr_set_ui (asin, 0, GMP_RNDN); mpfr_clear(xp); return 0; /* exact result */ } prec_asin = MPFR_PREC(asin); mpfr_ui_sub (xp, 1, xp, GMP_RNDD); suplement = 2 - MPFR_EXP(xp); #ifdef DEBUG printf("suplement=%d\n", suplement); #endif realprec = prec_asin + 10; while (!good) { estimated_delta = 1 + suplement; Prec = realprec+estimated_delta; /* Initialisation */ mpfr_init2 (tmp, Prec); mpfr_init2 (arcs, Prec); #ifdef DEBUG printf("Prec=%d\n", Prec); printf(" x="); mpfr_out_str (stdout, 2, 0, x, GMP_RNDN); printf ("\n"); #endif mpfr_mul (tmp, x, x, GMP_RNDN); #ifdef DEBUG printf(" x^2="); mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN); printf ("\n"); #endif mpfr_ui_sub (tmp, 1, tmp, GMP_RNDN); #ifdef DEBUG printf(" 1-x^2="); mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN); printf ("\n"); printf("10: 1-x^2="); mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN); printf ("\n"); #endif mpfr_sqrt (tmp, tmp, GMP_RNDN); #ifdef DEBUG printf(" sqrt(1-x^2)="); mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN); printf ("\n"); printf("10: sqrt(1-x^2)="); mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN); printf ("\n"); #endif mpfr_div (tmp, x, tmp, GMP_RNDN); #ifdef DEBUG printf("x/sqrt(1-x^2)="); mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN); printf ("\n"); #endif mpfr_atan (arcs, tmp, GMP_RNDN); #ifdef DEBUG printf("atan(x/..x^2)="); mpfr_out_str (stdout, 2, 0, arcs, GMP_RNDN); printf ("\n"); #endif if (mpfr_can_round (arcs, realprec, GMP_RNDN, rnd_mode, MPFR_PREC(asin))) { mpfr_set (asin, arcs, rnd_mode); #ifdef DEBUG printf("asin ="); mpfr_out_str (stdout, 2, prec_asin, asin, GMP_RNDN); printf ("\n"); #endif good = 1; } else { realprec += _mpfr_ceil_log2 ((double) realprec); #ifdef DEBUG printf("RETRY\n"); #endif } mpfr_clear (tmp); mpfr_clear (arcs); } mpfr_clear (xp); return 1; /* inexact result */ }
int mpfr_sub (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { MPFR_LOG_FUNC (("b[%Pu]=%.*Rg c[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (b), mpfr_log_prec, b, mpfr_get_prec (c), mpfr_log_prec, c, rnd_mode), ("a[%Pu]=%.*Rg", mpfr_get_prec (a), mpfr_log_prec, a)); if (MPFR_ARE_SINGULAR (b,c)) { if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c)) { MPFR_SET_NAN (a); MPFR_RET_NAN; } else if (MPFR_IS_INF (b)) { if (!MPFR_IS_INF (c) || MPFR_SIGN (b) != MPFR_SIGN(c)) { MPFR_SET_INF (a); MPFR_SET_SAME_SIGN (a, b); MPFR_RET (0); /* exact */ } else { MPFR_SET_NAN (a); /* Inf - Inf */ MPFR_RET_NAN; } } else if (MPFR_IS_INF (c)) { MPFR_SET_INF (a); MPFR_SET_OPPOSITE_SIGN (a, c); MPFR_RET (0); /* exact */ } else if (MPFR_IS_ZERO (b)) { if (MPFR_IS_ZERO (c)) { int sign = rnd_mode != MPFR_RNDD ? ((MPFR_IS_NEG(b) && MPFR_IS_POS(c)) ? -1 : 1) : ((MPFR_IS_POS(b) && MPFR_IS_NEG(c)) ? 1 : -1); MPFR_SET_SIGN (a, sign); MPFR_SET_ZERO (a); MPFR_RET(0); /* 0 - 0 is exact */ } else return mpfr_neg (a, c, rnd_mode); } else { MPFR_ASSERTD (MPFR_IS_ZERO (c)); return mpfr_set (a, b, rnd_mode); } } MPFR_ASSERTD (MPFR_IS_PURE_FP (b)); MPFR_ASSERTD (MPFR_IS_PURE_FP (c)); if (MPFR_LIKELY (MPFR_SIGN (b) == MPFR_SIGN (c))) { /* signs are equal, it's a real subtraction */ if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b) && MPFR_PREC (b) == MPFR_PREC (c))) return mpfr_sub1sp (a, b, c, rnd_mode); else return mpfr_sub1 (a, b, c, rnd_mode); } else { /* signs differ, it's an addition */ if (MPFR_GET_EXP (b) < MPFR_GET_EXP (c)) { /* exchange rounding modes toward +/- infinity */ int inexact; rnd_mode = MPFR_INVERT_RND (rnd_mode); if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b) && MPFR_PREC (b) == MPFR_PREC (c))) inexact = mpfr_add1sp (a, c, b, rnd_mode); else inexact = mpfr_add1 (a, c, b, rnd_mode); MPFR_CHANGE_SIGN (a); return -inexact; } else { if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b) && MPFR_PREC (b) == MPFR_PREC (c))) return mpfr_add1sp (a, b, c, rnd_mode); else return mpfr_add1 (a, b, c, rnd_mode); } } }
int mpfr_log10 (mpfr_ptr r, mpfr_srcptr a, mp_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 */ mp_prec_t Ny = MPFR_PREC(r); /* Precision of output variable */ mp_prec_t Nt; /* Precision of the intermediary variable */ mp_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, GMP_RNDN); /* 10 */ mpfr_log (t, t, GMP_RNDD); /* log(10) */ mpfr_log (tt, a, GMP_RNDN); /* log(a) */ mpfr_div (t, tt, t, GMP_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, GMP_RNDN) && !mpfr_ui_pow_ui (tt, 10, mpfr_get_ui (t, GMP_RNDN), GMP_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); }
int main (int argc, char *argv[]) { #if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0) unsigned int prec, yprec; int rnd; mpfr_t x, y, z, t; unsigned long n; int inex; tests_start_mpfr (); mpfr_init (x); mpfr_init (y); mpfr_init (z); mpfr_init (t); if (argc >= 3) /* tzeta_ui n prec [rnd] */ { mpfr_set_prec (x, atoi (argv[2])); mpfr_zeta_ui (x, atoi (argv[1]), argc > 3 ? (mpfr_rnd_t) atoi (argv[3]) : MPFR_RNDN); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); printf ("\n"); goto clear_and_exit; } mpfr_set_prec (x, 33); mpfr_set_prec (y, 33); mpfr_zeta_ui (x, 3, MPFR_RNDZ); mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1"); if (mpfr_cmp (x, y)) { printf ("Error for zeta(3), prec=33, MPFR_RNDZ\n"); printf ("expected "); mpfr_dump (y); printf ("got "); mpfr_dump (x); exit (1); } mpfr_clear_divby0 (); inex = mpfr_zeta_ui (x, 0, MPFR_RNDN); MPFR_ASSERTN (inex == 0 && mpfr_cmp_si_2exp (x, -1, -1) == 0 && !mpfr_divby0_p ()); mpfr_clear_divby0 (); inex = mpfr_zeta_ui (x, 1, MPFR_RNDN); MPFR_ASSERTN (inex == 0 && MPFR_IS_INF (x) && MPFR_IS_POS (x) && mpfr_divby0_p ()); for (prec = MPFR_PREC_MIN; prec <= 100; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (z, prec); mpfr_set_prec (t, prec); yprec = prec + 10; mpfr_set_prec (y, yprec); for (n = 0; n < 50; n++) for (rnd = 0; rnd < MPFR_RND_MAX; rnd++) { mpfr_zeta_ui (y, n, MPFR_RNDN); if (mpfr_can_round (y, yprec, MPFR_RNDN, MPFR_RNDZ, prec + (rnd == MPFR_RNDN))) { mpfr_set (t, y, (mpfr_rnd_t) rnd); mpfr_zeta_ui (z, n, (mpfr_rnd_t) rnd); if (mpfr_cmp (t, z)) { printf ("results differ for n=%lu", n); printf (" prec=%u rnd_mode=%s\n", prec, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); printf (" got "); mpfr_dump (z); printf (" expected "); mpfr_dump (t); printf (" approx "); mpfr_dump (y); exit (1); } } } } clear_and_exit: mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); tests_end_mpfr (); #endif return 0; }
bool set_from_BigReal(ElementType &result, gmp_RR a) const { mpfr_set(&result, a, GMP_RNDN); return true; }
int mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode) { int inexact; long xint; mpfr_t xfrac; MPFR_SAVE_EXPO_DECL (expo); 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)) { mp_rnd_t rnd2 = rnd_mode; /* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */ if (rnd_mode == GMP_RNDN && mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0) rnd2 = GMP_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_SIGN(x) > 0, rnd_mode, expo, {}); xint = mpfr_get_si (x, GMP_RNDZ); mpfr_init2 (xfrac, MPFR_PREC (x)); mpfr_sub_si (xfrac, x, xint, GMP_RNDN); /* exact */ if (MPFR_IS_ZERO (xfrac)) { mpfr_set_ui (y, 1, GMP_RNDN); inexact = 0; } else { /* 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 + 5 + MPFR_INT_CEIL_LOG2 (Ny); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); /* First computation */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute exp(x*ln(2))*/ mpfr_const_log2 (t, GMP_RNDU); /* ln(2) */ mpfr_mul (t, xfrac, t, GMP_RNDU); /* xfrac * ln(2) */ err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */ mpfr_exp (t, t, GMP_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, GMP_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); }
void from_ring_elem(ElementType &result, const ring_elem &a) const { mpfr_set(&result, reinterpret_cast<mpfr_ptr>(a.poly_val), GMP_RNDN); }
static int mpfr_rem1 (mpfr_ptr rem, long *quo, mpfr_rnd_t rnd_q, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd) { mpfr_exp_t ex, ey; int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x); mpz_t mx, my, r; int tiny = 0; MPFR_ASSERTD (rnd_q == MPFR_RNDN || rnd_q == MPFR_RNDZ); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y))) { if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x) || MPFR_IS_ZERO (y)) { /* for remquo, quo is undefined */ MPFR_SET_NAN (rem); MPFR_RET_NAN; } else /* either y is Inf and x is 0 or non-special, or x is 0 and y is non-special, in both cases the quotient is zero. */ { if (quo) *quo = 0; return mpfr_set (rem, x, rnd); } } /* now neither x nor y is NaN, Inf or zero */ mpz_init (mx); mpz_init (my); mpz_init (r); ex = mpfr_get_z_2exp (mx, x); /* x = mx*2^ex */ ey = mpfr_get_z_2exp (my, y); /* y = my*2^ey */ /* to get rid of sign problems, we compute it separately: quo(-x,-y) = quo(x,y), rem(-x,-y) = -rem(x,y) quo(-x,y) = -quo(x,y), rem(-x,y) = -rem(x,y) thus quo = sign(x/y)*quo(|x|,|y|), rem = sign(x)*rem(|x|,|y|) */ sign = (signx == MPFR_SIGN (y)) ? 1 : -1; mpz_abs (mx, mx); mpz_abs (my, my); q_is_odd = 0; /* divide my by 2^k if possible to make operations mod my easier */ { unsigned long k = mpz_scan1 (my, 0); ey += k; mpz_fdiv_q_2exp (my, my, k); } if (ex <= ey) { /* q = x/y = mx/(my*2^(ey-ex)) */ /* First detect cases where q=0, to avoid creating a huge number my*2^(ey-ex): if sx = mpz_sizeinbase (mx, 2) and sy = mpz_sizeinbase (my, 2), we have x < 2^(ex + sx) and y >= 2^(ey + sy - 1), thus if ex + sx <= ey + sy - 1 the quotient is 0 */ if (ex + (mpfr_exp_t) mpz_sizeinbase (mx, 2) < ey + (mpfr_exp_t) mpz_sizeinbase (my, 2)) { tiny = 1; mpz_set (r, mx); mpz_set_ui (mx, 0); } else { mpz_mul_2exp (my, my, ey - ex); /* divide mx by my*2^(ey-ex) */ /* since mx > 0 and my > 0, we can use mpz_tdiv_qr in all cases */ mpz_tdiv_qr (mx, r, mx, my); /* 0 <= |r| <= |my|, r has the same sign as mx */ } if (rnd_q == MPFR_RNDN) q_is_odd = mpz_tstbit (mx, 0); if (quo) /* mx is the quotient */ { mpz_tdiv_r_2exp (mx, mx, WANTED_BITS); *quo = mpz_get_si (mx); } } else /* ex > ey */ { if (quo) /* remquo case */ /* for remquo, to get the low WANTED_BITS more bits of the quotient, we first compute R = X mod Y*2^WANTED_BITS, where X and Y are defined below. Then the low WANTED_BITS of the quotient are floor(R/Y). */ mpz_mul_2exp (my, my, WANTED_BITS); /* 2^WANTED_BITS*Y */ else if (rnd_q == MPFR_RNDN) /* remainder case */ /* Let X = mx*2^(ex-ey) and Y = my. Then both X and Y are integers. Assume X = R mod Y, then x = X*2^ey = R*2^ey mod (Y*2^ey=y). To be able to perform the rounding, we need the least significant bit of the quotient, i.e., one more bit in the remainder, which is obtained by dividing by 2Y. */ mpz_mul_2exp (my, my, 1); /* 2Y */ mpz_set_ui (r, 2); mpz_powm_ui (r, r, ex - ey, my); /* 2^(ex-ey) mod my */ mpz_mul (r, r, mx); mpz_mod (r, r, my); if (quo) /* now 0 <= r < 2^WANTED_BITS*Y */ { mpz_fdiv_q_2exp (my, my, WANTED_BITS); /* back to Y */ mpz_tdiv_qr (mx, r, r, my); /* oldr = mx*my + newr */ *quo = mpz_get_si (mx); q_is_odd = *quo & 1; } else if (rnd_q == MPFR_RNDN) /* now 0 <= r < 2Y in the remainder case */ { mpz_fdiv_q_2exp (my, my, 1); /* back to Y */ /* least significant bit of q */ q_is_odd = mpz_cmpabs (r, my) >= 0; if (q_is_odd) mpz_sub (r, r, my); } /* now 0 <= |r| < |my|, and if needed, q_is_odd is the least significant bit of q */ } if (mpz_cmp_ui (r, 0) == 0) { inex = mpfr_set_ui (rem, 0, MPFR_RNDN); /* take into account sign of x */ if (signx < 0) mpfr_neg (rem, rem, MPFR_RNDN); } else { if (rnd_q == MPFR_RNDN) { /* FIXME: the comparison 2*r < my could be done more efficiently at the mpn level */ mpz_mul_2exp (r, r, 1); /* if tiny=1, we should compare r with my*2^(ey-ex) */ if (tiny) { if (ex + (mpfr_exp_t) mpz_sizeinbase (r, 2) < ey + (mpfr_exp_t) mpz_sizeinbase (my, 2)) compare = 0; /* r*2^ex < my*2^ey */ else { mpz_mul_2exp (my, my, ey - ex); compare = mpz_cmpabs (r, my); } } else compare = mpz_cmpabs (r, my); mpz_fdiv_q_2exp (r, r, 1); compare = ((compare > 0) || ((rnd_q == MPFR_RNDN) && (compare == 0) && q_is_odd)); /* if compare != 0, we need to subtract my to r, and add 1 to quo */ if (compare) { mpz_sub (r, r, my); if (quo && (rnd_q == MPFR_RNDN)) *quo += 1; } } /* take into account sign of x */ if (signx < 0) mpz_neg (r, r); inex = mpfr_set_z_2exp (rem, r, ex > ey ? ey : ex, rnd); } if (quo) *quo *= sign; mpz_clear (mx); mpz_clear (my); mpz_clear (r); return inex; }
int main (void) { mpfr_t *tab; mpfr_ptr *tabtmp; unsigned long i, n; mp_prec_t f; int rnd_mode; mpfr_srcptr *perm; mpfr_t sum, real_sum, real_non_rounded; tests_start_mpfr (); n = 1026; f = 1764; tab = (mpfr_t *) malloc (n * sizeof(mpfr_t)); for (i = 0; i < n; i++) { mpfr_init2 (tab[i], f); mpfr_urandomb (tab[i], RANDS); } mpfr_init2 (sum, f); mpfr_init2 (real_sum, f); algo_exact (real_non_rounded, tab, n, f); for (rnd_mode = 0; rnd_mode < GMP_RND_MAX; rnd_mode++) { mpfr_list_sum (sum, tab, n, (mp_rnd_t) rnd_mode); mpfr_set (real_sum, real_non_rounded, (mp_rnd_t) rnd_mode); if (mpfr_cmp (real_sum, sum) != 0) { printf ("mpfr_list_sum incorrect.\n"); mpfr_print_binary (real_sum); putchar ('\n'); mpfr_print_binary (sum); putchar ('\n'); return 1; } } for (i = 0; i < n; i++) { mpfr_urandomb (tab[i], RANDS); } mpfr_set_exp (tab[0], 1000); mpfr_clear (real_non_rounded); algo_exact (real_non_rounded, tab, n, f); for (rnd_mode = 0; rnd_mode < GMP_RND_MAX; rnd_mode++) { mpfr_list_sum (sum, tab, n, (mp_rnd_t) rnd_mode); mpfr_set (real_sum, real_non_rounded, (mp_rnd_t) rnd_mode); if (mpfr_cmp (real_sum, sum) != 0) { printf ("mpfr_list_sum incorrect.\n"); mpfr_print_binary (real_sum); putchar ('\n'); mpfr_print_binary (sum); putchar ('\n'); return 1; } } /* list_sum tested, now test the sorting function */ for (i = 0; i < n; i++) mpfr_urandomb (tab[i], RANDS); tabtmp = (mpfr_ptr *) malloc (n * sizeof(mpfr_ptr)); perm = (mpfr_srcptr *) malloc (n * sizeof(mpfr_srcptr)); for (i = 0; i < n; i++) tabtmp[i] = tab[i]; mpfr_count_sort (tabtmp, n, perm); if (is_sorted (n, perm) == 0) { printf ("mpfr_count_sort incorrect.\n"); for (i = 0; i < n; i++) { mpfr_print_binary (perm[i]); putchar ('\n'); } return 1; } for (i = 0; i < n; i++) mpfr_clear (tab[i]); mpfr_clear (sum); mpfr_clear (real_sum); mpfr_clear (real_non_rounded); free (tab); free (perm); tests_end_mpfr (); return 0; }