/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact ie, iff x = 0 */ int mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_prec_t prec, m; int neg, reduce; mpfr_t c, xr; mpfr_srcptr xx; mpfr_exp_t err, expx; int inexy, inexz; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_ASSERTN (y != z); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN(x) || MPFR_IS_INF(x)) { MPFR_SET_NAN (y); MPFR_SET_NAN (z); MPFR_RET_NAN; } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, x); /* y = 0, thus exact, but z is inexact in case of underflow or overflow */ inexy = 0; /* y is exact */ inexz = mpfr_set_ui (z, 1, rnd_mode); return INEX(inexy,inexz); } } MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("sin[%Pu]=%.*Rg cos[%Pu]=%.*Rg", mpfr_get_prec(y), mpfr_log_prec, y, mpfr_get_prec (z), mpfr_log_prec, z)); MPFR_SAVE_EXPO_MARK (expo); prec = MAX (MPFR_PREC (y), MPFR_PREC (z)); m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13; expx = MPFR_GET_EXP (x); /* When x is close to 0, say 2^(-k), then there is a cancellation of about 2k bits in 1-cos(x)^2. FIXME: in that case, it would be more efficient to compute sin(x) directly. VL: This is partly done by using MPFR_FAST_COMPUTE_IF_SMALL_INPUT from the mpfr_sin and mpfr_cos functions. Moreover, any overflow on m is avoided. */ if (expx < 0) { /* Warning: in case y = x, and the first call to MPFR_FAST_COMPUTE_IF_SMALL_INPUT succeeds but the second fails, we will have clobbered the original value of x. The workaround is to first compute z = cos(x) in that case, since y and z are different. */ if (y != x) /* y and x differ, thus we can safely try to compute y first */ { MPFR_FAST_COMPUTE_IF_SMALL_INPUT ( y, x, -2 * expx, 2, 0, rnd_mode, { inexy = _inexact; goto small_input; });
int mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode) { mpfr_t x; int inexact_sh, inexact_ch; MPFR_ASSERTN (sh != ch); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode), ("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg", mpfr_get_prec (sh), mpfr_log_prec, sh, mpfr_get_prec (ch), mpfr_log_prec, ch)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt))) { if (MPFR_IS_NAN (xt)) { MPFR_SET_NAN (ch); MPFR_SET_NAN (sh); MPFR_RET_NAN; } else if (MPFR_IS_INF (xt)) { MPFR_SET_INF (sh); MPFR_SET_SAME_SIGN (sh, xt); MPFR_SET_INF (ch); MPFR_SET_POS (ch); MPFR_RET (0); } else /* xt is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (xt)); MPFR_SET_ZERO (sh); /* sinh(0) = 0 */ MPFR_SET_SAME_SIGN (sh, xt); inexact_sh = 0; inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */ return INEX(inexact_sh,inexact_ch); } } /* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure that the code also works in case of overlap (see sin_cos.c) */ MPFR_TMP_INIT_ABS (x, xt); { mpfr_t s, c, ti; mpfr_exp_t d; mpfr_prec_t N; /* Precision of the intermediary variables */ long int err; /* Precision of error */ MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_GROUP_DECL (group); MPFR_SAVE_EXPO_MARK (expo); /* compute the precision of intermediary variable */ N = MPFR_PREC (ch); N = MAX (N, MPFR_PREC (sh)); /* the optimal number of bits : see algorithms.ps */ N = N + MPFR_INT_CEIL_LOG2 (N) + 4; /* initialise of intermediary variables */ MPFR_GROUP_INIT_3 (group, N, s, c, ti); /* First computation of sinh_cosh */ MPFR_ZIV_INIT (loop, N); for (;;) { MPFR_BLOCK_DECL (flags); /* compute sinh_cosh */ MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD)); if (MPFR_OVERFLOW (flags)) /* exp(x) does overflow */ { /* since cosh(x) >= exp(x), cosh(x) overflows too */ inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS); /* sinh(x) may be representable */ inexact_sh = mpfr_sinh (sh, xt, rnd_mode); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW); break; } d = MPFR_GET_EXP (s); mpfr_ui_div (ti, 1, s, MPFR_RNDU); /* 1/exp(x) */ mpfr_add (c, s, ti, MPFR_RNDU); /* exp(x) + 1/exp(x) */ mpfr_sub (s, s, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */ mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* 1/2(exp(x) + 1/exp(x)) */ mpfr_div_2ui (s, s, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */ /* it may be that s is zero (in fact, it can only occur when exp(x)=1, and thus ti=1 too) */ if (MPFR_IS_ZERO (s)) err = N; /* double the precision */ else { /* calculation of the error */ d = d - MPFR_GET_EXP (s) + 2; /* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/ err = N - (MAX (d, 0) + 1); if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh), rnd_mode) && \ MPFR_CAN_ROUND (c, err, MPFR_PREC (ch), rnd_mode))) { inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt)); inexact_ch = mpfr_set (ch, c, rnd_mode); break; } } /* actualisation of the precision */ N += err; MPFR_ZIV_NEXT (loop, N); MPFR_GROUP_REPREC_3 (group, N, s, c, ti); } MPFR_ZIV_FREE (loop); MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); } /* now, let's raise the flags if needed */ inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode); inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode); return INEX(inexact_sh,inexact_ch); }
int mpfr_grandom (mpfr_ptr rop1, mpfr_ptr rop2, gmp_randstate_t rstate, mpfr_rnd_t rnd) { int inex1, inex2, s1, s2; mpz_t x, y, xp, yp, t, a, b, s; mpfr_t sfr, l, r1, r2; mpfr_prec_t tprec, tprec0; inex2 = inex1 = 0; if (rop2 == NULL) /* only one output requested. */ { tprec0 = MPFR_PREC (rop1); } else { tprec0 = MAX (MPFR_PREC (rop1), MPFR_PREC (rop2)); } tprec0 += 11; /* We use "Marsaglia polar method" here (cf. George Marsaglia, Normal (Gaussian) random variables for supercomputers The Journal of Supercomputing, Volume 5, Number 1, 49–55 DOI: 10.1007/BF00155857). First we draw uniform x and y in [0,1] using mpz_urandomb (in fixed precision), and scale them to [-1, 1]. */ mpz_init (xp); mpz_init (yp); mpz_init (x); mpz_init (y); mpz_init (t); mpz_init (s); mpz_init (a); mpz_init (b); mpfr_init2 (sfr, MPFR_PREC_MIN); mpfr_init2 (l, MPFR_PREC_MIN); mpfr_init2 (r1, MPFR_PREC_MIN); if (rop2 != NULL) mpfr_init2 (r2, MPFR_PREC_MIN); mpz_set_ui (xp, 0); mpz_set_ui (yp, 0); for (;;) { tprec = tprec0; do { mpz_urandomb (xp, rstate, tprec); mpz_urandomb (yp, rstate, tprec); mpz_mul (a, xp, xp); mpz_mul (b, yp, yp); mpz_add (s, a, b); } while (mpz_sizeinbase (s, 2) > tprec * 2); /* x^2 + y^2 <= 2^{2tprec} */ for (;;) { /* FIXME: compute s as s += 2x + 2y + 2 */ mpz_add_ui (a, xp, 1); mpz_add_ui (b, yp, 1); mpz_mul (a, a, a); mpz_mul (b, b, b); mpz_add (s, a, b); if ((mpz_sizeinbase (s, 2) <= 2 * tprec) || ((mpz_sizeinbase (s, 2) == 2 * tprec + 1) && (mpz_scan1 (s, 0) == 2 * tprec))) goto yeepee; /* Extend by 32 bits */ mpz_mul_2exp (xp, xp, 32); mpz_mul_2exp (yp, yp, 32); mpz_urandomb (x, rstate, 32); mpz_urandomb (y, rstate, 32); mpz_add (xp, xp, x); mpz_add (yp, yp, y); tprec += 32; mpz_mul (a, xp, xp); mpz_mul (b, yp, yp); mpz_add (s, a, b); if (mpz_sizeinbase (s, 2) > tprec * 2) break; } } yeepee: /* FIXME: compute s with s -= 2x + 2y + 2 */ mpz_mul (a, xp, xp); mpz_mul (b, yp, yp); mpz_add (s, a, b); /* Compute the signs of the output */ mpz_urandomb (x, rstate, 2); s1 = mpz_tstbit (x, 0); s2 = mpz_tstbit (x, 1); for (;;) { /* s = xp^2 + yp^2 (loop invariant) */ mpfr_set_prec (sfr, 2 * tprec); mpfr_set_prec (l, tprec); mpfr_set_z (sfr, s, MPFR_RNDN); /* exact */ mpfr_mul_2si (sfr, sfr, -2 * tprec, MPFR_RNDN); /* exact */ mpfr_log (l, sfr, MPFR_RNDN); mpfr_neg (l, l, MPFR_RNDN); mpfr_mul_2si (l, l, 1, MPFR_RNDN); mpfr_div (l, l, sfr, MPFR_RNDN); mpfr_sqrt (l, l, MPFR_RNDN); mpfr_set_prec (r1, tprec); mpfr_mul_z (r1, l, xp, MPFR_RNDN); mpfr_div_2ui (r1, r1, tprec, MPFR_RNDN); /* exact */ if (s1) mpfr_neg (r1, r1, MPFR_RNDN); if (MPFR_CAN_ROUND (r1, tprec - 2, MPFR_PREC (rop1), rnd)) { if (rop2 != NULL) { mpfr_set_prec (r2, tprec); mpfr_mul_z (r2, l, yp, MPFR_RNDN); mpfr_div_2ui (r2, r2, tprec, MPFR_RNDN); /* exact */ if (s2) mpfr_neg (r2, r2, MPFR_RNDN); if (MPFR_CAN_ROUND (r2, tprec - 2, MPFR_PREC (rop2), rnd)) break; } else break; } /* Extend by 32 bits */ mpz_mul_2exp (xp, xp, 32); mpz_mul_2exp (yp, yp, 32); mpz_urandomb (x, rstate, 32); mpz_urandomb (y, rstate, 32); mpz_add (xp, xp, x); mpz_add (yp, yp, y); tprec += 32; mpz_mul (a, xp, xp); mpz_mul (b, yp, yp); mpz_add (s, a, b); } inex1 = mpfr_set (rop1, r1, rnd); if (rop2 != NULL) { inex2 = mpfr_set (rop2, r2, rnd); inex2 = mpfr_check_range (rop2, inex2, rnd); } inex1 = mpfr_check_range (rop1, inex1, rnd); if (rop2 != NULL) mpfr_clear (r2); mpfr_clear (r1); mpfr_clear (l); mpfr_clear (sfr); mpz_clear (b); mpz_clear (a); mpz_clear (s); mpz_clear (t); mpz_clear (y); mpz_clear (x); mpz_clear (yp); mpz_clear (xp); return INEX (inex1, inex2); }
/* 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)); } }