SeedValue seed_mpfr_round (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_ptr rop, op;
gint ret;
CHECK_ARG_COUNT("mpfr.round", 1);
rop = seed_object_get_private(this_object);
if ( seed_value_is_object_of_class(ctx, args[0], mpfr_class) )
{
op = seed_object_get_private(args[0]);
}
else
{
TYPE_EXCEPTION("mpfr.round", "mpfr_t");
}
ret = mpfr_round(rop, op);
return seed_value_from_int(ctx, ret, exception);
}
/**
* rasqal_xsd_decimal_round:
* @result: result variable
* @a: argment decimal
*
* Return the number with no fractional part closes to argument for an XSD Decimal
*
* Return value: non-0 on failure
**/
int
rasqal_xsd_decimal_round(rasqal_xsd_decimal* result, rasqal_xsd_decimal* a)
{
int rc = 0;
#ifdef RASQAL_DECIMAL_GMP
mpf_t b;
mpf_t c;
#endif
rasqal_xsd_decimal_clear_string(result);
#if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE)
result->raw = round(a->raw);
#endif
#ifdef RASQAL_DECIMAL_MPFR
mpfr_round(result->raw, a->raw);
#endif
#ifdef RASQAL_DECIMAL_GMP
/* GMP has no mpf_round so use result := floor(a + 0.5) */
mpf_init2(b, a->precision_bits);
mpf_init2(c, a->precision_bits);
mpf_set_d(b, 0.5);
mpf_add(c, a->raw, b);
mpf_floor(result->raw, c);
mpf_clear(b);
mpf_clear(c);
#endif
return rc;
}
decimal r_round(const decimal& a)
{
#ifdef USE_CGAL
CGAL::Gmpfr m;
CGAL::Gmpfr n=to_gmpfr(a);
mpfr_round(m.fr(),n.fr());
return decimal(m);
#else
return round(a);
#endif
}
static int synge_int_rand(synge_t to, synge_t number, mpfr_rnd_t round) {
/* round input */
mpfr_floor(number, number);
/* get random number */
synge_rand(to, number, round);
/* round output */
mpfr_round(to, to);
return 0;
} /* synge_int_rand() */
void _arith_euler_number_zeta(fmpz_t res, ulong n)
{
mpz_t r;
mpfr_t t, z, pi;
mp_bitcnt_t prec, pi_prec;
if (n % 2)
{
fmpz_zero(res);
return;
}
if (n < SMALL_EULER_LIMIT)
{
fmpz_set_ui(res, euler_number_small[n / 2]);
if (n % 4 == 2)
fmpz_neg(res, res);
return;
}
prec = arith_euler_number_size(n) + 10;
pi_prec = prec + FLINT_BIT_COUNT(n);
mpz_init(r);
mpfr_init2(t, prec);
mpfr_init2(z, prec);
mpfr_init2(pi, pi_prec);
flint_mpz_fac_ui(r, n);
mpfr_set_z(t, r, GMP_RNDN);
mpfr_mul_2exp(t, t, n + 2, GMP_RNDN);
/* pi^(n + 1) * L(n+1) */
mpfr_zeta_inv_euler_product(z, n + 1, 1);
mpfr_const_pi(pi, GMP_RNDN);
mpfr_pow_ui(pi, pi, n + 1, GMP_RNDN);
mpfr_mul(z, z, pi, GMP_RNDN);
mpfr_div(t, t, z, GMP_RNDN);
/* round */
mpfr_round(t, t);
mpfr_get_z(r, t, GMP_RNDN);
fmpz_set_mpz(res, r);
if (n % 4 == 2)
fmpz_neg(res, res);
mpz_clear(r);
mpfr_clear(t);
mpfr_clear(z);
mpfr_clear(pi);
}
int
mpfr_rint_round (mpfr_ptr r, mpfr_srcptr u, mpfr_rnd_t rnd_mode)
{
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(u) ) || mpfr_integer_p (u))
return mpfr_set (r, u, rnd_mode);
else
{
mpfr_t tmp;
int inex;
unsigned int saved_flags = __gmpfr_flags;
MPFR_BLOCK_DECL (flags);
mpfr_init2 (tmp, MPFR_PREC (u));
/* round(u) is representable in tmp unless an overflow occurs */
MPFR_BLOCK (flags, mpfr_round (tmp, u));
__gmpfr_flags = saved_flags;
inex = (MPFR_OVERFLOW (flags)
? mpfr_overflow (r, rnd_mode, MPFR_SIGN (u))
: mpfr_set (r, tmp, rnd_mode));
mpfr_clear (tmp);
return inex;
}
}
int
mpfr_rint_round (mpfr_ptr r, mpfr_srcptr u, mpfr_rnd_t rnd_mode)
{
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(u) ) || mpfr_integer_p (u))
return mpfr_set (r, u, rnd_mode);
else
{
mpfr_t tmp;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_BLOCK_DECL (flags);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (u));
/* round(u) is representable in tmp unless an overflow occurs */
MPFR_BLOCK (flags, mpfr_round (tmp, u));
inex = (MPFR_OVERFLOW (flags)
? mpfr_overflow (r, rnd_mode, MPFR_SIGN (u))
: mpfr_set (r, tmp, rnd_mode));
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (r, inex, rnd_mode);
}
}
/* Assumes that the exponent range has already been extended and if y is
an integer, then the result is not exact in unbounded exponent range. */
int
mpfr_pow_general (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y,
mpfr_rnd_t rnd_mode, int y_is_integer, mpfr_save_expo_t *expo)
{
mpfr_t t, u, k, absx;
int neg_result = 0;
int k_non_zero = 0;
int check_exact_case = 0;
int inexact;
/* Declaration of the size variable */
mpfr_prec_t Nz = MPFR_PREC(z); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (ziv_loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x,
mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (z), mpfr_log_prec, z, inexact));
/* We put the absolute value of x in absx, pointing to the significand
of x to avoid allocating memory for the significand of absx. */
MPFR_ALIAS(absx, x, /*sign=*/ 1, /*EXP=*/ MPFR_EXP(x));
/* We will compute the absolute value of the result. So, let's
invert the rounding mode if the result is negative. */
if (MPFR_IS_NEG (x) && is_odd (y))
{
neg_result = 1;
rnd_mode = MPFR_INVERT_RND (rnd_mode);
}
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Nz + 5 + MPFR_INT_CEIL_LOG2 (Nz);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
MPFR_ZIV_INIT (ziv_loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags1);
/* compute exp(y*ln|x|), using MPFR_RNDU to get an upper bound, so
that we can detect underflows. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDD : MPFR_RNDU); /* ln|x| */
mpfr_mul (t, y, t, MPFR_RNDU); /* y*ln|x| */
if (k_non_zero)
{
MPFR_LOG_MSG (("subtract k * ln(2)\n", 0));
mpfr_const_log2 (u, MPFR_RNDD);
mpfr_mul (u, u, k, MPFR_RNDD);
/* Error on u = k * log(2): < k * 2^(-Nt) < 1. */
mpfr_sub (t, t, u, MPFR_RNDU);
MPFR_LOG_MSG (("t = y * ln|x| - k * ln(2)\n", 0));
MPFR_LOG_VAR (t);
}
/* estimate of the error -- see pow function in algorithms.tex.
The error on t is at most 1/2 + 3*2^(EXP(t)+1) ulps, which is
<= 2^(EXP(t)+3) for EXP(t) >= -1, and <= 2 ulps for EXP(t) <= -2.
Additional error if k_no_zero: treal = t * errk, with
1 - |k| * 2^(-Nt) <= exp(-|k| * 2^(-Nt)) <= errk <= 1,
i.e., additional absolute error <= 2^(EXP(k)+EXP(t)-Nt).
Total error <= 2^err1 + 2^err2 <= 2^(max(err1,err2)+1). */
err = MPFR_NOTZERO (t) && MPFR_GET_EXP (t) >= -1 ?
MPFR_GET_EXP (t) + 3 : 1;
if (k_non_zero)
{
if (MPFR_GET_EXP (k) > err)
err = MPFR_GET_EXP (k);
err++;
}
MPFR_BLOCK (flags1, mpfr_exp (t, t, MPFR_RNDN)); /* exp(y*ln|x|)*/
/* We need to test */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (t) || MPFR_UNDERFLOW (flags1)))
{
mpfr_prec_t Ntmin;
MPFR_BLOCK_DECL (flags2);
MPFR_ASSERTN (!k_non_zero);
MPFR_ASSERTN (!MPFR_IS_NAN (t));
/* Real underflow? */
if (MPFR_IS_ZERO (t))
{
/* Underflow. We computed rndn(exp(t)), where t >= y*ln|x|.
Therefore rndn(|x|^y) = 0, and we have a real underflow on
|x|^y. */
inexact = mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ
: rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_UNDERFLOW);
break;
}
/* Real overflow? */
if (MPFR_IS_INF (t))
{
/* Note: we can probably use a low precision for this test. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD);
mpfr_mul (t, y, t, MPFR_RNDD); /* y * ln|x| */
MPFR_BLOCK (flags2, mpfr_exp (t, t, MPFR_RNDD));
/* t = lower bound on exp(y * ln|x|) */
if (MPFR_OVERFLOW (flags2))
{
/* We have computed a lower bound on |x|^y, and it
overflowed. Therefore we have a real overflow
on |x|^y. */
inexact = mpfr_overflow (z, rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_OVERFLOW);
break;
}
}
k_non_zero = 1;
Ntmin = sizeof(mpfr_exp_t) * CHAR_BIT;
if (Ntmin > Nt)
{
Nt = Ntmin;
mpfr_set_prec (t, Nt);
}
mpfr_init2 (u, Nt);
mpfr_init2 (k, Ntmin);
mpfr_log2 (k, absx, MPFR_RNDN);
mpfr_mul (k, y, k, MPFR_RNDN);
mpfr_round (k, k);
MPFR_LOG_VAR (k);
/* |y| < 2^Ntmin, therefore |k| < 2^Nt. */
continue;
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Nz, rnd_mode)))
{
inexact = mpfr_set (z, t, rnd_mode);
break;
}
/* check exact power, except when y is an integer (since the
exact cases for y integer have already been filtered out) */
if (check_exact_case == 0 && ! y_is_integer)
{
if (mpfr_pow_is_exact (z, absx, y, rnd_mode, &inexact))
break;
check_exact_case = 1;
}
/* reactualisation of the precision */
MPFR_ZIV_NEXT (ziv_loop, Nt);
mpfr_set_prec (t, Nt);
if (k_non_zero)
mpfr_set_prec (u, Nt);
}
MPFR_ZIV_FREE (ziv_loop);
if (k_non_zero)
{
int inex2;
long lk;
/* The rounded result in an unbounded exponent range is z * 2^k. As
* MPFR chooses underflow after rounding, the mpfr_mul_2si below will
* correctly detect underflows and overflows. However, in rounding to
* nearest, if z * 2^k = 2^(emin - 2), then the double rounding may
* affect the result. We need to cope with that before overwriting z.
* This can occur only if k < 0 (this test is necessary to avoid a
* potential integer overflow).
* If inexact >= 0, then the real result is <= 2^(emin - 2), so that
* o(2^(emin - 2)) = +0 is correct. If inexact < 0, then the real
* result is > 2^(emin - 2) and we need to round to 2^(emin - 1).
*/
MPFR_ASSERTN (MPFR_EXP_MAX <= LONG_MAX);
lk = mpfr_get_si (k, MPFR_RNDN);
/* Due to early overflow detection, |k| should not be much larger than
* MPFR_EMAX_MAX, and as MPFR_EMAX_MAX <= MPFR_EXP_MAX/2 <= LONG_MAX/2,
* an overflow should not be possible in mpfr_get_si (and lk is exact).
* And one even has the following assertion. TODO: complete proof.
*/
MPFR_ASSERTD (lk > LONG_MIN && lk < LONG_MAX);
/* Note: even in case of overflow (lk inexact), the code is correct.
* Indeed, for the 3 occurrences of lk:
* - The test lk < 0 is correct as sign(lk) = sign(k).
* - In the test MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk,
* if lk is inexact, then lk = LONG_MIN <= MPFR_EXP_MIN
* (the minimum value of the mpfr_exp_t type), and
* __gmpfr_emin - 1 - lk >= MPFR_EMIN_MIN - 1 - 2 * MPFR_EMIN_MIN
* >= - MPFR_EMIN_MIN - 1 = MPFR_EMAX_MAX - 1. However, from the
* choice of k, z has been chosen to be around 1, so that the
* result of the test is false, as if lk were exact.
* - In the mpfr_mul_2si (z, z, lk, rnd_mode), if lk is inexact,
* then |lk| >= LONG_MAX >= MPFR_EXP_MAX, and as z is around 1,
* mpfr_mul_2si underflows or overflows in the same way as if
* lk were exact.
* TODO: give a bound on |t|, then on |EXP(z)|.
*/
if (rnd_mode == MPFR_RNDN && inexact < 0 && lk < 0 &&
MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk && mpfr_powerof2_raw (z))
{
/* Rounding to nearest, real result > z * 2^k = 2^(emin - 2),
* underflow case: as the minimum precision is > 1, we will
* obtain the correct result and exceptions by replacing z by
* nextabove(z).
*/
MPFR_ASSERTN (MPFR_PREC_MIN > 1);
mpfr_nextabove (z);
}
MPFR_CLEAR_FLAGS ();
inex2 = mpfr_mul_2si (z, z, lk, rnd_mode);
if (inex2) /* underflow or overflow */
{
inexact = inex2;
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, __gmpfr_flags);
}
mpfr_clears (u, k, (mpfr_ptr) 0);
}
mpfr_clear (t);
/* update the sign of the result if x was negative */
if (neg_result)
{
MPFR_SET_NEG(z);
inexact = -inexact;
}
return inexact;
}
/* Function to calculate the expected number of unique codes
within each input success class */
void uniquecodes(mpfr_t *ucodes, int psiz, mpz_t n, unsigned long int mu, mpz_t ncodes ,mpfr_t *pdf,mpfr_prec_t prec)
{
//200 bits precision gives log[2^200] around 60 digits decimal precision
mpfr_t unity;
mpfr_init2(unity,prec);
mpfr_set_ui(unity,(unsigned long int) 1,MPFR_RNDN);
mpfr_t nunity;
mpfr_init2(nunity,prec);
mpfr_set_si(nunity,(signed long int) -1,MPFR_RNDN);
mpz_t bcnum;
mpz_init(bcnum);
mpfr_t bcnumf;
mpfr_init2(bcnumf,prec);
mpq_t cfrac;
mpq_init(cfrac);
mpfr_t cfracf;
mpfr_init2(cfracf,prec);
mpfr_t expargr;
mpfr_init2(expargr,prec);
mpfr_t r1;
mpfr_init2(r1,prec);
mpfr_t r2;
mpfr_init2(r2,prec);
// mpfr_t pdf[mu];
unsigned long int i;
int pdex;
int addr;
// for(i=0;i<=mu;i++)
// mpfr_init2(pdf[i],prec);
// inpdf(pdf,n,pin,mu,bcs,prec);
for(pdex=0;pdex<=psiz-1;pdex++)
{
for(i=0;i<=mu;i++)
{
addr=pdex*(mu+1)+i;
mpz_bin_ui(bcnum,n,i);
mpq_set_num(cfrac,ncodes);
mpq_set_den(cfrac,bcnum);
mpq_canonicalize(cfrac);
mpfr_set_q(cfracf,cfrac,MPFR_RNDN);
mpfr_mul(expargr,cfracf,*(pdf+addr),MPFR_RNDN);
mpfr_mul(expargr,expargr,nunity,MPFR_RNDN);
mpfr_exp(r1,expargr,MPFR_RNDN);
mpfr_sub(r1,unity,r1,MPFR_RNDN);
mpfr_set_z(bcnumf,bcnum,MPFR_RNDN);
mpfr_mul(r2,bcnumf,r1,MPFR_RNDN);
mpfr_set((*ucodes+addr),r2,MPFR_RNDN);
mpfr_round((*ucodes+addr),(*ucodes+addr));
}
}
mpfr_clear(unity);
mpfr_clear(nunity);
mpz_clear(bcnum);
mpfr_clear(bcnumf);
mpq_clear(cfrac);
mpfr_clear(cfracf);
mpfr_clear(expargr);
mpfr_clear(r1);
mpfr_clear(r2);
// for(i=0;i<=mu;i++)
// mpfr_clear(pdf[i]);
}
MpfrFloat MpfrFloat::round(const MpfrFloat& value)
{
MpfrFloat retval(MpfrFloat::kNoInitialization);
mpfr_round(retval.mData->mFloat, value.mData->mFloat);
return retval;
}
static PyObject *
GMPy_Real_DivMod_1(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *tempx = NULL, *tempy = NULL, *quo = NULL, *rem = NULL;
PyObject *result = NULL;
CHECK_CONTEXT(context);
if (!(result = PyTuple_New(2)) ||
!(rem = GMPy_MPFR_New(0, context)) ||
!(quo = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (IS_REAL(x) && IS_REAL(y)) {
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context)) ||
!(tempy = GMPy_MPFR_From_Real(y, 1, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
if (mpfr_zero_p(tempy->f)) {
context->ctx.divzero = 1;
if (context->ctx.traps & TRAP_DIVZERO) {
GMPY_DIVZERO("divmod() division by zero");
goto error;
}
}
if (mpfr_nan_p(tempx->f) || mpfr_nan_p(tempy->f) || mpfr_inf_p(tempx->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
else {
mpfr_set_nan(quo->f);
mpfr_set_nan(rem->f);
}
}
else if (mpfr_inf_p(tempy->f)) {
context->ctx.invalid = 1;
if (context->ctx.traps & TRAP_INVALID) {
GMPY_INVALID("divmod() invalid operation");
goto error;
}
if (mpfr_zero_p(tempx->f)) {
mpfr_set_zero(quo->f, mpfr_sgn(tempy->f));
mpfr_set_zero(rem->f, mpfr_sgn(tempy->f));
}
else if ((mpfr_signbit(tempx->f)) != (mpfr_signbit(tempy->f))) {
mpfr_set_si(quo->f, -1, MPFR_RNDN);
mpfr_set_inf(rem->f, mpfr_sgn(tempy->f));
}
else {
mpfr_set_si(quo->f, 0, MPFR_RNDN);
rem->rc = mpfr_set(rem->f, tempx->f, MPFR_RNDN);
}
}
else {
MPFR_Object *temp;
if (!(temp = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
goto error;
/* LCOV_EXCL_STOP */
}
mpfr_fmod(rem->f, tempx->f, tempy->f, MPFR_RNDN);
mpfr_sub(temp->f, tempx->f, rem->f, MPFR_RNDN);
mpfr_div(quo->f, temp->f, tempy->f, MPFR_RNDN);
if (!mpfr_zero_p(rem->f)) {
if ((mpfr_sgn(tempy->f) < 0) != (mpfr_sgn(rem->f) < 0)) {
mpfr_add(rem->f, rem->f, tempy->f, MPFR_RNDN);
mpfr_sub_ui(quo->f, quo->f, 1, MPFR_RNDN);
}
}
else {
mpfr_copysign(rem->f, rem->f, tempy->f, MPFR_RNDN);
}
if (!mpfr_zero_p(quo->f)) {
mpfr_round(quo->f, quo->f);
}
else {
mpfr_setsign(quo->f, quo->f, mpfr_sgn(tempx->f) * mpfr_sgn(tempy->f) - 1, MPFR_RNDN);
}
Py_DECREF((PyObject*)temp);
}
GMPY_MPFR_CHECK_RANGE(quo, context);
GMPY_MPFR_CHECK_RANGE(rem, context);
GMPY_MPFR_SUBNORMALIZE(quo, context);
GMPY_MPFR_SUBNORMALIZE(rem, context);
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
PyTuple_SET_ITEM(result, 0, (PyObject*)quo);
PyTuple_SET_ITEM(result, 1, (PyObject*)rem);
return (PyObject*)result;
}
/* LCOV_EXCL_START */
SYSTEM_ERROR("Internal error in GMPy_Real_DivMod_1().");
error:
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_XDECREF((PyObject*)rem);
Py_XDECREF((PyObject*)quo);
Py_XDECREF(result);
return NULL;
/* LCOV_EXCL_STOP */
}
int
main (int argc, char *argv[])
{
mp_size_t s;
mpz_t z;
mpfr_prec_t p;
mpfr_t x, y, t, u, v;
int r;
int inexact, sign_t;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (y);
mpz_init (z);
mpfr_init (t);
mpfr_init (u);
mpfr_init (v);
mpz_set_ui (z, 1);
for (s = 2; s < 100; s++)
{
/* z has exactly s bits */
mpz_mul_2exp (z, z, 1);
if (randlimb () % 2)
mpz_add_ui (z, z, 1);
mpfr_set_prec (x, s);
mpfr_set_prec (t, s);
mpfr_set_prec (u, s);
if (mpfr_set_z (x, z, MPFR_RNDN))
{
printf ("Error: mpfr_set_z should be exact (s = %u)\n",
(unsigned int) s);
exit (1);
}
if (randlimb () % 2)
mpfr_neg (x, x, MPFR_RNDN);
if (randlimb () % 2)
mpfr_div_2ui (x, x, randlimb () % s, MPFR_RNDN);
for (p = 2; p < 100; p++)
{
int trint;
mpfr_set_prec (y, p);
mpfr_set_prec (v, p);
for (r = 0; r < MPFR_RND_MAX ; r++)
for (trint = 0; trint < 3; trint++)
{
if (trint == 2)
inexact = mpfr_rint (y, x, (mpfr_rnd_t) r);
else if (r == MPFR_RNDN)
inexact = mpfr_round (y, x);
else if (r == MPFR_RNDZ)
inexact = (trint ? mpfr_trunc (y, x) :
mpfr_rint_trunc (y, x, MPFR_RNDZ));
else if (r == MPFR_RNDU)
inexact = (trint ? mpfr_ceil (y, x) :
mpfr_rint_ceil (y, x, MPFR_RNDU));
else /* r = MPFR_RNDD */
inexact = (trint ? mpfr_floor (y, x) :
mpfr_rint_floor (y, x, MPFR_RNDD));
if (mpfr_sub (t, y, x, MPFR_RNDN))
err ("subtraction 1 should be exact",
s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
sign_t = mpfr_cmp_ui (t, 0);
if (trint != 0 &&
(((inexact == 0) && (sign_t != 0)) ||
((inexact < 0) && (sign_t >= 0)) ||
((inexact > 0) && (sign_t <= 0))))
err ("wrong inexact flag", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
if (inexact == 0)
continue; /* end of the test for exact results */
if (((r == MPFR_RNDD || (r == MPFR_RNDZ && MPFR_SIGN (x) > 0))
&& inexact > 0) ||
((r == MPFR_RNDU || (r == MPFR_RNDZ && MPFR_SIGN (x) < 0))
&& inexact < 0))
err ("wrong rounding direction",
s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
if (inexact < 0)
{
mpfr_add_ui (v, y, 1, MPFR_RNDU);
if (mpfr_cmp (v, x) <= 0)
err ("representable integer between x and its "
"rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
}
else
{
mpfr_sub_ui (v, y, 1, MPFR_RNDD);
if (mpfr_cmp (v, x) >= 0)
err ("representable integer between x and its "
"rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
}
if (r == MPFR_RNDN)
{
int cmp;
if (mpfr_sub (u, v, x, MPFR_RNDN))
err ("subtraction 2 should be exact",
s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
cmp = mpfr_cmp_abs (t, u);
if (cmp > 0)
err ("faithful rounding, but not the nearest integer",
s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
if (cmp < 0)
continue;
/* |t| = |u|: x is the middle of two consecutive
representable integers. */
if (trint == 2)
{
/* halfway case for mpfr_rint in MPFR_RNDN rounding
mode: round to an even integer or significand. */
mpfr_div_2ui (y, y, 1, MPFR_RNDZ);
if (!mpfr_integer_p (y))
err ("halfway case for mpfr_rint, result isn't an"
" even integer", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
/* If floor(x) and ceil(x) aren't both representable
integers, the significand must be even. */
mpfr_sub (v, v, y, MPFR_RNDN);
mpfr_abs (v, v, MPFR_RNDN);
if (mpfr_cmp_ui (v, 1) != 0)
{
mpfr_div_2si (y, y, MPFR_EXP (y) - MPFR_PREC (y)
+ 1, MPFR_RNDN);
if (!mpfr_integer_p (y))
err ("halfway case for mpfr_rint, significand isn't"
" even", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
}
}
else
{ /* halfway case for mpfr_round: x must have been
rounded away from zero. */
if ((MPFR_SIGN (x) > 0 && inexact < 0) ||
(MPFR_SIGN (x) < 0 && inexact > 0))
err ("halfway case for mpfr_round, bad rounding"
" direction", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
}
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpz_clear (z);
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (v);
special ();
coverage_03032011 ();
#if __MPFR_STDC (199901L)
if (argc > 1 && strcmp (argv[1], "-s") == 0)
test_against_libc ();
#endif
tests_end_mpfr ();
return 0;
}
static void
special (void)
{
mpfr_t x, y;
mpfr_exp_t emax;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
mpfr_set_inf (x, 1);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) > 0);
mpfr_set_inf (x, -1);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) < 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS(y));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_NEG(y));
/* coverage test */
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_mul_2exp (x, x, mp_bits_per_limb, MPFR_RNDN);
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
/* another coverage test */
emax = mpfr_get_emax ();
set_emax (1);
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "1.11E0");
mpfr_set_prec (y, 2);
mpfr_rint (y, x, MPFR_RNDU); /* x rounds to 1.0E1=0.1E2 which overflows */
MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) > 0);
set_emax (emax);
/* yet another */
mpfr_set_prec (x, 97);
mpfr_set_prec (y, 96);
mpfr_set_str_binary (x, "-0.1011111001101111000111011100011100000110110110110000000111010001000101001111101010101011010111100E97");
mpfr_rint (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "0.10101100000000101001010101111111000000011111010000010E-1");
mpfr_rint (y, x, MPFR_RNDU);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0);
mpfr_rint (y, x, MPFR_RNDD);
MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS(y));
mpfr_set_prec (x, 36);
mpfr_set_prec (y, 2);
mpfr_set_str_binary (x, "-11000110101010111111110111001.0000100");
mpfr_rint (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "-11E27");
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
mpfr_set_prec (x, 39);
mpfr_set_prec (y, 29);
mpfr_set_str_binary (x, "-0.100010110100011010001111001001001100111E39");
mpfr_rint (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "-0.10001011010001101000111100101E39");
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
mpfr_set_prec (x, 46);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "-0.1011100110100101000001011111101011001001101001E32");
mpfr_rint (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "-0.10111001101001010000010111111011E32");
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
/* coverage test for mpfr_round */
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "1.01E1"); /* 2.5 */
mpfr_set_prec (y, 2);
mpfr_round (y, x);
/* since mpfr_round breaks ties away, should give 3 and not 2 as with
the "round to even" rule */
MPFR_ASSERTN(mpfr_cmp_ui (y, 3) == 0);
/* same test for the function */
(mpfr_round) (y, x);
MPFR_ASSERTN(mpfr_cmp_ui (y, 3) == 0);
mpfr_set_prec (x, 6);
mpfr_set_prec (y, 3);
mpfr_set_str_binary (x, "110.111");
mpfr_round (y, x);
if (mpfr_cmp_ui (y, 7))
{
printf ("Error in round(110.111)\n");
exit (1);
}
/* Bug found by Mark J Watkins */
mpfr_set_prec (x, 84);
mpfr_set_str_binary (x,
"0.110011010010001000000111101101001111111100101110010000000000000" \
"000000000000000000000E32");
mpfr_round (x, x);
if (mpfr_cmp_str (x, "0.1100110100100010000001111011010100000000000000" \
"00000000000000000000000000000000000000E32", 2, MPFR_RNDN))
{
printf ("Rounding error when dest=src\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
int
main (void)
{
mp_size_t s;
mpz_t z;
mp_prec_t p;
mpfr_t x, y, t;
mp_rnd_t r;
int inexact, sign_t;
mpfr_init (x);
mpfr_init (y);
mpz_init (z);
mpfr_init (t);
mpz_set_ui (z, 1);
for (s = 2; s < 100; s++)
{
/* z has exactly s bits */
mpz_mul_2exp (z, z, 1);
if (LONG_RAND () % 2)
mpz_add_ui (z, z, 1);
mpfr_set_prec (x, s);
mpfr_set_prec (t, s);
if (mpfr_set_z (x, z, GMP_RNDN))
{
fprintf (stderr, "Error: mpfr_set_z should be exact (s = %u)\n",
(unsigned int) s);
exit (1);
}
for (p=2; p<100; p++)
{
mpfr_set_prec (y, p);
for (r=0; r<4; r++)
{
if (r == GMP_RNDN)
inexact = mpfr_round (y, x);
else if (r == GMP_RNDZ)
inexact = mpfr_trunc (y, x);
else if (r == GMP_RNDU)
inexact = mpfr_ceil (y, x);
else /* r = GMP_RNDD */
inexact = mpfr_floor (y, x);
if (mpfr_sub (t, y, x, GMP_RNDN))
{
fprintf (stderr, "Error: subtraction should be exact\n");
exit (1);
}
sign_t = mpfr_cmp_ui (t, 0);
if (((inexact == 0) && (sign_t != 0)) ||
((inexact < 0) && (sign_t >= 0)) ||
((inexact > 0) && (sign_t <= 0)))
{
fprintf (stderr, "Wrong inexact flag\n");
exit (1);
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpz_clear (z);
mpfr_clear (t);
return 0;
}