int
mpc_mul_2ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_mul_2ui (mpc_realref(a), mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_mul_2ui (mpc_imagref(a), mpc_imagref(b), c, MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
void Compute(gmp_randstate_t r) const {
// The algorithm is sample x and z from the exponential distribution; if
// (x-1)^2 < 2*z, return (random sign)*x; otherwise repeat. Probability
// of acceptance is sqrt(pi/2) * exp(-1/2) = 0.7602.
while (true) {
_edist(_x, r);
_edist(_z, r);
for (mp_size_t k = 1; ; ++k) {
_x.ExpandTo(r, k - 1);
_z.ExpandTo(r, k - 1);
mpfr_prec_t prec = std::max(mpfr_prec_t(MPFR_PREC_MIN), k * bits);
mpfr_set_prec(_xf, prec);
mpfr_set_prec(_zf, prec);
// Try for acceptance first; so compute upper limit on (y-1)^2 and
// lower limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDD);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDU);
} else {
_x(_xf, MPFR_RNDU);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDU);
}
mpfr_sqr(_xf, _xf, MPFR_RNDU);
_z(_zf, MPFR_RNDD);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDD);
if (mpfr_cmp(_xf, _zf) < 0) { // (y-1)^2 < 2*z, so accept
if (_x.Boolean(r)) _x.Negate(); // include a random sign
return;
}
// Try for rejection; so compute lower limit on (y-1)^2 and upper
// limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDU);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDD);
} else {
_x(_xf, MPFR_RNDD);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDD);
}
mpfr_sqr(_xf, _xf, MPFR_RNDD);
_z(_zf, MPFR_RNDU);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDU);
if (mpfr_cmp(_xf, _zf) > 0) // (y-1)^2 > 2*z, so reject
break;
// Otherwise repeat with more precision
}
// Reject and start over with a new y and z
}
}
static PyObject *
GMPy_Real_Mul_2exp(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *result, *tempx;
unsigned long exp = 0;
CHECK_CONTEXT(context);
exp = c_ulong_From_Integer(y);
if (exp == (unsigned long)(-1) && PyErr_Occurred()) {
return NULL;
}
result = GMPy_MPFR_New(0, context);
tempx = GMPy_MPFR_From_Real(x, 1, context);
if (!result || !tempx) {
Py_XDECREF((PyObject*)result);
Py_XDECREF((PyObject*)tempx);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_mul_2ui(result->f, tempx->f, exp, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
GMPY_MPFR_CLEANUP(result, context, "mul_2exp()");
return (PyObject*)result;
}
/* Bug found by Jakub Jelinek
* http://bugzilla.redhat.com/643657
* https://gforge.inria.fr/tracker/index.php?func=detail&aid=11301
* The consequence can be either an assertion failure (i = 2 in the
* testcase below, in debug mode) or an incorrectly rounded value.
*/
static void
bug20101017 (void)
{
mpfr_t a, b, c;
int inex;
int i;
mpfr_init2 (a, GMP_NUMB_BITS * 2);
mpfr_init2 (b, GMP_NUMB_BITS);
mpfr_init2 (c, GMP_NUMB_BITS);
/* a = 2^(2N) + k.2^(2N-1) + 2^N and b = 1
with N = GMP_NUMB_BITS and k = 0 or 1.
c = a - b should round to the same value as a. */
for (i = 2; i <= 3; i++)
{
mpfr_set_ui_2exp (a, i, GMP_NUMB_BITS - 1, MPFR_RNDN);
mpfr_add_ui (a, a, 1, MPFR_RNDN);
mpfr_mul_2ui (a, a, GMP_NUMB_BITS, MPFR_RNDN);
mpfr_set_ui (b, 1, MPFR_RNDN);
inex = mpfr_sub (c, a, b, MPFR_RNDN);
mpfr_set (b, a, MPFR_RNDN);
if (! mpfr_equal_p (c, b))
{
printf ("Error in bug20101017 for i = %d.\n", i);
printf ("Expected ");
mpfr_out_str (stdout, 16, 0, b, MPFR_RNDN);
putchar ('\n');
printf ("Got ");
mpfr_out_str (stdout, 16, 0, c, MPFR_RNDN);
putchar ('\n');
exit (1);
}
if (inex >= 0)
{
printf ("Error in bug20101017 for i = %d: bad inex value.\n", i);
printf ("Expected negative, got %d.\n", inex);
exit (1);
}
}
mpfr_set_prec (a, 64);
mpfr_set_prec (b, 129);
mpfr_set_prec (c, 2);
mpfr_set_str_binary (b, "0.100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000001E65");
mpfr_set_str_binary (c, "0.10E1");
inex = mpfr_sub (a, b, c, MPFR_RNDN);
if (mpfr_cmp_ui_2exp (a, 1, 64) != 0 || inex >= 0)
{
printf ("Error in mpfr_sub for b-c for b=2^64+1+2^(-64), c=1\n");
printf ("Expected result 2^64 with inex < 0\n");
printf ("Got ");
mpfr_print_binary (a);
printf (" with inex=%d\n", inex);
exit (1);
}
mpfr_clears (a, b, c, (mpfr_ptr) 0);
}
/* Test provided by Christopher Creutzig, 2007-05-21. */
static void
check_tiny (void)
{
mpfr_t x, y;
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
mpfr_sin (y, x, MPFR_RNDD);
if (mpfr_cmp (x, y) < 0)
{
printf ("Error in check_tiny: got sin(x) > x for x = 2^(emin-1)\n");
exit (1);
}
mpfr_sin (y, x, MPFR_RNDU);
mpfr_mul_2ui (y, y, 1, MPFR_RNDU);
if (mpfr_cmp (x, y) > 0)
{
printf ("Error in check_tiny: got sin(x) < x/2 for x = 2^(emin-1)\n");
exit (1);
}
mpfr_neg (x, x, MPFR_RNDN);
mpfr_sin (y, x, MPFR_RNDU);
if (mpfr_cmp (x, y) > 0)
{
printf ("Error in check_tiny: got sin(x) < x for x = -2^(emin-1)\n");
exit (1);
}
mpfr_sin (y, x, MPFR_RNDD);
mpfr_mul_2ui (y, y, 1, MPFR_RNDD);
if (mpfr_cmp (x, y) < 0)
{
printf ("Error in check_tiny: got sin(x) > x/2 for x = -2^(emin-1)\n");
exit (1);
}
mpfr_clear (y);
mpfr_clear (x);
}
// Evaluate the sign of the rejection condition v^2 + 4*u^2*log(u)
int Reject(mpfr_t u, mpfr_t v, mpfr_prec_t prec, mpfr_rnd_t round) const {
// Use x1, x2 as scratch
mpfr_set_prec(_x1, prec);
mpfr_log(_x1, u, round);
mpfr_mul(_x1, _x1, u, round); // Important to do the multiplications in
mpfr_mul(_x1, _x1, u, round); // this order so that rounding works right.
mpfr_mul_2ui(_x1, _x1, 2u, round); // 4*u^2*log(u)
mpfr_set_prec(_x2, prec);
mpfr_mul(_x2, v, v, round); // v^2
mpfr_add(_x1, _x1, _x2, round); // v^2 + 4*u^2*log(u)
return mpfr_sgn(_x1);
}
static void
pow_int (mpfr_rnd_t rnd)
{
mpfr_t ref1, ref2, ref3;
mpfr_t res1;
int i;
#ifdef DEBUG
printf("pow_int\n");
#endif
mpfr_inits2 ((randlimb () % 200) + MPFR_PREC_MIN,
ref1, ref2, res1, (mpfr_ptr) 0);
mpfr_init2 (ref3, 1005);
for (i = 0; i <= 15; i++)
{
mpfr_urandomb (ref2, RANDS);
if (i & 1)
mpfr_neg (ref2, ref2, MPFR_RNDN);
mpfr_set_ui (ref3, 20, MPFR_RNDN);
/* We need to test huge integers because different algorithms/codes
are used for not-too-large integers (mpfr_pow_z) and for general
cases, in particular huge integers (mpfr_pow_general). [r7606] */
if (i & 2)
mpfr_mul_2ui (ref3, ref3, 1000, MPFR_RNDN);
if (i & 4)
mpfr_add_ui (ref3, ref3, 1, MPFR_RNDN); /* odd integer */
/* reference call: pow(a, b, c) */
mpfr_pow (ref1, ref2, ref3, rnd);
/* pow(a, a, c) */
mpfr_set (res1, ref2, rnd); /* exact operation */
mpfr_pow (res1, res1, ref3, rnd);
if (mpfr_compare (res1, ref1))
{
printf ("Error for pow_int(a, a, c) for ");
DISP("a=",ref2); DISP2(", c=",ref3);
printf ("expected "); mpfr_print_binary (ref1); puts ("");
printf ("got "); mpfr_print_binary (res1); puts ("");
exit (1);
}
}
mpfr_clears (ref1, ref2, ref3, res1, (mpfr_ptr) 0);
}
int
mpfr_mul_2ui (mpfr_ptr y, mpfr_srcptr x, unsigned long int n, mpfr_rnd_t rnd_mode)
{
int inexact;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg n=%lu rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x, n, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
inexact = MPFR_UNLIKELY(y != x) ? mpfr_set (y, x, rnd_mode) : 0;
if (MPFR_LIKELY( MPFR_IS_PURE_FP(y)) )
{
/* n will have to be casted to long to make sure that the addition
and subtraction below (for overflow detection) are signed */
while (MPFR_UNLIKELY(n > LONG_MAX))
{
int inex2;
n -= LONG_MAX;
inex2 = mpfr_mul_2ui(y, y, LONG_MAX, rnd_mode);
if (inex2)
return inex2; /* overflow */
}
/* MPFR_EMIN_MIN + (long) n is signed and doesn't lead to an overflow;
the first test useful so that the real test can't lead to an
overflow. */
{
mpfr_exp_t exp = MPFR_GET_EXP (y);
if (MPFR_UNLIKELY( __gmpfr_emax < MPFR_EMIN_MIN + (long) n ||
exp > __gmpfr_emax - (long) n))
return mpfr_overflow (y, rnd_mode, MPFR_SIGN(y));
MPFR_SET_EXP (y, exp + (long) n);
}
}
return inexact;
}
/* Return in y an approximation of Ei(x) using the asymptotic expansion:
Ei(x) = exp(x)/x * (1 + 1/x + 2/x^2 + ... + k!/x^k + ...)
Assumes x >= PREC(y) * log(2).
Returns the error bound in terms of ulp(y).
*/
static mp_exp_t
mpfr_eint_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mp_prec_t p = MPFR_PREC(y);
mpfr_t invx, t, err;
unsigned long k;
mp_exp_t err_exp;
mpfr_init2 (t, p);
mpfr_init2 (invx, p);
mpfr_init2 (err, 31); /* error in ulps on y */
mpfr_ui_div (invx, 1, x, GMP_RNDN); /* invx = 1/x*(1+u) with |u|<=2^(1-p) */
mpfr_set_ui (t, 1, GMP_RNDN); /* exact */
mpfr_set (y, t, GMP_RNDN);
mpfr_set_ui (err, 0, GMP_RNDN);
for (k = 1; MPFR_GET_EXP(t) + (mp_exp_t) p > MPFR_GET_EXP(y); k++)
{
mpfr_mul (t, t, invx, GMP_RNDN); /* 2 more roundings */
mpfr_mul_ui (t, t, k, GMP_RNDN); /* 1 more rounding: t = k!/x^k*(1+u)^e
with u=2^{-p} and |e| <= 3*k */
/* we use the fact that |(1+u)^n-1| <= 2*|n*u| for |n*u| <= 1, thus
the error on t is less than 6*k*2^{-p}*t <= 6*k*ulp(t) */
/* err is in terms of ulp(y): transform it in terms of ulp(t) */
mpfr_mul_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add_ui (err, err, 6 * k, GMP_RNDU);
/* transform back in terms of ulp(y) */
mpfr_div_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add (y, y, t, GMP_RNDN);
}
/* add the truncation error bounded by ulp(y): 1 ulp */
mpfr_mul (y, y, invx, GMP_RNDN); /* err <= 2*err + 3/2 */
mpfr_exp (t, x, GMP_RNDN); /* err(t) <= 1/2*ulp(t) */
mpfr_mul (y, y, t, GMP_RNDN); /* again: err <= 2*err + 3/2 */
mpfr_mul_2ui (err, err, 2, GMP_RNDU);
mpfr_add_ui (err, err, 8, GMP_RNDU);
err_exp = MPFR_GET_EXP(err);
mpfr_clear (t);
mpfr_clear (invx);
mpfr_clear (err);
return err_exp;
}
static void
exprange (void)
{
mpfr_exp_t emin, emax;
mpfr_t x, y, z;
int inex1, inex2;
unsigned int flags1, flags2;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init2 (x, 16);
mpfr_inits2 (8, y, z, (mpfr_ptr) 0);
mpfr_set_ui_2exp (x, 5, -1, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDN);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emin (0);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emin (emin);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test1)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_ui_2exp (x, 32769, -60, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (45);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test2)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_emax (44);
mpfr_clear_flags ();
inex1 = mpfr_check_range (y, inex1, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test3)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_ui_2exp (x, 1, -60, MPFR_RNDN);
mpfr_clear_flags ();
inex1 = mpfr_gamma (y, x, MPFR_RNDD);
flags1 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (60);
mpfr_clear_flags ();
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
mpfr_set_emax (emax);
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test4)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
MPFR_ASSERTN (MPFR_EMIN_MIN == - MPFR_EMAX_MAX);
mpfr_set_emin (MPFR_EMIN_MIN);
mpfr_set_emax (MPFR_EMAX_MAX);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_nextabove (x); /* x = 2^(emin - 1) */
mpfr_set_inf (y, 1);
inex1 = 1;
flags1 = MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
mpfr_clear_flags ();
/* MPFR_RNDU: overflow, infinity since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDU);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test5)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
/* MPFR_RNDN: overflow, infinity since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test6)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_nextbelow (y);
inex1 = -1;
mpfr_clear_flags ();
/* MPFR_RNDD: overflow, maxnum since 1/x = 2^(emax + 1) */
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test7)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_mul_2ui (x, x, 1, MPFR_RNDN); /* x = 2^emin */
mpfr_set_inf (y, 1);
inex1 = 1;
flags1 = MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
mpfr_clear_flags ();
/* MPFR_RNDU: overflow, infinity since 1/x = 2^emax */
inex2 = mpfr_gamma (z, x, MPFR_RNDU);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test8)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
/* MPFR_RNDN: overflow, infinity since 1/x = 2^emax */
inex2 = mpfr_gamma (z, x, MPFR_RNDN);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test9)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_nextbelow (y);
inex1 = -1;
flags1 = MPFR_FLAGS_INEXACT;
mpfr_clear_flags ();
/* MPFR_RNDD: no overflow, maxnum since 1/x = 2^emax and euler > 0 */
inex2 = mpfr_gamma (z, x, MPFR_RNDD);
flags2 = __gmpfr_flags;
MPFR_ASSERTN (mpfr_inexflag_p ());
if (inex1 != inex2 || flags1 != flags2 || ! mpfr_equal_p (y, z))
{
printf ("Error in exprange (test10)\n");
printf ("x = ");
mpfr_dump (x);
printf ("Expected inex1 = %d, flags1 = %u, ", SIGN (inex1), flags1);
mpfr_dump (y);
printf ("Got inex2 = %d, flags2 = %u, ", SIGN (inex2), flags2);
mpfr_dump (z);
exit (1);
}
mpfr_set_emin (emin);
mpfr_set_emax (emax);
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
int
main (int argc, char *argv[])
{
mpfr_t w,z;
unsigned long k;
int i;
tests_start_mpfr ();
mpfr_inits2 (53, w, z, (mpfr_ptr) 0);
for (i = 0; i < 3; i++)
{
mpfr_set_inf (w, 1);
test_mul (i, 0, w, w, 10, MPFR_RNDZ);
if (!MPFR_IS_INF(w))
{
printf ("Result is not Inf (i = %d)\n", i);
exit (1);
}
mpfr_set_nan (w);
test_mul (i, 0, w, w, 10, MPFR_RNDZ);
if (!MPFR_IS_NAN(w))
{
printf ("Result is not NaN (i = %d)\n", i);
exit (1);
}
for (k = 0 ; k < numberof(val) ; k+=3)
{
mpfr_set_str (w, val[k], 16, MPFR_RNDN);
test_mul (i, 0, z, w, 10, MPFR_RNDZ);
if (mpfr_cmp_str (z, val[k+1], 16, MPFR_RNDN))
{
printf ("ERROR for x * 2^n (i = %d) for %s\n", i, val[k]);
printf ("Expected: %s\n"
"Got : ", val[k+1]);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
putchar ('\n');
exit (1);
}
test_mul (i, 1, z, w, 10, MPFR_RNDZ);
if (mpfr_cmp_str (z, val[k+2], 16, MPFR_RNDN))
{
printf ("ERROR for x / 2^n (i = %d) for %s\n", i, val[k]);
printf ("Expected: %s\n"
"Got : ", val[k+2]);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
putchar ('\n');
exit (1);
}
}
mpfr_set_inf (w, 1);
mpfr_nextbelow (w);
test_mul (i, 0, w, w, 1, MPFR_RNDN);
if (!mpfr_inf_p (w))
{
printf ("Overflow error (i = %d)!\n", i);
exit (1);
}
mpfr_set_ui (w, 0, MPFR_RNDN);
mpfr_nextabove (w);
test_mul (i, 1, w, w, 1, MPFR_RNDN);
if (mpfr_cmp_ui (w, 0))
{
printf ("Underflow error (i = %d)!\n", i);
exit (1);
}
}
if (MPFR_EXP_MAX >= LONG_MAX/2 && MPFR_EXP_MIN <= LONG_MAX/2-LONG_MAX-1)
{
unsigned long lmp1 = (unsigned long) LONG_MAX + 1;
mpfr_set_ui (w, 1, MPFR_RNDN);
mpfr_mul_2ui (w, w, LONG_MAX/2, MPFR_RNDZ);
mpfr_div_2ui (w, w, lmp1, MPFR_RNDZ);
mpfr_mul_2ui (w, w, lmp1 - LONG_MAX/2, MPFR_RNDZ);
if (!mpfr_cmp_ui (w, 1))
{
printf ("Underflow LONG_MAX error!\n");
exit (1);
}
}
mpfr_clears (w, z, (mpfr_ptr) 0);
underflow0 ();
large0 ();
tests_end_mpfr ();
return 0;
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mpfr_exp_t d;
mpfr_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh */
MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */
/* t <- cosh(x/2): error(t) <= 1 ulp(t) */
MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
overflows too */
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
mpfr_sinh (ti, ti, MPFR_RNDD);
/* multiplication below, error(t) <= 5 ulp(t) */
MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* doubling below, exact */
MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* we have lost at most 3 bits of precision */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
err = Nt; /* double the precision */
}
else
{
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_exp_3 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t t, x_copy, tmp;
mpz_t uk;
mp_exp_t ttt, shift_x;
unsigned long twopoweri;
mpz_t *P;
mp_prec_t *mult;
int i, k, loop;
int prec_x;
mp_prec_t realprec, Prec;
int iter;
int inexact = 0;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (ziv_loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
MPFR_SAVE_EXPO_MARK (expo);
/* decompose x */
/* we first write x = 1.xxxxxxxxxxxxx
----- k bits -- */
prec_x = MPFR_INT_CEIL_LOG2 (MPFR_PREC (x)) - MPFR_LOG2_BITS_PER_MP_LIMB;
if (prec_x < 0)
prec_x = 0;
ttt = MPFR_GET_EXP (x);
mpfr_init2 (x_copy, MPFR_PREC(x));
mpfr_set (x_copy, x, GMP_RNDD);
/* we shift to get a number less than 1 */
if (ttt > 0)
{
shift_x = ttt;
mpfr_div_2ui (x_copy, x, ttt, GMP_RNDN);
ttt = MPFR_GET_EXP (x_copy);
}
else
shift_x = 0;
MPFR_ASSERTD (ttt <= 0);
/* Init prec and vars */
realprec = MPFR_PREC (y) + MPFR_INT_CEIL_LOG2 (prec_x + MPFR_PREC (y));
Prec = realprec + shift + 2 + shift_x;
mpfr_init2 (t, Prec);
mpfr_init2 (tmp, Prec);
mpz_init (uk);
/* Main loop */
MPFR_ZIV_INIT (ziv_loop, realprec);
for (;;)
{
int scaled = 0;
MPFR_BLOCK_DECL (flags);
k = MPFR_INT_CEIL_LOG2 (Prec) - MPFR_LOG2_BITS_PER_MP_LIMB;
/* now we have to extract */
twopoweri = BITS_PER_MP_LIMB;
/* Allocate tables */
P = (mpz_t*) (*__gmp_allocate_func) (3*(k+2)*sizeof(mpz_t));
for (i = 0; i < 3*(k+2); i++)
mpz_init (P[i]);
mult = (mp_prec_t*) (*__gmp_allocate_func) (2*(k+2)*sizeof(mp_prec_t));
/* Particular case for i==0 */
mpfr_extract (uk, x_copy, 0);
MPFR_ASSERTD (mpz_cmp_ui (uk, 0) != 0);
mpfr_exp_rational (tmp, uk, shift + twopoweri - ttt, k + 1, P, mult);
for (loop = 0; loop < shift; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
twopoweri *= 2;
/* General case */
iter = (k <= prec_x) ? k : prec_x;
for (i = 1; i <= iter; i++)
{
mpfr_extract (uk, x_copy, i);
if (MPFR_LIKELY (mpz_cmp_ui (uk, 0) != 0))
{
mpfr_exp_rational (t, uk, twopoweri - ttt, k - i + 1, P, mult);
mpfr_mul (tmp, tmp, t, GMP_RNDD);
}
MPFR_ASSERTN (twopoweri <= LONG_MAX/2);
twopoweri *=2;
}
/* Clear tables */
for (i = 0; i < 3*(k+2); i++)
mpz_clear (P[i]);
(*__gmp_free_func) (P, 3*(k+2)*sizeof(mpz_t));
(*__gmp_free_func) (mult, 2*(k+2)*sizeof(mp_prec_t));
if (shift_x > 0)
{
MPFR_BLOCK (flags, {
for (loop = 0; loop < shift_x - 1; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
mpfr_sqr (t, tmp, GMP_RNDD);
} );
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* tmp <= exact result, so that it is a real overflow. */
inexact = mpfr_overflow (y, rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
{
/* This may be a spurious underflow. So, let's scale
the result. */
mpfr_mul_2ui (tmp, tmp, 1, GMP_RNDD); /* no overflow, exact */
mpfr_sqr (t, tmp, GMP_RNDD);
if (MPFR_IS_ZERO (t))
{
/* approximate result < 2^(emin - 3), thus
exact result < 2^(emin - 2). */
inexact = mpfr_underflow (y, (rnd_mode == GMP_RNDN) ?
GMP_RNDZ : rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
break;
}
scaled = 1;
}
}
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
from Abramowitz & Stegun).
Assumes |z| > p log(2)/2, where p is the target precision
(z can be negative only for jn).
Return 0 if the expansion does not converge enough (the value 0 as inexact
flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
mpfr_prec_t w;
long k;
int inex, stop, diverge = 0;
mpfr_exp_t err2, err;
MPFR_ZIV_DECL (loop);
mpfr_init (c);
w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;
MPFR_ZIV_INIT (loop, w);
for (;;)
{
mpfr_set_prec (c, w);
mpfr_init2 (s, w);
mpfr_init2 (P, w);
mpfr_init2 (Q, w);
mpfr_init2 (t, w);
mpfr_init2 (iz, w);
mpfr_init2 (err_t, 31);
mpfr_init2 (err_s, 31);
mpfr_init2 (err_u, 31);
/* Approximate sin(z) and cos(z). In the following, err <= k means that
the approximate value y and the true value x are related by
y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
mpfr_sin_cos (s, c, z, MPFR_RNDN);
if (MPFR_IS_NEG(z))
mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
/* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
mpfr_add (t, s, c, MPFR_RNDN);
mpfr_sub (c, s, c, MPFR_RNDN);
mpfr_swap (s, t);
/* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
with total absolute error bounded by 2^(1-w). */
/* precompute 1/(8|z|) */
mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */
mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);
/* compute P and Q */
mpfr_set_ui (P, 1, MPFR_RNDN);
mpfr_set_ui (Q, 0, MPFR_RNDN);
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
for (k = 1, stop = 0; stop < 4; k++)
{
/* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */
mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */
/* the relative error on t is bounded by (1+u)^(5k)-1, which is
bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
/* the absolute error on t is bounded by err_t * 2^(-w) */
mpfr_abs (err_u, t, MPFR_RNDU);
mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
if (stop >= 2)
{
/* take into account the neglected terms: t * 2^w */
mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
if (MPFR_IS_POS(t))
mpfr_add (err_s, err_s, t, MPFR_RNDU);
else
mpfr_sub (err_s, err_s, t, MPFR_RNDU);
mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
stop ++;
}
/* if k is odd, add to Q, otherwise to P */
else if (k & 1)
{
/* if k = 1 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (Q, Q, t, MPFR_RNDN);
else
mpfr_sub (Q, Q, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(Q): if EXP(err_u)
<= EXP(Q), since the current term is bounded by
err_u * 2^(-w), it is bounded by ulp(Q) */
if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
stop ++;
else
stop = 0;
}
else
{
/* if k = 0 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (P, P, t, MPFR_RNDN);
else
mpfr_sub (P, P, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(P) */
if (MPFR_EXP(err_u) <= MPFR_EXP(P))
stop ++;
else
stop = 0;
}
mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
/* the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w) */
/* stop when start to diverge */
if (stop < 2 &&
((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
(MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
{
/* if we have to stop the series because it diverges, then
increasing the precision will most probably fail, since
we will stop to the same point, and thus compute a very
similar approximation */
diverge = 1;
stop = 2; /* force stop */
}
}
/* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */
/* Now combine: the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
Q * (sin + cos) + P (sin - cos) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_sub (s, s, c, MPFR_RNDN);
#else
mpfr_add (s, s, c, MPFR_RNDN);
#endif
}
else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
Q * (sin - cos) - P (cos + sin) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_add (s, s, c, MPFR_RNDN);
#else
mpfr_sub (s, c, s, MPFR_RNDN);
#endif
}
if ((n & 2) != 0)
mpfr_neg (s, s, MPFR_RNDN);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
/* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
+ err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
<= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
since |c|, |old_s| <= 2. */
err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
/* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
/* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
err2 = (err >= err2) ? err + 1 : err2 + 1;
/* now the absolute error on s is bounded by 2^(err2 - w) */
/* multiply by sqrt(1/(Pi*z)) */
mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */
mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */
mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is
bounded by 3*u*|c| for |u| <= 0.25 */
mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDU);
mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
/* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
err2 += MPFR_EXP(c);
/* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by
1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
+ |old_c| * 2^(err2 - w) */
/* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
/* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
/* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
err = (err >= err2) ? err + 1 : err2 + 1;
/* the absolute error on c is bounded by 2^(err - w) */
mpfr_clear (s);
mpfr_clear (P);
mpfr_clear (Q);
mpfr_clear (t);
mpfr_clear (iz);
mpfr_clear (err_t);
mpfr_clear (err_s);
mpfr_clear (err_u);
err -= MPFR_EXP(c);
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
break;
if (diverge != 0)
{
mpfr_set (c, z, r); /* will force inex=0 below, which means the
asymptotic expansion failed */
break;
}
MPFR_ZIV_NEXT (loop, w);
}
MPFR_ZIV_FREE (loop);
inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
: mpfr_neg (res, c, r);
mpfr_clear (c);
return inex;
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact
ie, iff x = 0 */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mp_prec_t prec, m;
int neg, reduce;
mpfr_t c, xr;
mpfr_srcptr xx;
mp_exp_t err, expx;
MPFR_ZIV_DECL (loop);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN (y);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
/* y = 0, thus exact, but z is inexact in case of underflow
or overflow */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("sin[%#R]=%R cos[%#R]=%R", y, y, z, z));
prec = MAX (MPFR_PREC (y), MPFR_PREC (z));
m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* the following is copied from sin.c */
if (expx >= 2) /* reduce the argument */
{
reduce = 1;
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN);
mpfr_remainder (xr, x, c, GMP_RNDN);
mpfr_div_2ui (c, c, 1, GMP_RNDN);
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, GMP_RNDZ);
else
mpfr_add (c, c, xr, GMP_RNDZ);
if (MPFR_IS_ZERO(xr) || MPFR_EXP(xr) < (mp_exp_t) 3 - (mp_exp_t) m
|| MPFR_EXP(c) < (mp_exp_t) 3 - (mp_exp_t) m)
goto next_step;
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
neg = MPFR_IS_NEG (xx); /* gives sign of sin(x) */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, GMP_RNDZ);
/* If no argument reduction was performed, the error is at most ulp(c),
otherwise it is at most ulp(c) + 2^(2-m). Since |c| < 1, we have
ulp(c) <= 2^(-m), thus the error is bounded by 2^(3-m) in that later
case. */
if (reduce == 0)
err = m;
else
err = MPFR_GET_EXP (c) + (mp_exp_t) (m - 3);
if (!mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (z) + (rnd_mode == GMP_RNDN)))
goto next_step;
mpfr_set (z, c, rnd_mode);
mpfr_sqr (c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
err = 2 + (- MPFR_GET_EXP (c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
MPFR_CHANGE_SIGN (c);
/* the absolute error on c is at most 2^(err-m), which we must put
in the form 2^(EXP(c)-err). If there was an argument reduction,
we need to add 2^(2-m); since err >= 2, the error is bounded by
2^(err+1-m) in that case. */
err = MPFR_GET_EXP (c) + (mp_exp_t) m - (err + reduce);
if (mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (y) + (rnd_mode == GMP_RNDN)))
break;
/* check for huge cancellation */
if (err < (mp_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1
&& MPFR_MANT (c)[MPFR_LIMB_SIZE (c)-1] == MPFR_LIMB_HIGHBIT)
m += m;
next_step:
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (c, m);
}
MPFR_ZIV_FREE (loop);
mpfr_set (y, c, rnd_mode);
mpfr_clear (c);
mpfr_clear (xr);
MPFR_RET (1); /* Always inexact */
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int K0, K, precy, m, k, l, inexact;
mpfr_t r, s;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
mpfr_set_ui (y, 1, GMP_RNDN);
return 0;
}
precy = MPFR_PREC(y);
K0 = _mpfr_isqrt(precy / 2);
/* we need at least K + log2(precy/K) extra bits */
m = precy + 3 * K0 + 3;
mpfr_init2 (r, m);
mpfr_init2 (s, m);
do
{
mpfr_mul (r, x, x, GMP_RNDU); /* err <= 1 ulp */
/* we need that |r| < 1 for mpfr_cos2_aux, i.e. up(x^2)/2^(2K) < 1 */
K = K0 + MAX(MPFR_EXP(r), 0);
mpfr_div_2ui (r, r, 2 * K, GMP_RNDN); /* r = (x/2^K)^2, err <= 1 ulp */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
for (k = 0; k < K; k++)
{
mpfr_mul (s, s, s, GMP_RNDU); /* err <= 2*olderr */
mpfr_mul_2ui (s, s, 1, GMP_RNDU); /* err <= 4*olderr */
mpfr_sub_ui (s, s, 1, GMP_RNDN);
}
/* absolute error on s is bounded by (2l+1/3)*2^(2K-m) */
for (k = 2 * K, l = 2 * l + 1; l > 1; k++, l = (l + 1) >> 1);
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
l = mpfr_can_round (s, MPFR_EXP(s) + m - k, GMP_RNDN, rnd_mode, precy);
if (l == 0)
{
m += BITS_PER_MP_LIMB;
mpfr_set_prec (r, m);
mpfr_set_prec (s, m);
}
}
while (l == 0);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
return inexact;
}
/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
where x = n*log(2)+(2^K)*r
together with Brent-Kung O(t^(1/2)) algorithm for the evaluation of
power series. The resulting complexity is O(n^(1/3)*M(n)).
*/
int
mpfr_exp_2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
long n;
unsigned long K, k, l, err; /* FIXME: Which type ? */
int error_r;
mp_exp_t exps;
mp_prec_t q, precy;
int inexact;
mpfr_t r, s, t;
mpz_t ss;
TMP_DECL(marker);
precy = MPFR_PREC(y);
MPFR_TRACE ( printf("Py=%d Px=%d", MPFR_PREC(y), MPFR_PREC(x)) );
MPFR_TRACE ( MPFR_DUMP (x) );
n = (long) (mpfr_get_d1 (x) / LOG2);
/* error bounds the cancelled bits in x - n*log(2) */
if (MPFR_UNLIKELY(n == 0))
error_r = 0;
else
count_leading_zeros (error_r, (mp_limb_t) (n < 0) ? -n : n);
error_r = BITS_PER_MP_LIMB - error_r + 2;
/* for the O(n^(1/2)*M(n)) method, the Taylor series computation of
n/K terms costs about n/(2K) multiplications when computed in fixed
point */
K = (precy < SWITCH) ? __gmpfr_isqrt ((precy + 1) / 2)
: __gmpfr_cuberoot (4*precy);
l = (precy - 1) / K + 1;
err = K + MPFR_INT_CEIL_LOG2 (2 * l + 18);
/* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
q = precy + err + K + 5;
/*q = ( (q-1)/BITS_PER_MP_LIMB + 1) * BITS_PER_MP_LIMB; */
mpfr_init2 (r, q + error_r);
mpfr_init2 (s, q + error_r);
mpfr_init2 (t, q);
/* the algorithm consists in computing an upper bound of exp(x) using
a precision of q bits, and see if we can round to MPFR_PREC(y) taking
into account the maximal error. Otherwise we increase q. */
for (;;)
{
MPFR_TRACE ( printf("n=%d K=%d l=%d q=%d\n",n,K,l,q) );
/* if n<0, we have to get an upper bound of log(2)
in order to get an upper bound of r = x-n*log(2) */
mpfr_const_log2 (s, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* s is within 1 ulp of log(2) */
mpfr_mul_ui (r, s, (n < 0) ? -n : n, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* r is within 3 ulps of n*log(2) */
if (n < 0)
mpfr_neg (r, r, GMP_RNDD); /* exact */
/* r = floor(n*log(2)), within 3 ulps */
MPFR_TRACE ( MPFR_DUMP (x) );
MPFR_TRACE ( MPFR_DUMP (r) );
mpfr_sub (r, x, r, GMP_RNDU);
/* possible cancellation here: the error on r is at most
3*2^(EXP(old_r)-EXP(new_r)) */
while (MPFR_IS_NEG (r))
{ /* initial approximation n was too large */
n--;
mpfr_add (r, r, s, GMP_RNDU);
}
mpfr_prec_round (r, q, GMP_RNDU);
MPFR_TRACE ( MPFR_DUMP (r) );
MPFR_ASSERTD (MPFR_IS_POS (r));
mpfr_div_2ui (r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K, exact */
TMP_MARK(marker);
MY_INIT_MPZ(ss, 3 + 2*((q-1)/BITS_PER_MP_LIMB));
exps = mpfr_get_z_exp (ss, s);
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! */
l = (precy < SWITCH) ?
mpfr_exp2_aux (ss, r, q, &exps) /* naive method */
: mpfr_exp2_aux2 (ss, r, q, &exps); /* Brent/Kung method */
MPFR_TRACE(printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q));
for (k = 0; k < K; k++)
{
mpz_mul (ss, ss, ss);
exps <<= 1;
exps += mpz_normalize (ss, ss, q);
}
mpfr_set_z (s, ss, GMP_RNDN);
MPFR_SET_EXP(s, MPFR_GET_EXP (s) + exps);
TMP_FREE(marker); /* don't need ss anymore */
if (n>0)
mpfr_mul_2ui(s, s, n, GMP_RNDU);
else
mpfr_div_2ui(s, s, -n, GMP_RNDU);
/* error is at most 2^K*(3l*(l+1)) ulp for mpfr_exp2_aux */
l = (precy < SWITCH) ? 3*l*(l+1) : l*(l+4) ;
k = MPFR_INT_CEIL_LOG2 (l);
/* k = 0; while (l) { k++; l >>= 1; } */
/* now k = ceil(log(error in ulps)/log(2)) */
K += k;
MPFR_TRACE ( printf("after mult. by 2^n:\n") );
MPFR_TRACE ( MPFR_DUMP (s) );
MPFR_TRACE ( printf("err=%d bits\n", K) );
if (mpfr_can_round (s, q - K, GMP_RNDN, GMP_RNDZ,
precy + (rnd_mode == GMP_RNDN)) )
break;
MPFR_TRACE (printf("prec++, use %d\n", q+BITS_PER_MP_LIMB) );
MPFR_TRACE (printf("q=%d q-K=%d precy=%d\n",q,q-K,precy) );
q += BITS_PER_MP_LIMB;
mpfr_set_prec (r, q);
mpfr_set_prec (s, q);
mpfr_set_prec (t, q);
}
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
mpfr_clear (t);
return inexact;
}
int
main (void)
{
mpfr_t x, u;
mpf_t y, z;
mpfr_exp_t emax;
unsigned long k, pr;
int r, inexact;
tests_start_mpfr ();
mpf_init (y);
mpf_init (z);
mpf_set_d (y, 0.0);
/* check prototype of mpfr_init_set_f */
mpfr_init_set_f (x, y, MPFR_RNDN);
mpfr_set_prec (x, 100);
mpfr_set_f (x, y, MPFR_RNDN);
mpf_urandomb (y, RANDS, 10 * GMP_NUMB_BITS);
mpfr_set_f (x, y, RND_RAND ());
/* bug found by Jean-Pierre Merlet */
mpfr_set_prec (x, 256);
mpf_set_prec (y, 256);
mpfr_init2 (u, 256);
mpfr_set_str (u,
"7.f10872b020c49ba5e353f7ced916872b020c49ba5e353f7ced916872b020c498@2",
16, MPFR_RNDN);
mpf_set_str (y, "2033033E-3", 10); /* avoid 2033.033 which is
locale-sensitive */
mpfr_set_f (x, y, MPFR_RNDN);
if (mpfr_cmp (x, u))
{
printf ("mpfr_set_f failed for y=2033033E-3\n");
exit (1);
}
mpf_set_str (y, "-2033033E-3", 10); /* avoid -2033.033 which is
locale-sensitive */
mpfr_set_f (x, y, MPFR_RNDN);
mpfr_neg (u, u, MPFR_RNDN);
if (mpfr_cmp (x, u))
{
printf ("mpfr_set_f failed for y=-2033033E-3\n");
exit (1);
}
mpf_set_prec (y, 300);
mpf_set_str (y, "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111", -2);
mpf_mul_2exp (y, y, 600);
mpfr_set_prec (x, 300);
mpfr_set_f (x, y, MPFR_RNDN);
if (mpfr_check (x) == 0)
{
printf ("Error in mpfr_set_f: corrupted result\n");
mpfr_dump (x);
exit (1);
}
MPFR_ASSERTN(mpfr_cmp_ui_2exp (x, 1, 901) == 0);
/* random values */
for (k = 1; k <= 1000; k++)
{
pr = 2 + (randlimb () & 255);
mpf_set_prec (z, pr);
mpf_urandomb (z, RANDS, z->_mp_prec);
mpfr_set_prec (u, ((pr / GMP_NUMB_BITS + 1) * GMP_NUMB_BITS));
mpfr_set_f (u, z, MPFR_RNDN);
if (mpfr_cmp_f (u , z) != 0)
{
printf ("Error in mpfr_set_f:\n");
printf ("mpf (precision=%lu)=", pr);
mpf_out_str (stdout, 16, 0, z);
printf ("\nmpfr(precision=%lu)=",
((pr / GMP_NUMB_BITS + 1) * GMP_NUMB_BITS));
mpfr_out_str (stdout, 16, 0, u, MPFR_RNDN);
putchar ('\n');
exit (1);
}
mpfr_set_prec (x, pr);
mpfr_set_f (x, z, MPFR_RNDN);
mpfr_sub (u, u, x, MPFR_RNDN);
mpfr_abs (u, u, MPFR_RNDN);
if (mpfr_cmp_ui_2exp (u, 1, -pr - 1) > 0)
{
printf ("Error in mpfr_set_f: precision=%lu\n", pr);
printf ("mpf =");
mpf_out_str (stdout, 16, 0, z);
printf ("\nmpfr=");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
}
/* Check for +0 */
mpfr_set_prec (x, 53);
mpf_set_prec (y, 53);
mpf_set_ui (y, 0);
for (r = 0 ; r < MPFR_RND_MAX ; r++)
{
int i;
for (i = -1; i <= 1; i++)
{
if (i)
mpfr_set_si (x, i, MPFR_RNDN);
inexact = mpfr_set_f (x, y, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || !MPFR_IS_POS(x) || inexact)
{
printf ("mpfr_set_f(x,0) failed for %s, i = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
exit (1);
}
}
}
/* coverage test */
mpf_set_prec (y, 2);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpf_set_ui (y, 1);
for (r = 0; r < mp_bits_per_limb; r++)
{
mpfr_urandomb (x, RANDS); /* to fill low limbs with random data */
inexact = mpfr_set_f (x, y, MPFR_RNDN);
MPFR_ASSERTN(inexact == 0 && mpfr_cmp_ui_2exp (x, 1, r) == 0);
mpf_mul_2exp (y, y, 1);
}
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, ULONG_MAX);
mpfr_set_f (x, y, MPFR_RNDN);
mpfr_set_ui (u, 1, MPFR_RNDN);
mpfr_mul_2ui (u, u, ULONG_MAX, MPFR_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, MPFR_RNDN) for y = 2^ULONG_MAX\n");
exit (1);
}
emax = mpfr_get_emax ();
/* For mpf_mul_2exp, emax must fit in an unsigned long! */
if (emax >= 0 && emax <= ULONG_MAX)
{
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, emax);
mpfr_set_f (x, y, MPFR_RNDN);
mpfr_set_ui_2exp (u, 1, emax, MPFR_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, MPFR_RNDN) for y = 2^emax\n");
exit (1);
}
}
/* For mpf_mul_2exp, emax - 1 must fit in an unsigned long! */
if (emax >= 1 && emax - 1 <= ULONG_MAX)
{
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, emax - 1);
mpfr_set_f (x, y, MPFR_RNDN);
mpfr_set_ui_2exp (u, 1, emax - 1, MPFR_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, MPFR_RNDN) for y = 2^(emax-1)\n");
exit (1);
}
}
mpfr_clear (x);
mpfr_clear (u);
mpf_clear (y);
mpf_clear (z);
tests_end_mpfr ();
return 0;
}
static void
check_special (void)
{
mpfr_t x, y, z;
mpfr_exp_t emin, emax;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
/* check exp(NaN) = NaN */
mpfr_set_nan (x);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for exp(NaN)\n");
exit (1);
}
/* check exp(+inf) = +inf */
mpfr_set_inf (x, 1);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(+inf)\n");
exit (1);
}
/* check exp(-inf) = +0 */
mpfr_set_inf (x, -1);
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(-inf)\n");
exit (1);
}
/* Check overflow. Corner case of mpfr_exp_2 */
mpfr_set_prec (x, 64);
mpfr_set_emax (MPFR_EMAX_DEFAULT);
mpfr_set_emin (MPFR_EMIN_DEFAULT);
mpfr_set_str (x,
"0.1011000101110010000101111111010100001100000001110001100111001101E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDD);
if (mpfr_cmp_str (x,
".1111111111111111111111111111111111111111111111111111111111111111E1073741823",
2, MPFR_RNDN) != 0)
{
printf ("Wrong overflow detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
/* Check underflow. Corner case of mpfr_exp_2 */
mpfr_set_str (x,
"-0.1011000101110010000101111111011111010001110011110111100110101100E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, "0.1E-1073741823", 2, MPFR_RNDN) != 0)
{
printf ("Wrong underflow (1) detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
mpfr_set_str (x,
"-0.1011001101110010000101111111011111010001110011110111100110111101E30",
2, MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) != 0)
{
printf ("Wrong underflow (2) detection in mpfr_exp\n");
mpfr_dump (x);
exit (1);
}
/* Check overflow. Corner case of mpfr_exp_3 */
if (MPFR_PREC_MAX >= MPFR_EXP_THRESHOLD + 10 && MPFR_PREC_MAX >= 64)
{
/* this ensures that for small MPFR_EXP_THRESHOLD, the following
mpfr_set_str conversion is exact */
mpfr_set_prec (x, (MPFR_EXP_THRESHOLD + 10 > 64)
? MPFR_EXP_THRESHOLD + 10 : 64);
mpfr_set_str (x,
"0.1011000101110010000101111111010100001100000001110001100111001101E30",
2, MPFR_RNDN);
mpfr_clear_overflow ();
mpfr_exp (x, x, MPFR_RNDD);
if (!mpfr_overflow_p ())
{
printf ("Wrong overflow detection in mpfr_exp_3\n");
mpfr_dump (x);
exit (1);
}
/* Check underflow. Corner case of mpfr_exp_3 */
mpfr_set_str (x,
"-0.1011000101110010000101111111011111010001110011110111100110101100E30",
2, MPFR_RNDN);
mpfr_clear_underflow ();
mpfr_exp (x, x, MPFR_RNDN);
if (!mpfr_underflow_p ())
{
printf ("Wrong underflow detection in mpfr_exp_3\n");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 53);
}
/* check overflow */
set_emax (10);
mpfr_set_ui (x, 7, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(7) for emax=10\n");
exit (1);
}
set_emax (emax);
/* check underflow */
set_emin (-10);
mpfr_set_si (x, -9, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error for exp(-9) for emin=-10\n");
printf ("Expected +0\n");
printf ("Got ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
set_emin (emin);
/* check case EXP(x) < -precy */
mpfr_set_prec (y, 2);
mpfr_set_str_binary (x, "-0.1E-3");
test_exp (y, x, MPFR_RNDD);
if (mpfr_cmp_ui_2exp (y, 3, -2))
{
printf ("Error for exp(-1/16), prec=2, RNDD\n");
printf ("expected 0.11, got ");
mpfr_dump (y);
exit (1);
}
test_exp (y, x, MPFR_RNDZ);
if (mpfr_cmp_ui_2exp (y, 3, -2))
{
printf ("Error for exp(-1/16), prec=2, RNDZ\n");
printf ("expected 0.11, got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_str_binary (x, "0.1E-3");
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error for exp(1/16), prec=2, RNDN\n");
exit (1);
}
test_exp (y, x, MPFR_RNDU);
if (mpfr_cmp_ui_2exp (y, 3, -1))
{
printf ("Error for exp(1/16), prec=2, RNDU\n");
exit (1);
}
/* bug reported by Franky Backeljauw, 28 Mar 2003 */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "1.1101011000111101011110000111010010101001101001110111e28");
test_exp (y, x, MPFR_RNDN);
mpfr_set_prec (x, 153);
mpfr_set_prec (z, 153);
mpfr_set_str_binary (x, "1.1101011000111101011110000111010010101001101001110111e28");
test_exp (z, x, MPFR_RNDN);
mpfr_prec_round (z, 53, MPFR_RNDN);
if (mpfr_cmp (y, z))
{
printf ("Error in mpfr_exp for large argument\n");
exit (1);
}
/* corner cases in mpfr_exp_3 */
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_prec (y, 2);
mpfr_exp_3 (y, x, MPFR_RNDN);
/* Check some little things about overflow detection */
set_emin (-125);
set_emax (128);
mpfr_set_prec (x, 107);
mpfr_set_prec (y, 107);
mpfr_set_str_binary (x, "0.11110000000000000000000000000000000000000000000"
"0000000000000000000000000000000000000000000000000000"
"00000000E4");
test_exp (y, x, MPFR_RNDN);
if (mpfr_cmp_str (y, "0.11000111100001100110010101111101011010010101010000"
"1101110111100010111001011111111000110111001011001101010"
"01E22", 2, MPFR_RNDN))
{
printf ("Special overflow error (1)\n");
mpfr_dump (y);
exit (1);
}
set_emin (emin);
set_emax (emax);
/* Check for overflow producing a segfault with HUGE exponent */
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_mul_2ui (x, x, 32, MPFR_RNDN);
test_exp (y, x, MPFR_RNDN); /* Can't test return value: May overflow or not*/
/* Bug due to wrong approximation of (x)/log2 */
mpfr_set_prec (x, 163);
mpfr_set_str (x, "-4.28ac8fceeadcda06bb56359017b1c81b85b392e7", 16,
MPFR_RNDN);
mpfr_exp (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, "3.fffffffffffffffffffffffffffffffffffffffe8@-2",
16, MPFR_RNDN))
{
printf ("Error for x= -4.28ac8fceeadcda06bb56359017b1c81b85b392e7");
printf ("expected 3.fffffffffffffffffffffffffffffffffffffffe8@-2");
printf ("Got ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
putchar ('\n');
}
/* bug found by Guillaume Melquiond, 13 Sep 2005 */
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "-1E-400");
mpfr_exp (x, x, MPFR_RNDZ);
if (mpfr_cmp_ui (x, 1) == 0)
{
printf ("Error for exp(-2^(-400))\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
int
mpfr_tanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
/****** Declaration ******/
mpfr_t x;
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special value checking */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
/* tanh(inf) = 1 && tanh(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (xt), rnd_mode);
}
else /* tanh (0) = 0 and xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO(xt));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* tanh(x) = x - x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 0,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te;
mpfr_exp_t d;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
long int err; /* error */
int sign = MPFR_SIGN (xt);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
/* First check for BIG overflow of exp(2*x):
For x > 0, exp(2*x) > 2^(2*x)
If 2 ^(2*x) > 2^emax or x>emax/2, there is an overflow */
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax/2) >= 0)) {
/* initialise of intermediary variables
since 'set_one' label assumes the variables have been
initialize */
MPFR_GROUP_INIT_2 (group, MPFR_PREC_MIN, t, te);
goto set_one;
}
/* Compute the precision of intermediary variable */
/* The optimal number of bits: see algorithms.tex */
Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 4;
/* if x is small, there will be a cancellation in exp(2x)-1 */
if (MPFR_GET_EXP (x) < 0)
Nt += -MPFR_GET_EXP (x);
/* initialise of intermediary variable */
MPFR_GROUP_INIT_2 (group, Nt, t, te);
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* tanh = (exp(2x)-1)/(exp(2x)+1) */
mpfr_mul_2ui (te, x, 1, MPFR_RNDN); /* 2x */
/* since x > 0, we can only have an overflow */
mpfr_exp (te, te, MPFR_RNDN); /* exp(2x) */
if (MPFR_UNLIKELY (MPFR_IS_INF (te))) {
set_one:
inexact = MPFR_FROM_SIGN_TO_INT (sign);
mpfr_set4 (y, __gmpfr_one, MPFR_RNDN, sign);
if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG_SIGN (sign)))
{
inexact = -inexact;
mpfr_nexttozero (y);
}
break;
}
d = MPFR_GET_EXP (te); /* For Error calculation */
mpfr_add_ui (t, te, 1, MPFR_RNDD); /* exp(2x) + 1*/
mpfr_sub_ui (te, te, 1, MPFR_RNDU); /* exp(2x) - 1*/
d = d - MPFR_GET_EXP (te);
mpfr_div (t, te, t, MPFR_RNDN); /* (exp(2x)-1)/(exp(2x)+1)*/
/* Calculation of the error */
d = MAX(3, d + 1);
err = Nt - (d + 1);
if (MPFR_LIKELY ((d <= Nt / 2) && MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, sign);
break;
}
/* if t=1, we still can round since |sinh(x)| < 1 */
if (MPFR_GET_EXP (t) == 1)
goto set_one;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, te);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
inexact = mpfr_check_range (y, inexact, rnd_mode);
return inexact;
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
int main()
{
slong i;
mpfr_t tabx, expx, y1, y2;
mpz_t tt;
flint_printf("exp_tab....");
fflush(stdout);
{
slong prec, bits, num;
prec = ARB_EXP_TAB1_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB1_BITS;
num = ARB_EXP_TAB1_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab1[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS;
num = ARB_EXP_TAB21_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab21[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS + ARB_EXP_TAB22_BITS;
num = ARB_EXP_TAB22_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab22[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
/* Don't need to save/restore exponent range: the cache does it */
int
mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t a, A, B, D, S;
mpfr_prec_t px, p, cancel, k, kmax;
MPFR_ZIV_DECL (loop);
int inex;
MPFR_LOG_FUNC
(("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex));
px = MPFR_PREC (x);
/* we need 9*2^kmax - 4 >= px+2*kmax+8 */
for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++);
p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */
mpfr_init2 (a, p);
mpfr_init2 (A, p);
mpfr_init2 (B, p);
mpfr_init2 (D, p);
mpfr_init2 (S, p);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_set_ui (a, 1, MPFR_RNDN); /* a = 1 */
mpfr_set_ui (A, 1, MPFR_RNDN); /* A = a^2 = 1 */
mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */
mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */
#define b B
#define ap a
#define Ap A
#define Bp B
for (k = 0; ; k++)
{
/* invariant: 1/2 <= B <= A <= a < 1 */
mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */
mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */
mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */
mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */
mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */
mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */
mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */
mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */
mpfr_sub (S, Ap, Bp, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0);
cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p;
/* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */
mpfr_mul_2ui (S, S, k, MPFR_RNDN);
mpfr_sub (D, D, S, MPFR_RNDN);
/* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */
if (cancel + k >= p)
break;
}
#undef b
#undef ap
#undef Ap
#undef Bp
mpfr_div (A, B, D, MPFR_RNDN);
/* MPFR_ASSERTN(p >= 2 * k + 8); */
if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode)))
break;
p += kmax;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (a, p);
mpfr_set_prec (A, p);
mpfr_set_prec (B, p);
mpfr_set_prec (D, p);
mpfr_set_prec (S, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (x, A, rnd_mode);
mpfr_clear (a);
mpfr_clear (A);
mpfr_clear (B);
mpfr_clear (D);
mpfr_clear (S);
return inex;
}
static void
test_large (void)
{
mpfr_t x, y, z, t;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_set_ui (x, 21, MPFR_RNDN);
mpfr_set_ui (y, 28, MPFR_RNDN);
mpfr_set_ui (z, 35, MPFR_RNDN);
mpfr_mul_2ui (x, x, MPFR_EMAX_DEFAULT-6, MPFR_RNDN);
mpfr_mul_2ui (y, y, MPFR_EMAX_DEFAULT-6, MPFR_RNDN);
mpfr_mul_2ui (z, z, MPFR_EMAX_DEFAULT-6, MPFR_RNDN);
mpfr_hypot (t, x, y, MPFR_RNDN);
if (mpfr_cmp (z, t))
{
printf ("Error in test_large: got\n");
mpfr_out_str (stdout, 2, 0, t, MPFR_RNDN);
printf ("\ninstead of\n");
mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (t, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "0.11101100011110000011101000010101010011001101000001100E-1021");
mpfr_set_str_binary (y, "0.11111001010011000001110110001101011100001000010010100E-1021");
mpfr_hypot (t, x, y, MPFR_RNDN);
mpfr_set_str_binary (z, "0.101010111100110111101110111110100110010011001010111E-1020");
if (mpfr_cmp (z, t))
{
printf ("Error in test_large: got\n");
mpfr_out_str (stdout, 2, 0, t, MPFR_RNDN);
printf ("\ninstead of\n");
mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 240);
mpfr_set_prec (y, 22);
mpfr_set_prec (z, 2);
mpfr_set_prec (t, 2);
mpfr_set_str_binary (x, "0.100111011010010010110100000100000001100010011100110101101111111101011110111011011101010110100101111000111100010100110000100101011110111011100110100110100101110101101100011000001100000001111101110100100100011011011010110111100110010101000111e-7");
mpfr_set_str_binary (y, "0.1111000010000011000111E-10");
mpfr_hypot (t, x, y, MPFR_RNDN);
mpfr_set_str_binary (z, "0.11E-7");
if (mpfr_cmp (z, t))
{
printf ("Error in test_large: got\n");
mpfr_out_str (stdout, 2, 0, t, MPFR_RNDN);
printf ("\ninstead of\n");
mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
static int
mpfr_fsss (mpfr_ptr z, mpfr_srcptr a, mpfr_srcptr c, mpfr_rnd_t rnd)
{
/* Computes z = a^2 - c^2.
Assumes that a and c are finite and non-zero; so a squaring yielding
an infinity is an overflow, and a squaring yielding 0 is an underflow.
Assumes further that z is distinct from a and c. */
int inex;
mpfr_t u, v;
/* u=a^2, v=c^2 exactly */
mpfr_init2 (u, 2*mpfr_get_prec (a));
mpfr_init2 (v, 2*mpfr_get_prec (c));
mpfr_sqr (u, a, MPFR_RNDN);
mpfr_sqr (v, c, MPFR_RNDN);
/* tentatively compute z as u-v; here we need z to be distinct
from a and c to not lose the latter */
inex = mpfr_sub (z, u, v, rnd);
if (mpfr_inf_p (z)) {
/* replace by "correctly rounded overflow" */
mpfr_set_si (z, (mpfr_signbit (z) ? -1 : 1), MPFR_RNDN);
inex = mpfr_mul_2ui (z, z, mpfr_get_emax (), rnd);
}
else if (mpfr_zero_p (u) && !mpfr_zero_p (v)) {
/* exactly u underflowed, determine inexact flag */
inex = (mpfr_signbit (u) ? 1 : -1);
}
else if (mpfr_zero_p (v) && !mpfr_zero_p (u)) {
/* exactly v underflowed, determine inexact flag */
inex = (mpfr_signbit (v) ? -1 : 1);
}
else if (mpfr_nan_p (z) || (mpfr_zero_p (u) && mpfr_zero_p (v))) {
/* In the first case, u and v are +inf.
In the second case, u and v are zeroes; their difference may be 0
or the least representable number, with a sign to be determined.
Redo the computations with mpz_t exponents */
mpfr_exp_t ea, ec;
mpz_t eu, ev;
/* cheat to work around the const qualifiers */
/* Normalise the input by shifting and keep track of the shifts in
the exponents of u and v */
ea = mpfr_get_exp (a);
ec = mpfr_get_exp (c);
mpfr_set_exp ((mpfr_ptr) a, (mpfr_prec_t) 0);
mpfr_set_exp ((mpfr_ptr) c, (mpfr_prec_t) 0);
mpz_init (eu);
mpz_init (ev);
mpz_set_si (eu, (long int) ea);
mpz_mul_2exp (eu, eu, 1);
mpz_set_si (ev, (long int) ec);
mpz_mul_2exp (ev, ev, 1);
/* recompute u and v and move exponents to eu and ev */
mpfr_sqr (u, a, MPFR_RNDN);
/* exponent of u is non-positive */
mpz_sub_ui (eu, eu, (unsigned long int) (-mpfr_get_exp (u)));
mpfr_set_exp (u, (mpfr_prec_t) 0);
mpfr_sqr (v, c, MPFR_RNDN);
mpz_sub_ui (ev, ev, (unsigned long int) (-mpfr_get_exp (v)));
mpfr_set_exp (v, (mpfr_prec_t) 0);
if (mpfr_nan_p (z)) {
mpfr_exp_t emax = mpfr_get_emax ();
int overflow;
/* We have a = ma * 2^ea with 1/2 <= |ma| < 1 and ea <= emax.
So eu <= 2*emax, and eu > emax since we have
an overflow. The same holds for ev. Shift u and v by as much as
possible so that one of them has exponent emax and the
remaining exponents in eu and ev are the same. Then carry out
the addition. Shifting u and v prevents an underflow. */
if (mpz_cmp (eu, ev) >= 0) {
mpfr_set_exp (u, emax);
mpz_sub_ui (eu, eu, (long int) emax);
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_ui (ev));
/* remaining common exponent is now in eu */
}
else {
mpfr_set_exp (v, emax);
mpz_sub_ui (ev, ev, (long int) emax);
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_ui (eu));
mpz_set (eu, ev);
/* remaining common exponent is now also in eu */
}
inex = mpfr_sub (z, u, v, rnd);
/* Result is finite since u and v have the same sign. */
overflow = mpfr_mul_2ui (z, z, mpz_get_ui (eu), rnd);
if (overflow)
inex = overflow;
}
else {
int underflow;
/* Subtraction of two zeroes. We have a = ma * 2^ea
with 1/2 <= |ma| < 1 and ea >= emin and similarly for b.
So 2*emin < 2*emin+1 <= eu < emin < 0, and analogously for v. */
mpfr_exp_t emin = mpfr_get_emin ();
if (mpz_cmp (eu, ev) <= 0) {
mpfr_set_exp (u, emin);
mpz_add_ui (eu, eu, (unsigned long int) (-emin));
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_si (ev));
}
else {
mpfr_set_exp (v, emin);
mpz_add_ui (ev, ev, (unsigned long int) (-emin));
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_si (eu));
mpz_set (eu, ev);
}
inex = mpfr_sub (z, u, v, rnd);
mpz_neg (eu, eu);
underflow = mpfr_div_2ui (z, z, mpz_get_ui (eu), rnd);
if (underflow)
inex = underflow;
}
mpz_clear (eu);
mpz_clear (ev);
mpfr_set_exp ((mpfr_ptr) a, ea);
mpfr_set_exp ((mpfr_ptr) c, ec);
/* works also when a == c */
}
mpfr_clear (u);
mpfr_clear (v);
return inex;
}
/* hard test of rounding */
static void
check_rounding (void)
{
mpfr_t a, b, c, res;
mpfr_prec_t p;
long k, l;
int i;
#define MAXKL (2 * GMP_NUMB_BITS)
for (p = MPFR_PREC_MIN; p <= GMP_NUMB_BITS; p++)
{
mpfr_init2 (a, p);
mpfr_init2 (res, p);
mpfr_init2 (b, p + 1 + MAXKL);
mpfr_init2 (c, MPFR_PREC_MIN);
/* b = 2^p + 1 + 2^(-k), c = 2^(-l) */
for (k = 0; k <= MAXKL; k++)
for (l = 0; l <= MAXKL; l++)
{
mpfr_set_ui_2exp (b, 1, p, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_mul_2ui (b, b, k, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_div_2ui (b, b, k, MPFR_RNDN);
mpfr_set_ui_2exp (c, 1, -l, MPFR_RNDN);
i = mpfr_sub (a, b, c, MPFR_RNDN);
/* b - c = 2^p + 1 + 2^(-k) - 2^(-l), should be rounded to
2^p for l <= k, and 2^p+2 for l < k */
if (l <= k)
{
if (mpfr_cmp_ui_2exp (a, 1, p) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected 2^%lu\n", p);
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i >= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("a="); mpfr_print_binary (a); puts ("");
printf ("Expected < 0, got %d\n", i);
exit (1);
}
}
else /* l < k */
{
mpfr_set_ui_2exp (res, 1, p, MPFR_RNDN);
mpfr_add_ui (res, res, 2, MPFR_RNDN);
if (mpfr_cmp (a, res) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected "); mpfr_print_binary (res); puts ("");
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i <= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected > 0, got %d\n", i);
exit (1);
}
}
}
mpfr_clear (a);
mpfr_clear (res);
mpfr_clear (b);
mpfr_clear (c);
}
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int prec, m, ok, e, inexact, neg;
mpfr_t c, k;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_SET_NAN(z);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
MPFR_CLEAR_FLAGS(y);
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y, x);
mpfr_set_ui (z, 1, GMP_RNDN);
MPFR_RET(0);
}
prec = MAX(MPFR_PREC(y), MPFR_PREC(z));
m = prec + _mpfr_ceil_log2 ((double) prec) + ABS(MPFR_EXP(x)) + 13;
mpfr_init2 (c, m);
mpfr_init2 (k, m);
/* first determine sign */
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN); /* 2*Pi */
mpfr_div (k, x, c, GMP_RNDN); /* x/(2*Pi) */
mpfr_floor (k, k); /* floor(x/(2*Pi)) */
mpfr_mul (c, k, c, GMP_RNDN);
mpfr_sub (k, x, c, GMP_RNDN); /* 0 <= k < 2*Pi */
mpfr_const_pi (c, GMP_RNDN); /* cached */
neg = mpfr_cmp (k, c) > 0;
mpfr_clear (k);
do
{
mpfr_cos (c, x, GMP_RNDZ);
if ((ok = mpfr_can_round (c, m, GMP_RNDZ, rnd_mode, MPFR_PREC(z))))
{
inexact = mpfr_set (z, c, rnd_mode);
mpfr_mul (c, c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
e = 2 + (-MPFR_EXP(c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
mpfr_neg (c, c, GMP_RNDN);
/* the absolute error on c is at most 2^(e-m) = 2^(EXP(c)-err) */
e = MPFR_EXP(c) + m - e;
ok = (e >= 0) && mpfr_can_round (c, e, GMP_RNDN, rnd_mode,
MPFR_PREC(y));
}
if (ok == 0)
{
m += _mpfr_ceil_log2 ((double) m);
mpfr_set_prec (c, m);
}
}
while (ok == 0);
inexact = mpfr_set (y, c, rnd_mode) || inexact;
mpfr_clear (c);
return inexact; /* inexact */
}
/* We use the reflection formula
Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t))
in order to treat the case x <= 1,
i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x)
*/
int
mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, GammaTrial, tmp, tmp2;
mpz_t fact;
mpfr_prec_t realprec;
int compared, is_integer;
int inex = 0; /* 0 means: result gamma not set yet */
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("gamma[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex));
/* Trivial cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
if (MPFR_IS_NEG (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF (gamma);
MPFR_SET_POS (gamma);
MPFR_RET (0); /* exact */
}
}
else /* x is zero */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
MPFR_SET_INF(gamma);
MPFR_SET_SAME_SIGN(gamma, x);
MPFR_SET_DIVBY0 ();
MPFR_RET (0); /* exact */
}
}
/* Check for tiny arguments, where gamma(x) ~ 1/x - euler + ....
We know from "Bound on Runs of Zeros and Ones for Algebraic Functions",
Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal
number of consecutive zeroes or ones after the round bit is n-1 for an
input of n bits. But we need a more precise lower bound. Assume x has
n bits, and 1/x is near a floating-point number y of n+1 bits. We can
write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits.
Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e).
Two cases can happen:
(i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y
are themselves powers of two, i.e., x is a power of two;
(ii) or X*Y is at distance at least one from 2^(f-e), thus
|xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n).
Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means
that the distance |y-1/x| >= 2^(-2n) ufp(y).
Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1,
if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y),
and round(1/x) with precision >= 2n+2 gives the correct result.
If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1).
A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)).
*/
if (MPFR_GET_EXP (x) + 2
<= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma)))
{
int sign = MPFR_SIGN (x); /* retrieve sign before possible override */
int special;
MPFR_BLOCK_DECL (flags);
MPFR_SAVE_EXPO_MARK (expo);
/* for overflow cases, see below; this needs to be done
before x possibly gets overridden. */
special =
MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX &&
MPFR_IS_POS_SIGN (sign) &&
MPFR_IS_LIKE_RNDD (rnd_mode, sign) &&
mpfr_powerof2_raw (x);
MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode));
if (inex == 0) /* x is a power of two */
{
/* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */
if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign))
inex = 1;
else
{
mpfr_nextbelow (gamma);
inex = -1;
}
}
else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* Overflow in the division 1/x. This is a real overflow, except
in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to
the "- euler", the rounded value in unbounded exponent range
is 0.111...11 * 2^emax (not an overflow). */
if (!special)
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags);
}
MPFR_SAVE_EXPO_FREE (expo);
/* Note: an overflow is possible with an infinite result;
in this case, the overflow flag will automatically be
restored by mpfr_check_range. */
return mpfr_check_range (gamma, inex, rnd_mode);
}
is_integer = mpfr_integer_p (x);
/* gamma(x) for x a negative integer gives NaN */
if (is_integer && MPFR_IS_NEG(x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
compared = mpfr_cmp_ui (x, 1);
if (compared == 0)
return mpfr_set_ui (gamma, 1, rnd_mode);
/* if x is an integer that fits into an unsigned long, use mpfr_fac_ui
if argument is not too large.
If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)),
so for u <= M(p), fac_ui should be faster.
We approximate here M(p) by p*log(p)^2, which is not a bad guess.
Warning: since the generic code does not handle exact cases,
we want all cases where gamma(x) is exact to be treated here.
*/
if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long int u;
mpfr_prec_t p = MPFR_PREC(gamma);
u = mpfr_get_ui (x, MPFR_RNDN);
if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN))
/* bits_fac: lower bound on the number of bits of m,
where gamma(x) = (u-1)! = m*2^e with m odd. */
return mpfr_fac_ui (gamma, u - 1, rnd_mode);
/* if bits_fac(...) > p (resp. p+1 for rounding to nearest),
then gamma(x) cannot be exact in precision p (resp. p+1).
FIXME: remove the test u < 44787929UL after changing bits_fac
to return a mpz_t or mpfr_t. */
}
MPFR_SAVE_EXPO_MARK (expo);
/* check for overflow: according to (6.1.37) in Abramowitz & Stegun,
gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi)
>= 2 * (x/e)^x / x for x >= 1 */
if (compared > 0)
{
mpfr_t yp;
mpfr_exp_t expxp;
MPFR_BLOCK_DECL (flags);
/* quick test for the default exponent range */
if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* 1/e rounded down to 53 bits */
#define EXPM1_STR "0.010111100010110101011000110110001011001110111100111"
mpfr_init2 (xp, 53);
mpfr_init2 (yp, 53);
mpfr_set_str_binary (xp, EXPM1_STR);
mpfr_mul (xp, x, xp, MPFR_RNDZ);
mpfr_sub_ui (yp, x, 2, MPFR_RNDZ);
mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */
mpfr_set_str_binary (yp, EXPM1_STR);
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */
mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */
MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ));
expxp = MPFR_GET_EXP (xp);
mpfr_clear (xp);
mpfr_clear (yp);
MPFR_SAVE_EXPO_FREE (expo);
return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ?
mpfr_overflow (gamma, rnd_mode, 1) :
mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* now compared < 0 */
/* check for underflow: for x < 1,
gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x).
Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have
|gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))|
<= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|.
To avoid an underflow in ((2-x)/e)^x, we compute the logarithm.
*/
if (MPFR_IS_NEG(x))
{
int underflow = 0, sgn, ck;
mpfr_prec_t w;
mpfr_init2 (xp, 53);
mpfr_init2 (tmp, 53);
mpfr_init2 (tmp2, 53);
/* we want an upper bound for x * [log(2-x)-1].
since x < 0, we need a lower bound on log(2-x) */
mpfr_ui_sub (xp, 2, x, MPFR_RNDD);
mpfr_log (xp, xp, MPFR_RNDD);
mpfr_sub_ui (xp, xp, 1, MPFR_RNDD);
mpfr_mul (xp, xp, x, MPFR_RNDU);
/* we need an upper bound on 1/|sin(Pi*(2-x))|,
thus a lower bound on |sin(Pi*(2-x))|.
If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p)
thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u,
assuming u <= 1, thus <= u + 3Pi(2-x)u */
w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */
w += 17; /* to get tmp2 small enough */
mpfr_set_prec (tmp, w);
mpfr_set_prec (tmp2, w);
MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN));
MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */
mpfr_const_pi (tmp2, MPFR_RNDN);
mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */
mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */
sgn = mpfr_sgn (tmp);
mpfr_abs (tmp, tmp, MPFR_RNDN);
mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */
mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */
mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU);
/* if tmp2<|tmp|, we get a lower bound */
if (mpfr_cmp (tmp2, tmp) < 0)
{
mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */
mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */
mpfr_log2 (tmp, tmp, MPFR_RNDU);
mpfr_add (xp, tmp, xp, MPFR_RNDU);
/* The assert below checks that expo.saved_emin - 2 always
fits in a long. FIXME if we want to allow mpfr_exp_t to
be a long long, for instance. */
MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN);
underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0;
}
mpfr_clear (xp);
mpfr_clear (tmp);
mpfr_clear (tmp2);
if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn);
}
}
realprec = MPFR_PREC (gamma);
/* we want both 1-x and 2-x to be exact */
{
mpfr_prec_t w;
w = mpfr_gamma_1_minus_x_exact (x);
if (realprec < w)
realprec = w;
w = mpfr_gamma_2_minus_x_exact (x);
if (realprec < w)
realprec = w;
}
realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20;
MPFR_ASSERTD(realprec >= 5);
MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20,
xp, tmp, tmp2, GammaTrial);
mpz_init (fact);
MPFR_ZIV_INIT (loop, realprec);
for (;;)
{
mpfr_exp_t err_g;
int ck;
MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial);
/* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */
ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */
mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */
mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */
err_g = MPFR_GET_EXP(GammaTrial);
mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */
/* If tmp is +Inf, we compute exp(lngamma(x)). */
if (mpfr_inf_p (tmp))
{
inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode);
if (inex)
goto end;
else
goto ziv_next;
}
err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial);
/* let g0 the true value of Pi*(2-x), g the computed value.
We have g = g0 + h with |h| <= |(1+u^2)-1|*g.
Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g.
The relative error is thus bounded by |(1+u^2)-1|*g/sin(g)
<= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4.
With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */
ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */
mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN);
/* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u
+ (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2.
For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <=
0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus
(0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4
<= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */
mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN);
/* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u].
For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2
<= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4.
(1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u)
= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3
+ (18+9*2^err_g)*u^4
<= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3
<= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2
<= 1 + (23 + 10*2^err_g)*u.
The final error is thus bounded by (23 + 10*2^err_g) ulps,
which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */
err_g = (err_g <= 2) ? 6 : err_g + 4;
if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g,
MPFR_PREC(gamma), rnd_mode)))
break;
ziv_next:
MPFR_ZIV_NEXT (loop, realprec);
}
end:
MPFR_ZIV_FREE (loop);
if (inex == 0)
inex = mpfr_set (gamma, GammaTrial, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (fact);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (gamma, inex, rnd_mode);
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t K0, K, precy, m, k, l;
int inexact, reduce = 0;
mpfr_t r, s, xr, c;
mpfr_exp_t exps, cancel = 0, expx;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_LOG_FUNC (
("x[%Pu]=%*.Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%*.Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y,
inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* cos(x) = 1-x^2/2 + ..., so error < 2^(2*EXP(x)-1) */
expx = MPFR_GET_EXP (x);
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, -2 * expx,
1, 0, rnd_mode, expo, {});
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_cos_fast (y, x, rnd_mode);
}
K0 = __gmpfr_isqrt (precy / 3);
m = precy + 2 * MPFR_INT_CEIL_LOG2 (precy) + 2 * K0;
if (expx >= 3)
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_init2 call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_init2 (c, expx + m - 1);
mpfr_init2 (xr, m);
}
MPFR_GROUP_INIT_2 (group, m, r, s);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* If |x| >= 4, first reduce x cmod (2*Pi) into xr, using mpfr_remainder:
let e = EXP(x) >= 3, and m the target precision:
(1) c <- 2*Pi [precision e+m-1, nearest]
(2) xr <- remainder (x, c) [precision m, nearest]
We have |c - 2*Pi| <= 1/2ulp(c) = 2^(3-e-m)
|xr - x - k c| <= 1/2ulp(xr) <= 2^(1-m)
|k| <= |x|/(2*Pi) <= 2^(e-2)
Thus |xr - x - 2kPi| <= |k| |c - 2Pi| + 2^(1-m) <= 2^(2-m).
It follows |cos(xr) - cos(x)| <= 2^(2-m). */
if (reduce)
{
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN); /* 2Pi */
mpfr_remainder (xr, x, c, MPFR_RNDN);
if (MPFR_IS_ZERO(xr))
goto ziv_next;
/* now |xr| <= 4, thus r <= 16 below */
mpfr_mul (r, xr, xr, MPFR_RNDU); /* err <= 1 ulp */
}
else
mpfr_mul (r, x, x, MPFR_RNDU); /* err <= 1 ulp */
/* now |x| < 4 (or xr if reduce = 1), thus |r| <= 16 */
/* we need |r| < 1/2 for mpfr_cos2_aux, i.e., EXP(r) - 2K <= -1 */
K = K0 + 1 + MAX(0, MPFR_GET_EXP(r)) / 2;
/* since K0 >= 0, if EXP(r) < 0, then K >= 1, thus EXP(r) - 2K <= -3;
otherwise if EXP(r) >= 0, then K >= 1/2 + EXP(r)/2, thus
EXP(r) - 2K <= -1 */
MPFR_SET_EXP (r, MPFR_GET_EXP (r) - 2 * K); /* Can't overflow! */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
/* l is the error bound in ulps on s */
MPFR_SET_ONE (r);
for (k = 0; k < K; k++)
{
mpfr_sqr (s, s, MPFR_RNDU); /* err <= 2*olderr */
MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); /* Can't overflow */
mpfr_sub (s, s, r, MPFR_RNDN); /* err <= 4*olderr */
if (MPFR_IS_ZERO(s))
goto ziv_next;
MPFR_ASSERTD (MPFR_GET_EXP (s) <= 1);
}
/* The absolute error on s is bounded by (2l+1/3)*2^(2K-m)
2l+1/3 <= 2l+1.
If |x| >= 4, we need to add 2^(2-m) for the argument reduction
by 2Pi: if K = 0, this amounts to add 4 to 2l+1/3, i.e., to add
2 to l; if K >= 1, this amounts to add 1 to 2*l+1/3. */
l = 2 * l + 1;
if (reduce)
l += (K == 0) ? 4 : 1;
k = MPFR_INT_CEIL_LOG2 (l) + 2*K;
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
exps = MPFR_GET_EXP (s);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, exps + m - k, precy, rnd_mode)))
break;
if (MPFR_UNLIKELY (exps == 1))
/* s = 1 or -1, and except x=0 which was already checked above,
cos(x) cannot be 1 or -1, so we can round if the error is less
than 2^(-precy) for directed rounding, or 2^(-precy-1) for rounding
to nearest. */
{
if (m > k && (m - k >= precy + (rnd_mode == MPFR_RNDN)))
{
/* If round to nearest or away, result is s = 1 or -1,
otherwise it is round(nexttoward (s, 0)). However in order to
have the inexact flag correctly set below, we set |s| to
1 - 2^(-m) in all cases. */
mpfr_nexttozero (s);
break;
}
}
if (exps < cancel)
{
m += cancel - exps;
cancel = exps;
}
ziv_next:
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, r, s);
if (reduce)
{
mpfr_set_prec (xr, m);
mpfr_set_prec (c, expx + m - 1);
}
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
MPFR_GROUP_CLEAR (group);
if (reduce)
{
mpfr_clear (xr);
mpfr_clear (c);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
