static void
check_nans (void)
{
mpfr_t x, y;
int inexact;
mpfr_init2 (x, 123);
mpfr_init2 (y, 123);
/* 1.0 / nan is nan */
mpfr_set_nan (x);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, 1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_NAN);
MPFR_ASSERTN (mpfr_nan_p (y));
/* 1.0 / +inf == +0 */
mpfr_set_inf (x, 1);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, 1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_zero_p (y));
MPFR_ASSERTN (MPFR_IS_POS (y));
/* 1.0 / -inf == -0 */
mpfr_set_inf (x, -1);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, 1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_zero_p (y));
MPFR_ASSERTN (MPFR_IS_NEG (y));
#if !defined(MPFR_ERRDIVZERO)
/* 1.0 / 0 == +inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, 1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_POS (y));
/* -1.0 / 0 == -inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, -1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_NEG (y));
/* 1.0 / -0 == -inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, 1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_NEG (y));
/* -1.0 / -0 == +inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, -1.0, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_POS (y));
/* +inf / 0 == +inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, DBL_POS_INF, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_POS (y));
/* -inf / 0 == -inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, DBL_NEG_INF, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_NEG (y));
/* +inf / -0 == -inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, DBL_POS_INF, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_NEG (y));
/* -inf / -0 == +inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_clear_flags ();
inexact = mpfr_d_div (y, DBL_NEG_INF, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
MPFR_ASSERTN (__gmpfr_flags == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (MPFR_IS_POS (y));
#endif
mpfr_clear (x);
mpfr_clear (y);
}
static int
mpfr_rem1 (mpfr_ptr rem, long *quo, mpfr_rnd_t rnd_q,
mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd)
{
mpfr_exp_t ex, ey;
int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x);
mpz_t mx, my, r;
int tiny = 0;
MPFR_ASSERTD (rnd_q == MPFR_RNDN || rnd_q == MPFR_RNDZ);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x)
|| MPFR_IS_ZERO (y))
{
/* for remquo, quo is undefined */
MPFR_SET_NAN (rem);
MPFR_RET_NAN;
}
else /* either y is Inf and x is 0 or non-special,
or x is 0 and y is non-special,
in both cases the quotient is zero. */
{
if (quo)
*quo = 0;
return mpfr_set (rem, x, rnd);
}
}
/* now neither x nor y is NaN, Inf or zero */
mpz_init (mx);
mpz_init (my);
mpz_init (r);
ex = mpfr_get_z_2exp (mx, x); /* x = mx*2^ex */
ey = mpfr_get_z_2exp (my, y); /* y = my*2^ey */
/* to get rid of sign problems, we compute it separately:
quo(-x,-y) = quo(x,y), rem(-x,-y) = -rem(x,y)
quo(-x,y) = -quo(x,y), rem(-x,y) = -rem(x,y)
thus quo = sign(x/y)*quo(|x|,|y|), rem = sign(x)*rem(|x|,|y|) */
sign = (signx == MPFR_SIGN (y)) ? 1 : -1;
mpz_abs (mx, mx);
mpz_abs (my, my);
q_is_odd = 0;
/* divide my by 2^k if possible to make operations mod my easier */
{
unsigned long k = mpz_scan1 (my, 0);
ey += k;
mpz_fdiv_q_2exp (my, my, k);
}
if (ex <= ey)
{
/* q = x/y = mx/(my*2^(ey-ex)) */
/* First detect cases where q=0, to avoid creating a huge number
my*2^(ey-ex): if sx = mpz_sizeinbase (mx, 2) and sy =
mpz_sizeinbase (my, 2), we have x < 2^(ex + sx) and
y >= 2^(ey + sy - 1), thus if ex + sx <= ey + sy - 1
the quotient is 0 */
if (ex + (mpfr_exp_t) mpz_sizeinbase (mx, 2) <
ey + (mpfr_exp_t) mpz_sizeinbase (my, 2))
{
tiny = 1;
mpz_set (r, mx);
mpz_set_ui (mx, 0);
}
else
{
mpz_mul_2exp (my, my, ey - ex); /* divide mx by my*2^(ey-ex) */
/* since mx > 0 and my > 0, we can use mpz_tdiv_qr in all cases */
mpz_tdiv_qr (mx, r, mx, my);
/* 0 <= |r| <= |my|, r has the same sign as mx */
}
if (rnd_q == MPFR_RNDN)
q_is_odd = mpz_tstbit (mx, 0);
if (quo) /* mx is the quotient */
{
mpz_tdiv_r_2exp (mx, mx, WANTED_BITS);
*quo = mpz_get_si (mx);
}
}
else /* ex > ey */
{
if (quo) /* remquo case */
/* for remquo, to get the low WANTED_BITS more bits of the quotient,
we first compute R = X mod Y*2^WANTED_BITS, where X and Y are
defined below. Then the low WANTED_BITS of the quotient are
floor(R/Y). */
mpz_mul_2exp (my, my, WANTED_BITS); /* 2^WANTED_BITS*Y */
else if (rnd_q == MPFR_RNDN) /* remainder case */
/* Let X = mx*2^(ex-ey) and Y = my. Then both X and Y are integers.
Assume X = R mod Y, then x = X*2^ey = R*2^ey mod (Y*2^ey=y).
To be able to perform the rounding, we need the least significant
bit of the quotient, i.e., one more bit in the remainder,
which is obtained by dividing by 2Y. */
mpz_mul_2exp (my, my, 1); /* 2Y */
mpz_set_ui (r, 2);
mpz_powm_ui (r, r, ex - ey, my); /* 2^(ex-ey) mod my */
mpz_mul (r, r, mx);
mpz_mod (r, r, my);
if (quo) /* now 0 <= r < 2^WANTED_BITS*Y */
{
mpz_fdiv_q_2exp (my, my, WANTED_BITS); /* back to Y */
mpz_tdiv_qr (mx, r, r, my);
/* oldr = mx*my + newr */
*quo = mpz_get_si (mx);
q_is_odd = *quo & 1;
}
else if (rnd_q == MPFR_RNDN) /* now 0 <= r < 2Y in the remainder case */
{
mpz_fdiv_q_2exp (my, my, 1); /* back to Y */
/* least significant bit of q */
q_is_odd = mpz_cmpabs (r, my) >= 0;
if (q_is_odd)
mpz_sub (r, r, my);
}
/* now 0 <= |r| < |my|, and if needed,
q_is_odd is the least significant bit of q */
}
if (mpz_cmp_ui (r, 0) == 0)
{
inex = mpfr_set_ui (rem, 0, MPFR_RNDN);
/* take into account sign of x */
if (signx < 0)
mpfr_neg (rem, rem, MPFR_RNDN);
}
else
{
if (rnd_q == MPFR_RNDN)
{
/* FIXME: the comparison 2*r < my could be done more efficiently
at the mpn level */
mpz_mul_2exp (r, r, 1);
/* if tiny=1, we should compare r with my*2^(ey-ex) */
if (tiny)
{
if (ex + (mpfr_exp_t) mpz_sizeinbase (r, 2) <
ey + (mpfr_exp_t) mpz_sizeinbase (my, 2))
compare = 0; /* r*2^ex < my*2^ey */
else
{
mpz_mul_2exp (my, my, ey - ex);
compare = mpz_cmpabs (r, my);
}
}
else
compare = mpz_cmpabs (r, my);
mpz_fdiv_q_2exp (r, r, 1);
compare = ((compare > 0) ||
((rnd_q == MPFR_RNDN) && (compare == 0) && q_is_odd));
/* if compare != 0, we need to subtract my to r, and add 1 to quo */
if (compare)
{
mpz_sub (r, r, my);
if (quo && (rnd_q == MPFR_RNDN))
*quo += 1;
}
}
/* take into account sign of x */
if (signx < 0)
mpz_neg (r, r);
inex = mpfr_set_z_2exp (rem, r, ex > ey ? ey : ex, rnd);
}
if (quo)
*quo *= sign;
mpz_clear (mx);
mpz_clear (my);
mpz_clear (r);
return inex;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y;
unsigned int n;
int inex;
tests_start_mpfr ();
test_generic (2, 100, 20);
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
/* check NaN */
mpfr_set_nan (x);
inex = test_log10 (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y) && inex == 0);
/* check Inf */
mpfr_set_inf (x, -1);
inex = test_log10 (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y) && inex == 0);
mpfr_set_inf (x, 1);
inex = test_log10 (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y) && mpfr_sgn (y) > 0 && inex == 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
inex = test_log10 (x, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (x) && mpfr_sgn (x) < 0 && inex == 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
inex = test_log10 (x, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (x) && mpfr_sgn (x) < 0 && inex == 0);
/* check negative argument */
mpfr_set_si (x, -1, MPFR_RNDN);
inex = test_log10 (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y) && inex == 0);
/* check log10(1) = 0 */
mpfr_set_ui (x, 1, MPFR_RNDN);
inex = test_log10 (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS (y) && inex == 0);
/* check log10(10^n)=n */
mpfr_set_ui (x, 1, MPFR_RNDN);
for (n = 1; n <= 15; n++)
{
mpfr_mul_ui (x, x, 10, MPFR_RNDN); /* x = 10^n */
inex = test_log10 (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, n))
{
printf ("log10(10^n) <> n for n=%u\n", n);
exit (1);
}
MPFR_ASSERTN (inex == 0);
}
mpfr_clear (x);
mpfr_clear (y);
data_check ("data/log10", mpfr_log10, "mpfr_log10");
tests_end_mpfr ();
return 0;
}
int
mpfr_sub (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
MPFR_LOG_FUNC
(("b[%Pu]=%.*Rg c[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (b), mpfr_log_prec, b,
mpfr_get_prec (c), mpfr_log_prec, c, rnd_mode),
("a[%Pu]=%.*Rg", mpfr_get_prec (a), mpfr_log_prec, a));
if (MPFR_ARE_SINGULAR (b,c))
{
if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c))
{
MPFR_SET_NAN (a);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (b))
{
if (!MPFR_IS_INF (c) || MPFR_SIGN (b) != MPFR_SIGN(c))
{
MPFR_SET_INF (a);
MPFR_SET_SAME_SIGN (a, b);
MPFR_RET (0); /* exact */
}
else
{
MPFR_SET_NAN (a); /* Inf - Inf */
MPFR_RET_NAN;
}
}
else if (MPFR_IS_INF (c))
{
MPFR_SET_INF (a);
MPFR_SET_OPPOSITE_SIGN (a, c);
MPFR_RET (0); /* exact */
}
else if (MPFR_IS_ZERO (b))
{
if (MPFR_IS_ZERO (c))
{
int sign = rnd_mode != MPFR_RNDD
? ((MPFR_IS_NEG(b) && MPFR_IS_POS(c)) ? -1 : 1)
: ((MPFR_IS_POS(b) && MPFR_IS_NEG(c)) ? 1 : -1);
MPFR_SET_SIGN (a, sign);
MPFR_SET_ZERO (a);
MPFR_RET(0); /* 0 - 0 is exact */
}
else
return mpfr_neg (a, c, rnd_mode);
}
else
{
MPFR_ASSERTD (MPFR_IS_ZERO (c));
return mpfr_set (a, b, rnd_mode);
}
}
MPFR_ASSERTD (MPFR_IS_PURE_FP (b));
MPFR_ASSERTD (MPFR_IS_PURE_FP (c));
if (MPFR_LIKELY (MPFR_SIGN (b) == MPFR_SIGN (c)))
{ /* signs are equal, it's a real subtraction */
if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b)
&& MPFR_PREC (b) == MPFR_PREC (c)))
return mpfr_sub1sp (a, b, c, rnd_mode);
else
return mpfr_sub1 (a, b, c, rnd_mode);
}
else
{ /* signs differ, it's an addition */
if (MPFR_GET_EXP (b) < MPFR_GET_EXP (c))
{ /* exchange rounding modes toward +/- infinity */
int inexact;
rnd_mode = MPFR_INVERT_RND (rnd_mode);
if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b)
&& MPFR_PREC (b) == MPFR_PREC (c)))
inexact = mpfr_add1sp (a, c, b, rnd_mode);
else
inexact = mpfr_add1 (a, c, b, rnd_mode);
MPFR_CHANGE_SIGN (a);
return -inexact;
}
else
{
if (MPFR_LIKELY (MPFR_PREC (a) == MPFR_PREC (b)
&& MPFR_PREC (b) == MPFR_PREC (c)))
return mpfr_add1sp (a, b, c, rnd_mode);
else
return mpfr_add1 (a, b, c, rnd_mode);
}
}
}
static void
special (void)
{
mpfr_t x, y;
int r;
mpfr_init (x);
mpfr_init (y);
/* asin(NaN) = NaN */
mpfr_set_nan (x);
mpfr_asin (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_asin (NaN) <> NaN\n");
exit (1);
}
/* asin(+/-Inf) = NaN */
mpfr_set_inf (x, 1);
mpfr_asin (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_asin (+Inf) <> NaN\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_asin (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_asin (-Inf) <> NaN\n");
exit (1);
}
/* asin(+/-2) = NaN */
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_asin (+2) <> NaN\n");
exit (1);
}
mpfr_set_si (x, -2, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_asin (-2) <> NaN\n");
exit (1);
}
/* asin(+/-0) = +/-0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error: mpfr_asin (+0) <> +0\n");
exit (1);
}
mpfr_neg (x, x, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
{
printf ("Error: mpfr_asin (-0) <> -0\n");
exit (1);
}
/* asin(1) = Pi/2 */
for (r = 0; r < MPFR_RND_MAX; r++)
{
mpfr_set_ui (x, 1, MPFR_RNDN); /* exact */
mpfr_asin (y, x, (mpfr_rnd_t) r);
mpfr_const_pi (x, (mpfr_rnd_t) r);
mpfr_div_2exp (x, x, 1, MPFR_RNDN); /* exact */
if (mpfr_cmp (x, y))
{
printf ("Error: asin(1) != Pi/2 for rnd=%s\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
exit (1);
}
}
/* asin(-1) = -Pi/2 */
for (r = 0; r < MPFR_RND_MAX; r++)
{
mpfr_set_si (x, -1, MPFR_RNDN); /* exact */
mpfr_asin (y, x, (mpfr_rnd_t) r);
mpfr_const_pi (x, MPFR_INVERT_RND((mpfr_rnd_t) r));
mpfr_neg (x, x, MPFR_RNDN); /* exact */
mpfr_div_2exp (x, x, 1, MPFR_RNDN); /* exact */
if (mpfr_cmp (x, y))
{
printf ("Error: asin(-1) != -Pi/2 for rnd=%s\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
exit (1);
}
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.1101110111111111001011101000101");
mpfr_asin (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "1.00001100101011000001111100111");
if (mpfr_cmp (x, y))
{
printf ("Error: mpfr_asin (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "-0.01110111000011101010111100000101");
mpfr_asin (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "-0.0111101111010100011111110101");
if (mpfr_cmp (x, y))
{
printf ("Error: mpfr_asin (2)\n");
mpfr_print_binary (x); printf ("\n");
mpfr_print_binary (y); printf ("\n");
exit (1);
}
mpfr_set_prec (x, 9);
mpfr_set_prec (y, 19);
mpfr_set_str_binary (x, "0.110000000E-6");
mpfr_asin (y, x, MPFR_RNDD);
mpfr_set_prec (x, 19);
mpfr_set_str_binary (x, "0.1100000000000001001E-6");
if (mpfr_cmp (x, y))
{
printf ("Error: mpfr_asin (3)\n");
mpfr_dump (x);
mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/* bugs found by Alain Delplanque */
static void
check_large (void)
{
mpfr_t x;
char *s, s1[7];
const char xm[] = { '1', '1', '9', '1', '3', '2', '9', '3', '7', '3',
'5', '8', '4', '4', '5', '4', '9', '0', '2', '9',
'6', '3', '4', '4', '6', '9', '9', '1', '9', '5',
'5', '7', '2', '0', '1', '7', '5', '2', '8', '6',
'1', '2', '5', '2', '5', '2', '7', '4', '0', '2',
'7', '9', '1', '1', '7', '4', '5', '6', '7', '5',
'9', '3', '1', '4', '2', '5', '5', '6', '6', '6',
'1', '6', '4', '3', '8', '1', '2', '8', '7', '6',
'2', '9', '2', '0', '8', '8', '9', '4', '3', '9',
'6', '2', '8', '4', '1', '1', '8', '1', '0', '6',
'2', '3', '7', '6', '3', '8', '1', '5', '1', '7',
'3', '4', '6', '1', '2', '4', '0', '1', '3', '0',
'8', '4', '1', '3', '9', '3', '2', '0', '1', '6',
'3', '6', '7', '1', '5', '1', '7', '5', '0', '1',
'9', '8', '4', '0', '8', '2', '7', '9', '1', '3',
'2', '2', '8', '3', '4', '1', '6', '2', '3', '9',
'6', '2', '0', '7', '3', '5', '5', '5', '3', '4',
'2', '1', '7', '0', '9', '7', '6', '2', '1', '0',
'3', '3', '5', '4', '7', '6', '0', '9', '7', '6',
'9', '3', '5', '1', '7', '8', '6', '8', '8', '2',
'8', '1', '4', '3', '7', '4', '3', '3', '2', '4',
'1', '5', '4', '7', '8', '1', '1', '4', '2', '1',
'2', '4', '2', '7', '6', '5', '9', '5', '4', '5',
'2', '6', '7', '3', '0', '3', '4', '0', '6', '9',
'1', '8', '9', '9', '9', '8', '0', '5', '7', '0',
'9', '3', '8', '7', '6', '2', '4', '6', '1', '6',
'7', '2', '0', '3', '5', '9', '3', '5', '8', '8',
'9', '7', '7', '9', '2', '7', '0', '8', '1', '6',
'8', '7', '4', '8', '5', '3', '0', '8', '4', '3',
'5', '6', '5', '1', '6', '6', '0', '9', '7', '9',
'8', '9', '2', '7', '2', '6', '8', '5', '9', '4',
'5', '8', '1', '3', '7', '2', '9', '3', '8', '3',
'7', '9', '1', '7', '9', '9', '7', '7', '2', '8',
'4', '6', '5', '5', '7', '3', '3', '8', '3', '6',
'6', '9', '7', '1', '4', '3', '3', '7', '1', '4',
'9', '4', '1', '2', '4', '9', '5', '1', '4', '7',
'2', '6', '4', '4', '8', '0', '6', '2', '6', '0',
'6', '9', '8', '1', '1', '7', '9', '9', '3', '9',
'3', '8', '4', '7', '3', '1', '9', '0', '2', '3',
'5', '3', '5', '4', '2', '1', '1', '7', '6', '7',
'4', '3', '2', '2', '0', '6', '5', '9', '9', '3',
'2', '6', '7', '1', '2', '0', '0', '3', '7', '3',
'8', '7', '4', '3', '3', '3', '3', '3', '2', '3',
'8', '2', '8', '6', '3', '1', '5', '5', '2', '2',
'5', '9', '3', '3', '7', '0', '6', '2', '8', '1',
'0', '3', '6', '7', '6', '9', '6', '5', '9', '0',
'6', '6', '6', '3', '6', '9', '9', '3', '8', '7',
'6', '5', '4', '5', '3', '5', '9', '4', '0', '0',
'7', '5', '8', '5', '4', '1', '4', '3', '1', '5',
'7', '6', '6', '3', '4', '4', '5', '0', '8', '7',
'5', '7', '5', '0', '1', '0', '1', '8', '4', '7',
'3', '1', '9', '9', '2', '7', '1', '1', '1', '2',
'3', '9', '9', '6', '5', '9', '2', '3', '2', '8',
'1', '5', '5', '1', '2', '6', '4', '9', '6', '6',
'4', '5', '1', '1', '6', '0', '0', '3', '2', '8',
'4', '8', '7', '1', '4', '9', '6', '8', '1', '6',
'5', '9', '8', '3', '4', '2', '9', '7', '0', '1',
'9', '2', '6', '6', '9', '1', '3', '5', '9', '3',
'2', '9', '6', '2', '3', '0', '6', '0', '1', '1',
'6', '5', '1', '7', '9', '0', '7', '5', '8', '6',
'8', '4', '2', '1', '0', '3', '8', '6', '6', '4',
'4', '9', '9', '7', '5', '8', '1', '7', '5', '7',
'9', '6', '6', '8', '8', '5', '8', '6', '7', '4',
'0', '7', '2', '0', '2', '9', '9', '4', '4', '1',
'9', '5', '8', '6', '5', '0', '6', '7', '4', '2',
'7', '3', '2', '3', '2', '7', '0', '2', '1', '3',
'0', '5', '9', '0', '3', '9', '1', '4', '5', '3',
'7', '2', '7', '0', '8', '5', '5', '4', '6', '1',
'1', '0', '0', '9', '2', '0', '4', '1', '6', '6',
'4', '6', '9', '1', '3', '2', '8', '5', '0', '3',
'3', '8', '9', '8', '7', '8', '5', '9', '5', '5',
'9', '1', '9', '3', '6', '5', '4', '1', '7', '4',
'0', '2', '4', '7', '2', '9', '7', '1', '2', '4',
'5', '8', '1', '4', '4', '6', '1', '8', '5', '8',
'7', '6', '9', '7', '2', '1', '2', '0', '8', '9',
'5', '9', '5', '5', '3', '8', '1', '2', '5', '4',
'3', '0', '7', '6', '5', '1', '7', '8', '2', '0',
'0', '7', '6', '7', '4', '8', '1', '0', '6', '3',
'2', '3', '0', '5', '2', '5', '0', '1', '1', '4',
'3', '8', '4', '5', '2', '3', '9', '5', '0', '9',
'8', '2', '6', '4', '7', '4', '8', '0', '1', '1',
'7', '1', '5', '4', '9', '0', '9', '2', '2', '3',
'8', '1', '6', '9', '0', '4', '6', '4', '5', '4',
'6', '3', '8', '7', '3', '6', '1', '7', '2', '3',
'4', '5', '5', '2', '0', '2', '5', '8', '1', '4',
'9', '3', '0', '7', '4', '1', '6', '8', '7', '8',
'2', '6', '2', '5', '1', '0', '7', '4', '7', '3',
'6', '6', '4', '5', '6', '6', '6', '6', '8', '5',
'1', '3', '5', '7', '1', '6', '2', '0', '9', '2',
'3', '2', '6', '0', '7', '9', '8', '1', '6', '2',
'0', '3', '8', '8', '0', '2', '8', '7', '7', '5',
'9', '3', '1', '0', '6', '7', '5', '7', '3', '1',
'2', '7', '7', '2', '0', '0', '4', '1', '2', '8',
'2', '0', '8', '4', '0', '5', '0', '5', '0', '1',
'9', '3', '3', '6', '3', '6', '9', '6', '2', '8',
'2', '9', '7', '5', '3', '8', '8', '9', '1', '1',
'4', '5', '7', '7', '5', '6', '0', '2', '7', '9',
'7', '2', '1', '7', '4', '3', '0', '3', '6', '7',
'3', '7', '2', '2', '7', '5', '6', '2', '3', '1',
'2', '1', '3', '1', '4', '2', '6', '9', '2', '3',
'\0' };
mpfr_exp_t e;
mpfr_init2 (x, 3322);
mpfr_set_str (x, xm, 10, MPFR_RNDN);
mpfr_div_2exp (x, x, 4343, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (s[999] != '1') /* s must be 5.04383...689071e-309 */
{
printf ("Error in check_large: expected '689071', got '%s'\n",
s + 994);
exit (1);
}
mpfr_free_str (s);
mpfr_mul_2exp (x, x, 4343, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (strcmp (s, "12") || (e != 1000))
{
printf ("Error in check_large: expected 0.12e1000\n");
printf ("got %se%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_set_nan (x);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "@NaN@"))
{
printf ("Error for NaN\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_inf (x, 1);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "@Inf@"))
{
printf ("Error for Inf\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_inf (x, -1);
s = mpfr_get_str (NULL, &e, 10, 1000, x, MPFR_RNDN);
if (strcmp (s, "-@Inf@"))
{
printf ("Error for -Inf\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 1000, x, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (e != 0 || strcmp (s, "00"))
{
printf ("Error for 0.0\n");
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 2, x, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0.0 */
s = mpfr_get_str (NULL, &e, 10, 2, x, MPFR_RNDN);
if (e != 0 || strcmp (s, "-00"))
{
printf ("Error for -0.0\ngot %se%d\n", s, (int) e);
exit (1);
}
mpfr_free_str (s);
mpfr_get_str (s1, &e, 10, 2, x, MPFR_RNDN);
mpfr_clear (x);
}
int
main (void)
{
mpfr_t x;
tests_start_mpfr ();
mpfr_init (x);
/* check +infinity gives non-zero for mpfr_inf_p only */
mpfr_set_ui (x, 1L, MPFR_RNDZ);
mpfr_div_ui (x, x, 0L, MPFR_RNDZ);
if (mpfr_nan_p (x) || (mpfr_nan_p) (x) )
{
printf ("Error: mpfr_nan_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(+Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+Inf) gives non-zero\n");
exit (1);
}
/* same for -Inf */
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p(x)))
{
printf ("Error: mpfr_nan_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(-Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p)(x) )
{
printf ("Error: mpfr_number_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_zero_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-Inf) gives non-zero\n");
exit (1);
}
/* same for NaN */
mpfr_sub (x, x, x, MPFR_RNDN);
if (mpfr_nan_p (x) == 0)
{
printf ("Error: mpfr_nan_p(NaN) gives zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(NaN) gives non-zero\n");
exit (1);
}
/* same for a regular number */
mpfr_set_ui (x, 1, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(1) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) == 0 || (mpfr_regular_p) (x) == 0)
{
printf ("Error: mpfr_regular_p(1) gives zero\n");
exit (1);
}
/* Same for +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(+0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(+0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+0) gives non-zero\n");
exit (1);
}
/* Same for -0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(-0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(-0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-0) gives non-zero\n");
exit (1);
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
int
mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
int inex;
unsigned long absn;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex));
absn = SAFE_ABS (unsigned long, n);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z)))
{
if (MPFR_IS_NAN (z))
{
MPFR_SET_NAN (res); /* y(n,NaN) = NaN */
MPFR_RET_NAN;
}
/* y(n,z) tends to zero when z goes to +Inf, oscillating around
0. We choose to return +0 in that case. */
else if (MPFR_IS_INF (z))
{
if (MPFR_SIGN(z) > 0)
return mpfr_set_ui (res, 0, r);
else /* y(n,-Inf) = NaN */
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
}
else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise,
when z goes to zero */
{
MPFR_SET_INF(res);
if (n >= 0 || ((unsigned long) n & 1) == 0)
MPFR_SET_NEG(res);
else
MPFR_SET_POS(res);
mpfr_set_divby0 ();
MPFR_RET(0);
}
}
/* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we
assume does not happen for a rational z. */
if (MPFR_SIGN(z) < 0)
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
/* now z is not singular, and z > 0 */
MPFR_SAVE_EXPO_MARK (expo);
/* Deal with tiny arguments. We have:
y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more
precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z),
g(z) - 0.41*z^2 < y0(z)/log(z) < g(z)
thus since log(z) is negative:
g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z)
and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on
y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2.
Note: we use both the main term in log(z) and the constant term, because
otherwise the relative error would be only in 1/log(|log(z)|).
*/
if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2))
{
mpfr_t l, h, t, logz;
mpfr_prec_t prec;
int ok, inex2;
prec = MPFR_PREC(res) + 10;
mpfr_init2 (l, prec);
mpfr_init2 (h, prec);
mpfr_init2 (t, prec);
mpfr_init2 (logz, prec);
/* first enclose log(z) + euler - log(2) = log(z/2) + euler */
mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */
mpfr_set (h, logz, MPFR_RNDU); /* exact */
mpfr_nextabove (h); /* upper bound of log(z) */
mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */
mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */
mpfr_nextabove (t); /* upper bound of euler */
mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */
mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */
mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */
mpfr_nextbelow (t); /* lower bound of log(2) */
mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */
mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */
mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */
mpfr_nextbelow (t); /* lower bound of Pi */
mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */
mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */
mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */
/* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z)
to h */
mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */
/* since logz is negative, a lower bound corresponds to an upper bound
for its absolute value */
mpfr_neg (t, t, MPFR_RNDD);
mpfr_div_2ui (t, t, 1, MPFR_RNDD);
mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */
mpfr_add (h, h, t, MPFR_RNDU);
inex = mpfr_prec_round (l, MPFR_PREC(res), r);
inex2 = mpfr_prec_round (h, MPFR_PREC(res), r);
/* we need h=l and inex=inex2 */
ok = (inex == inex2) && mpfr_equal_p (l, h);
if (ok)
mpfr_set (res, h, r); /* exact */
mpfr_clear (l);
mpfr_clear (h);
mpfr_clear (t);
mpfr_clear (logz);
if (ok)
goto end;
}
/* small argument check for y1(z) = -2/Pi/z + O(log(z)):
for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */
if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res))
{
mpfr_t y;
mpfr_prec_t prec;
mpfr_exp_t err1;
int ok;
MPFR_BLOCK_DECL (flags);
/* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1),
then |y1(z)| > 2^emax */
prec = MPFR_PREC(res) + 10;
mpfr_init2 (y, prec);
mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u
represents a quantity <= 1/2^prec */
mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */
MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ));
/* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */
if (MPFR_OVERFLOW (flags))
{
mpfr_clear (y);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (res, r, -1);
}
mpfr_neg (y, y, MPFR_RNDN);
/* (1+u)^6 can be written 1+7u [for another value of u], thus the
error on 2/Pi/z is less than 7ulp(y). The truncation error is less
than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y),
otherwise it is less than 1/4+7/8 <= 2. */
if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */
err1 = 3;
else /* ulp(y) <= 1/8 */
err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1;
ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r);
if (ok)
inex = mpfr_set (res, y, r);
mpfr_clear (y);
if (ok)
goto end;
}
/* we can use the asymptotic expansion as soon as z > p log(2)/2,
but to get some margin we use it for z > p/2 */
if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0)
{
inex = mpfr_yn_asympt (res, n, z, r);
if (inex != 0)
goto end;
}
/* General case */
{
mpfr_prec_t prec;
mpfr_exp_t err1, err2, err3;
mpfr_t y, s1, s2, s3;
MPFR_ZIV_DECL (loop);
mpfr_init (y);
mpfr_init (s1);
mpfr_init (s2);
mpfr_init (s3);
prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13;
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (y, prec);
mpfr_set_prec (s1, prec);
mpfr_set_prec (s2, prec);
mpfr_set_prec (s3, prec);
mpfr_mul (y, z, z, MPFR_RNDN);
mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */
/* store (z/2)^n temporarily in s2 */
mpfr_pow_ui (s2, z, absn, MPFR_RNDN);
mpfr_div_2si (s2, s2, absn, MPFR_RNDN);
/* compute S1 * (z/2)^(-n) */
if (n == 0)
{
mpfr_set_ui (s1, 0, MPFR_RNDN);
err1 = 0;
}
else
err1 = mpfr_yn_s1 (s1, y, absn - 1);
mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */
/* See algorithms.tex: the relative error on s1 is bounded by
(3n+3)*2^(e+1-prec). */
err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1;
/* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */
/* compute (z/2)^n * S3 */
mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */
err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */
/* the error on s3 is bounded by 2^err3 ulps */
/* add s1+s3 */
err1 += MPFR_EXP(s1);
mpfr_add (s1, s1, s3, MPFR_RNDN);
/* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1))
+ 2^err3*2^(EXP(s3) - EXP(s1)) */
err3 += MPFR_EXP(s3);
err1 = (err3 > err1) ? err3 + 1 : err1 + 1;
err1 -= MPFR_EXP(s1);
err1 = (err1 >= 0) ? err1 + 1 : 1;
/* now the error on s1 is bounded by 2^err1*ulp(s1) */
/* compute S2 */
mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */
mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */
mpfr_const_euler (s3, MPFR_RNDN);
err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3);
mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */
err2 -= MPFR_EXP(s2);
mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */
mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */
mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */
err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see
algorithms.tex */
/* add all three sums */
err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */
err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */
mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */
err2 = (err1 > err2) ? err1 + 1 : err2 + 1;
err2 -= MPFR_EXP(s2);
err2 = (err2 >= 0) ? err2 + 1 : 1;
/* now the error on s2 is bounded by 2^err2*ulp(s2) */
mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */
mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by
2^(err2+1)*ulp(s2) */
err2 ++;
if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
/* Assume two's complement for the test n & 1 */
inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ?
MPFR_SIGN (s2) : - MPFR_SIGN (s2));
mpfr_clear (y);
mpfr_clear (s1);
mpfr_clear (s2);
mpfr_clear (s3);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (res, inex, r);
}
int main(){
double max;
double tmp;
double resDet;
mpfr_t det;
double mulTmp;
mpfr_t tmp1;
mpfr_t tmp2;
mpfr_t logAbsDet;
int i,j,k,maxRow,sign;
char f_name[50];
double* buffer;
mpfr_init(det);
mpfr_init(tmp1);
mpfr_init(tmp2);
mpfr_init(logAbsDet);
buffer = malloc(size*size*sizeof(double));
sprintf(f_name,"m5000x5000.bin");
FILE *datafile=fopen(f_name,"rb");
for(i=0;i<size;i++){
for(j=0;j<size;j++){
*(buffer+size*i+j)=0;
}
}
for(i=0;i<size;i++){
for(j=0;j<size;j++){
fread(buffer+(size*i+j),sizeof(double),1,datafile);
}
}
for(i=0;i<size;i++){
for(j=0;j<size;j++){
printf("%lf\t",*(buffer+(size*i+j)));
}
printf("\n");
}
for(i=0;i<size-1;i++){
maxRow = i;
max = *(buffer+(size*i+i));
for(j=i+1;j<size;j++){
if(fabs(max)<fabs(*(buffer+size*j+i))){
max = *(buffer+size*j+i);
maxRow=j;
}
}
if(fabs(max)<0.000001){
resDet =0;
printf("det=%e\n",resDet);
exit(1);
}
if(maxRow!=i){
sign++;
for(j=i;j<size;j++){
tmp = *(buffer + size*i+j);
*(buffer+size*i+j) = *(buffer + size*maxRow+j);
*(buffer+size*maxRow+j) = tmp;
}
}
for(j=i+1;j<size;j++){
mulTmp = *(buffer+size*j+i) / *(buffer+size*i+i);
for(k=i;k<size;k++){
*(buffer+size*j+k) = *(buffer+size*j+k)-*(buffer + size*i+k)*mulTmp;
}
}
}
mpfr_set_d(tmp1,1.0,GMP_RNDN);
for(i=0;i<size;i++){
mpfr_set_d(tmp2,*(buffer+size*i+i),GMP_RNDN);
mpfr_mul(tmp1,tmp2,tmp1,GMP_RNDN);
}
if(sign%2==0){
mpfr_set(det,tmp1,GMP_RNDN);
resDet=mpfr_get_d(det,GMP_RNDN);
mpfr_log10(logAbsDet,det,GMP_RNDN);
}
else{
mpfr_neg(tmp1,tmp1,GMP_RNDN);
mpfr_set(det,tmp1,GMP_RNDN);
resDet=mpfr_get_d(det,GMP_RNDN);
mpfr_log10(logAbsDet,det,GMP_RNDN);
}
//mpf_abs(absDet,det);
// mpf_set(logAbsDet, mpfr_log10(absDet));
// mpfr_printf("det= %Fe\n",det);
printf("det= %e\n",resDet);
mpfr_printf("log(abs(det))= %Fe\n",logAbsDet);
//gmp_printf("log(abs(det)= %e\n",logAbsDet);
double END = clock();
printf("%f\n",END/CLOCKS_PER_SEC);
mpfr_clear(det);
mpfr_clear(tmp1);
mpfr_clear(tmp2);
mpfr_clear(logAbsDet);
free(buffer);
return 0;
}
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 (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;
}
int
main (void)
{
mpfr_t x, u;
mpf_t y, z;
mp_exp_t emax;
unsigned long k, pr;
int r, inexact;
MPFR_TEST_USE_RANDS ();
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, GMP_RNDN);
mpfr_set_prec (x, 100);
mpfr_set_f (x, y, GMP_RNDN);
mpf_random2 (y, 10, 0);
mpfr_set_f (x, y, (mp_rnd_t) 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, GMP_RNDN);
mpf_set_str (y, "2033033E-3", 10); /* avoid 2033.033 which is
locale-sensitive */
mpfr_set_f (x, y, GMP_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, GMP_RNDN);
mpfr_neg (u, u, GMP_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, GMP_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);
for (k = 1; k <= 100000; k++)
{
pr = 2 + (randlimb () & 255);
mpf_set_prec (z, pr);
mpf_random2 (z, z->_mp_prec, 0);
mpfr_set_prec (x, pr);
mpfr_set_f (x, z, (mp_rnd_t) 0);
}
/* Check for +0 */
mpfr_set_prec (x, 53);
mpf_set_prec (y, 53);
mpf_set_ui (y, 0);
for (r = 0 ; r < GMP_RND_MAX ; r++)
{
int i;
for (i = -1; i <= 1; i++)
{
if (i)
mpfr_set_si (x, i, GMP_RNDN);
inexact = mpfr_set_f (x, y, (mp_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 ((mp_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_random (x); /* to fill low limbs with random data */
inexact = mpfr_set_f (x, y, GMP_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, GMP_RNDN);
mpfr_set_ui (u, 1, GMP_RNDN);
mpfr_mul_2ui (u, u, ULONG_MAX, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_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, GMP_RNDN);
mpfr_set_ui_2exp (u, 1, emax, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_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, GMP_RNDN);
mpfr_set_ui_2exp (u, 1, emax - 1, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_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;
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
double sd, eps, m1, c;
long add;
mpfr_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (
("s[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, MPFR_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
return mpfr_set_si_2exp (z, -1, -1, rnd_mode);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|.
Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding
(the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest).
A sufficient condition is that EXP(s) + 1 < -PREC(z). */
if (MPFR_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if (rnd_mode == MPFR_RNDA)
rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */
if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == MPFR_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == MPFR_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_GET_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* Check for case s= 1 before changing the exponent range */
if (mpfr_cmp (s, __gmpfr_one) ==0)
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
mpfr_set_divby0 ();
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
int overflow = 0;
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
sd = mpfr_get_d (s, MPFR_RNDN) - 1.0;
if (sd < 0.0)
sd = -sd; /* now sd = abs(s-1.0) */
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
/* eps = pow (2.0, - (double) precz - 14.0); */
eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0);
m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps);
c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1));
/* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */
add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1));
prec1 = precz + add;
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_sub (s1, __gmpfr_one, s, MPFR_RNDN);/* s1 = 1-s */
mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */
mpfr_gamma (y, s1, MPFR_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k,
Zeta(s) > 0 for -4k < s < -4k+2 */
{
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1;
break;
}
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */
mpfr_const_pi (p, MPFR_RNDD);
mpfr_mul (y, s, p, MPFR_RNDN);
mpfr_div_2ui (y, y, 1, MPFR_RNDN); /* s*Pi/2 */
mpfr_sin (y, y, MPFR_RNDN); /* sin(Pi*s/2) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */
mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
if (overflow != 0)
{
inex = mpfr_overflow (z, rnd_mode, overflow);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
}
else
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* The computation of z = pow(x,y) is done by
z = exp(y * log(x)) = x^y
For the special cases, see Section F.9.4.4 of the C standard:
_ pow(±0, y) = ±inf for y an odd integer < 0.
_ pow(±0, y) = +inf for y < 0 and not an odd integer.
_ pow(±0, y) = ±0 for y an odd integer > 0.
_ pow(±0, y) = +0 for y > 0 and not an odd integer.
_ pow(-1, ±inf) = 1.
_ pow(+1, y) = 1 for any y, even a NaN.
_ pow(x, ±0) = 1 for any x, even a NaN.
_ pow(x, y) = NaN for finite x < 0 and finite non-integer y.
_ pow(x, -inf) = +inf for |x| < 1.
_ pow(x, -inf) = +0 for |x| > 1.
_ pow(x, +inf) = +0 for |x| < 1.
_ pow(x, +inf) = +inf for |x| > 1.
_ pow(-inf, y) = -0 for y an odd integer < 0.
_ pow(-inf, y) = +0 for y < 0 and not an odd integer.
_ pow(-inf, y) = -inf for y an odd integer > 0.
_ pow(-inf, y) = +inf for y > 0 and not an odd integer.
_ pow(+inf, y) = +0 for y < 0.
_ pow(+inf, y) = +inf for y > 0. */
int
mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
int inexact;
int cmp_x_1;
int y_is_integer;
MPFR_SAVE_EXPO_DECL (expo);
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));
if (MPFR_ARE_SINGULAR (x, y))
{
/* pow(x, 0) returns 1 for any x, even a NaN. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (y)))
return mpfr_set_ui (z, 1, rnd_mode);
else if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_NAN (y))
{
/* pow(+1, NaN) returns 1. */
if (mpfr_cmp_ui (x, 1) == 0)
return mpfr_set_ui (z, 1, rnd_mode);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (y))
{
if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int cmp;
cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y);
MPFR_SET_POS (z);
if (cmp > 0)
{
/* Return +inf. */
MPFR_SET_INF (z);
MPFR_RET (0);
}
else if (cmp < 0)
{
/* Return +0. */
MPFR_SET_ZERO (z);
MPFR_RET (0);
}
else
{
/* Return 1. */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
}
else if (MPFR_IS_INF (x))
{
int negative;
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG (x) && mpfr_odd_p (y);
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int negative;
MPFR_ASSERTD (MPFR_IS_ZERO (x));
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG(x) && mpfr_odd_p (y);
if (MPFR_IS_NEG (y))
{
MPFR_ASSERTD (! MPFR_IS_INF (y));
MPFR_SET_INF (z);
MPFR_SET_DIVBY0 ();
}
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* x^y for x < 0 and y not an integer is not defined */
y_is_integer = mpfr_integer_p (y);
if (MPFR_IS_NEG (x) && ! y_is_integer)
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
/* now the result cannot be NaN:
(1) either x > 0
(2) or x < 0 and y is an integer */
cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one);
if (cmp_x_1 == 0)
return mpfr_set_si (z, MPFR_IS_NEG (x) && mpfr_odd_p (y) ? -1 : 1, rnd_mode);
/* now we have:
(1) either x > 0
(2) or x < 0 and y is an integer
and in addition |x| <> 1.
*/
/* detect overflow: an overflow is possible if
(a) |x| > 1 and y > 0
(b) |x| < 1 and y < 0.
FIXME: this assumes 1 is always representable.
FIXME2: maybe we can test overflow and underflow simultaneously.
The idea is the following: first compute an approximation to
y * log2|x|, using rounding to nearest. If |x| is not too near from 1,
this approximation should be accurate enough, and in most cases enable
one to prove that there is no underflow nor overflow.
Otherwise, it should enable one to check only underflow or overflow,
instead of both cases as in the present case.
*/
/* fast check for cases where no overflow nor underflow is possible:
if |y| <= 2^15, and -32767 < EXP(x) <= 32767, then
|y*log2(x)| <= 2^15*32767 < 1073741823, thus for the default
emax=1073741823 and emin=-emax there can be no overflow nor underflow */
if (__gmpfr_emax >= 1073741823 && __gmpfr_emin <= -1073741823 &&
MPFR_EXP(y) <= 15 && -32767 < MPFR_EXP(x) && MPFR_EXP(x) <= 32767)
goto no_overflow_nor_underflow;
if (cmp_x_1 * MPFR_SIGN (y) > 0)
{
mpfr_t t;
int negative, overflow;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (t, 53);
/* we want a lower bound on y*log2|x|:
(i) if x > 0, it suffices to round log2(x) toward zero, and
to round y*o(log2(x)) toward zero too;
(ii) if x < 0, we first compute t = o(-x), with rounding toward 1,
and then follow as in case (1). */
if (MPFR_IS_POS (x))
mpfr_log2 (t, x, MPFR_RNDZ);
else
{
mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU);
mpfr_log2 (t, t, MPFR_RNDZ);
}
mpfr_mul (t, t, y, MPFR_RNDZ);
overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0;
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
if (overflow)
{
MPFR_LOG_MSG (("early overflow detection\n", 0));
negative = MPFR_IS_NEG (x) && mpfr_odd_p (y);
return mpfr_overflow (z, rnd_mode, negative ? -1 : 1);
}
}
/* Basic underflow checking. One has:
* - if y > 0, |x^y| < 2^(EXP(x) * y);
* - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y);
* so that one can compute a value ebound such that |x^y| < 2^ebound.
* If we have ebound <= emin - 2 (emin - 1 in directed rounding modes),
* then there is an underflow and we can decide the return value.
*/
if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0))
{
mp_limb_t tmp_limb[MPFR_EXP_LIMB_SIZE];
mpfr_t tmp;
mpfr_eexp_t ebound;
int inex2;
/* We must restore the flags. */
MPFR_SAVE_EXPO_MARK (expo);
MPFR_TMP_INIT1 (tmp_limb, tmp, sizeof (mpfr_exp_t) * CHAR_BIT);
inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
if (MPFR_IS_NEG (y))
{
inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
}
mpfr_mul (tmp, tmp, y, MPFR_RNDU);
if (MPFR_IS_NEG (y))
mpfr_nextabove (tmp);
/* tmp doesn't necessarily fit in ebound, but that doesn't matter
since we get the minimum value in such a case. */
ebound = mpfr_get_exp_t (tmp, MPFR_RNDU);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (ebound <=
__gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1)))
{
/* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */
MPFR_LOG_MSG (("early underflow detection\n", 0));
return mpfr_underflow (z,
rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
MPFR_IS_NEG (x) && mpfr_odd_p (y) ? -1 : 1);
}
}
no_overflow_nor_underflow:
/* If y is an integer, we can use mpfr_pow_z (based on multiplications),
but if y is very large (I'm not sure about the best threshold -- VL),
we shouldn't use it, as it can be very slow and take a lot of memory
(and even crash or make other programs crash, as several hundred of
MBs may be necessary). Note that in such a case, either x = +/-2^b
(this case is handled below) or x^y cannot be represented exactly in
any precision supported by MPFR (the general case uses this property).
*/
if (y_is_integer && (MPFR_GET_EXP (y) <= 256))
{
mpz_t zi;
MPFR_LOG_MSG (("special code for y not too large integer\n", 0));
mpz_init (zi);
mpfr_get_z (zi, y, MPFR_RNDN);
inexact = mpfr_pow_z (z, x, zi, rnd_mode);
mpz_clear (zi);
return inexact;
}
/* Special case (+/-2^b)^Y which could be exact. If x is negative, then
necessarily y is a large integer. */
if (mpfr_powerof2_raw (x))
{
mpfr_exp_t b = MPFR_GET_EXP (x) - 1;
mpfr_t tmp;
int sgnx = MPFR_SIGN (x);
MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */
MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0));
/* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is
an integer */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT);
inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inexact == 0);
/* Note: as the exponent range has been extended, an overflow is not
possible (due to basic overflow and underflow checking above, as
the result is ~ 2^tmp), and an underflow is not possible either
because b is an integer (thus either 0 or >= 1). */
MPFR_CLEAR_FLAGS ();
inexact = mpfr_exp2 (z, tmp, rnd_mode);
mpfr_clear (tmp);
if (sgnx < 0 && mpfr_odd_p (y))
{
mpfr_neg (z, z, rnd_mode);
inexact = -inexact;
}
/* Without the following, the overflows3 test in tpow.c fails. */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
MPFR_SAVE_EXPO_MARK (expo);
/* Case where y * log(x) is very small. Warning: x can be negative, in
that case y is a large integer. */
{
mpfr_exp_t err, expx, logt;
/* We need an upper bound on the exponent of y * log(x). */
if (MPFR_IS_POS(x))
expx = cmp_x_1 > 0 ? MPFR_EXP(x) : 1 - MPFR_EXP(x);
else
expx = mpfr_cmp_si (x, -1) > 0 ? 1 - MPFR_EXP(x) : MPFR_EXP(x);
MPFR_ASSERTD(expx >= 0);
/* now |log(x)| < expx */
logt = MPFR_INT_CEIL_LOG2 (expx);
/* now expx <= 2^logt */
err = MPFR_GET_EXP (y) + logt;
MPFR_CLEAR_FLAGS ();
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0,
(MPFR_IS_POS (y)) ^ (cmp_x_1 < 0),
rnd_mode, expo, {});
}
/* General case */
inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, MPFR_RNDN);
mpfr_lngamma (x, y, MPFR_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (MPFR_IS_NAN (x) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (120)\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("Got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
inex = mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lngamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(0.1100E-66)\n");
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-2^199-0.5)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
static void
special_erf (void)
{
mpfr_t x, y;
int inex;
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
/* erf(NaN) = NaN */
mpfr_set_nan (x);
mpfr_erf (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("mpfr_erf failed for x=NaN\n");
exit (1);
}
/* erf(+Inf) = 1 */
mpfr_set_inf (x, 1);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_erf failed for x=+Inf\n");
printf ("expected 1.0, got ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* erf(-Inf) = -1 */
mpfr_set_inf (x, -1);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_si (y, -1))
{
printf ("mpfr_erf failed for x=-Inf\n");
exit (1);
}
/* erf(+0) = +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("mpfr_erf failed for x=+0\n");
exit (1);
}
/* erf(-0) = -0 */
mpfr_neg (x, x, MPFR_RNDN);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
{
printf ("mpfr_erf failed for x=-0\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.11010111101110110011110100111010000010000100010001011");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=1.0, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
printf ("expected 1\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "-6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_si (x, -1))
{
printf ("mpfr_erf failed for x=-6.6, rnd=MPFR_RNDN\n");
printf ("expected -1\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDZ\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "4.5", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.1111111111111111111111111111111100100111110100011");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=4.5, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 120);
mpfr_set_prec (y, 120);
mpfr_set_str_binary (x, "0.110100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011E3");
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111111111111111100111111000100111011111011010000110101111100011001101");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 8);
mpfr_set_ui (x, 50, MPFR_RNDN);
inex = mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN\n");
printf ("expected 1, got ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inex <= 0)
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
"expected positive, got %d\n", inex);
exit (1);
}
inex = mpfr_erf (x, x, MPFR_RNDZ);
mpfr_nextbelow (y);
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDZ\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inex >= 0)
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
"expected negative, got %d\n", inex);
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.1010100100111011001111100101E-1");
mpfr_set_str_binary (y, "0.10111000001110011010110001101011E-1");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "-0.10110011011010111110010001100001");
mpfr_set_str_binary (y, "-0.1010110110101011100010111000111");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (2)\n");
mpfr_print_binary (x); printf ("\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (3)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_erf (x, x, MPFR_RNDZ);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (4)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (5)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (6)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
mpfr_erf (x, x, MPFR_RNDZ);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (7)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (8)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (9)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (10)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (11)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDD);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (12)\n");
exit (1);
}
mpfr_set_prec (x, 43);
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "-0.1101110110101111100101011101110101101001001e3");
mpfr_erf (y, x, MPFR_RNDU);
mpfr_set_prec (x, 64);
mpfr_set_str_binary (x, "-0.1111111111111111111111111111111111111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=43,64 (13)\n");
exit (1);
}
/* worst cases */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "1.0000000000000000000000000000000000000110000000101101");
mpfr_erf (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.110101111011101100111101001110100000101011000011001");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
mpfr_erf (y, x, MPFR_RNDU);
mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000110");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (2a)\n");
exit (1);
}
mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
mpfr_erf (y, x, MPFR_RNDD);
mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000101");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (2b)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z, ax;
long int iy;
mpfr_init (x);
mpfr_init (ax);
mpfr_init2 (y,sizeof(unsigned long int)*CHAR_BIT);
mpfr_init (z);
MPFR_SET_NAN(x);
mpfr_random(y);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_NAN(z))
{
printf ("evaluation of function in x=NAN does not return NAN");
exit (1);
}
MPFR_SET_NAN(y);
mpfr_random(x);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_NAN(z))
{
printf ("evaluation of function in y=NAN does not return NAN");
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_ZERO(y);
mpfr_random(x);
mpfr_pow (z, x,y, GMP_RNDN);
if(mpfr_cmp_ui(z,1)!=0 && !(MPFR_IS_NAN(x)))
{
printf ("evaluation of function in y=0 does not return 1\n");
printf ("x =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_INF(y);
if (MPFR_SIGN(y) < 0)
MPFR_CHANGE_SIGN(y);
mpfr_random(x);
mpfr_set_prec (ax, MPFR_PREC(x));
mpfr_abs(ax,x,GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
if( !MPFR_IS_INF(z) && (mpfr_cmp_ui(ax,1) > 0) )
{
printf ("evaluation of function in y=INF (|x|>1) does not return INF");
exit (1);
}
if( !MPFR_IS_ZERO(z) && (mpfr_cmp_ui(ax,1) < 0) )
{
printf ("\nevaluation of function in y=INF (|x|<1) does not return 0");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_INF(y);
if (MPFR_SIGN(y) > 0)
MPFR_CHANGE_SIGN(y);
mpfr_random(x);
mpfr_set_prec (ax, MPFR_PREC(x));
mpfr_abs(ax,x,GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
if( !MPFR_IS_INF(z) && (mpfr_cmp_ui(ax,1) < 0) )
{
printf ("evaluation of function in y=INF (for |x| <0) does not return INF");
exit (1);
}
if( !MPFR_IS_ZERO(z) && (mpfr_cmp_ui(ax,1) > 0) )
{
printf ("evaluation of function in y=INF (for |x| >0) does not return 0");
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_INF(x);
if (MPFR_SIGN(x) < 0)
MPFR_CHANGE_SIGN(x);
mpfr_random(y);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0))
{
printf ("evaluation of function in INF does not return INF");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0))
{
printf ("evaluation of function in INF does not return INF");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_INF(x);
if (MPFR_SIGN(x) > 0)
MPFR_CHANGE_SIGN(x);
mpfr_random(y);
if (random() % 2)
mpfr_neg (y, y, GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in x=-INF does not return INF");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
if(mpfr_isinteger(y))
printf("y is an integer\n");
else
printf("y is not an integer\n");
exit (1);
}
if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in x=-INF does not return 0");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
if(mpfr_isinteger(y))
printf("y is an integer\n");
else
printf("y is not an integer\n");
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_INF(x);
if (MPFR_SIGN(x) > 0)
MPFR_CHANGE_SIGN(x);
iy=random();
mpfr_random(y);
if (random() % 2)
iy=-iy;
mpfr_set_d(y,iy,GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in x=-INF does not return INF");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
if(mpfr_isinteger(y))
printf("y is an integer\n");
else
printf("y is not an integer\n");
exit (1);
}
if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in x=-INF does not return 0");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
if(mpfr_isinteger(y))
printf("y is an integer\n");
else
printf("y is not an integer\n");
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
mpfr_set_ui(x,1,GMP_RNDN);
MPFR_SET_INF(y);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_NAN(z))
{
printf ("evaluation of function in x=1, y=INF does not return NAN");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
MPFR_CLEAR_FLAGS(z);
MPFR_CLEAR_FLAGS(y);
MPFR_CLEAR_FLAGS(x);
MPFR_SET_ZERO(x);
mpfr_random(y);
if (random() % 2)
mpfr_neg (y, y, GMP_RNDN);
mpfr_pow (z, x,y, GMP_RNDN);
if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) < 0) && !(mpfr_isinteger(y)))
{
printf ("evaluation of function in y<0 does not return 0");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
if(!MPFR_IS_INF(z) && (MPFR_SIGN(y) < 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in y<0 (y integer) does not return INF");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
if(!MPFR_IS_ZERO(z) && (MPFR_SIGN(y) > 0) && (mpfr_isinteger(y)))
{
printf ("evaluation of function in y<0 (y integer) does not return 0");
printf ("\nx =");
mpfr_out_str (stdout, 10, MPFR_PREC(x), x, GMP_RNDN);
printf ("\n y =");
mpfr_out_str (stdout, 10, MPFR_PREC(y), y, GMP_RNDN);
printf ("\n result =");
mpfr_out_str (stdout, 10, MPFR_PREC(z), z, GMP_RNDN);
putchar('\n');
exit (1);
}
{
mp_prec_t prec, yprec;
mpfr_t t, s;
mp_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n, err;
int p0=2;
int p1=100;
int N=100;
mpfr_init (s);
mpfr_init (t);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (s, sizeof(unsigned long int)*CHAR_BIT);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (n=0; n<N; n++)
{
mpfr_random (x);
mpfr_random (s);
if (random() % 2)
mpfr_neg (s, s, GMP_RNDN);
rnd = random () % 4;
mpfr_set_prec (y, yprec);
compare = mpfr_pow (y, x, s, rnd);
err = (rnd == GMP_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = mpfr_pow (z,x, s, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, GMP_RNDN);
printf (" values of the exponential=");
mpfr_out_str (stdout, 2, prec, s, GMP_RNDN);
printf (" prec=%u rnd_mode=%s\n", (unsigned) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, z, GMP_RNDN);
putchar ('\n');
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, GMP_RNDN);
putchar ('\n');
printf ("approx ");
mpfr_print_binary (y);
putchar ('\n');
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if ((rnd != GMP_RNDN) && (compare * compare2 >= 0))
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (((inexact == 0) && (compare != 0)) ||
((inexact > 0) && (compare <= 0)) ||
((inexact < 0) && (compare >= 0)))
{
fprintf (stderr, "Wrong inexact flag for rnd=%s: expected %d, got %d\n",
mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x="); mpfr_print_binary (x); putchar ('\n');
printf ("y="); mpfr_print_binary (y); putchar ('\n');
printf ("t="); mpfr_print_binary (t); putchar ('\n');
exit (1);
}
}
}
}
mpfr_clear (s);
mpfr_clear (t);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (ax);
return 0;
}
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int s_re;
int s_im;
int inex_re;
int inex_im;
int inex;
inex_re = 0;
inex_im = 0;
s_re = mpfr_signbit (mpc_realref (op));
s_im = mpfr_signbit (mpc_imagref (op));
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_nan_p (mpc_realref (op)))
{
mpfr_set_nan (mpc_realref (rop));
if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
mpfr_set_nan (mpc_imagref (rop));
}
else
{
if (mpfr_inf_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int cmp_1;
if (s_im)
cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
else
cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);
if (cmp_1 < 0)
{
/* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s_re)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else if (cmp_1 == 0)
{
/* atan(+/-0+i) = NaN +i*inf
atan(+/-0-i) = NaN -i*inf */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
}
else
{
/* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
mpfr_rnd_t rnd_im, rnd_away;
mpfr_t y;
mpfr_prec_t p, p_im;
int ok;
rnd_im = MPC_RND_IM (rnd);
mpfr_init (y);
p_im = mpfr_get_prec (mpc_imagref (rop));
p = p_im;
/* a = o(1/y) with error(a) < 1 ulp(a)
b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)
As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
2 bits of precision are lost.
We round atanh(1/y) away from 0.
*/
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (y, p);
rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
/* FIXME: should we consider the case with unreasonably huge
precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
representable while 1/Im(op) underflows ?
This corresponds to |y| = 0.5*2^emin, in which case the
result may be wrong. */
/* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
inex_im |= mpfr_atanh (y, y, rnd_away);
ok = inex_im == 0
|| mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN));
} while (ok == 0);
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
mpfr_clear (y);
}
return MPC_INEX (inex_re, inex_im);
}
/* regular number argument */
{
mpfr_t a, b, x, y;
mpfr_prec_t prec, p;
mpfr_exp_t err, expo;
int ok = 0;
mpfr_t minus_op_re;
mpfr_exp_t op_re_exp, op_im_exp;
mpfr_rnd_t rnd1, rnd2;
mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);
/* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
op_re_exp = mpfr_get_exp (mpc_realref (op));
op_im_exp = mpfr_get_exp (mpc_imagref (op));
prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */
/* a = o(1-y) error(a) < 1 ulp(a)
b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
= kb ulp(b)
c = o(1+y) error(c) < 1 ulp(c)
d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
= kd ulp(d)
e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
+ kd*2^{Exp(d)-Exp(e)}] ulp(e)
error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
+ 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
because |atan(u)| < |u|
< [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
-Exp(e)}] ulp(e)
f = e/2 exact
*/
/* p: working precision */
p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
: (prec - op_im_exp);
rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (x, p);
/* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
x positive, and an upper bound on 1-y for x negative */
mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
expo will be 1 or 2 below */
{
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
/* check for intermediate underflow */
err = 2; /* ensures err will be expo below */
}
else
err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);
/* b = lower bound for atan (-x/(1+y)): for x negative, we need a
lower bound on -x/(1+y), i.e., an upper bound on 1+y */
mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
/* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
and we can simply ignore the terms involving Exp(a) in the error */
if (mpfr_sgn (a) == 0)
{
MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
/* check for intermediate underflow */
expo = err; /* will leave err unchanged below */
}
else
expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);
err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
mpfr_sub (x, x, b, GMP_RNDU);
err = 5 + op_re_exp - err - mpfr_get_exp (x);
/* error is bounded by [1 + 2^err] ulp(e) */
err = err < 0 ? 1 : err + 1;
mpfr_div_2ui (x, x, 1, GMP_RNDU);
/* Note: using RND2=RNDD guarantees that if x is exactly representable
on prec + ... bits, mpfr_can_round will return 0 */
ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
/* Imaginary part
Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */
/* a = o(1+y) error(a) < 1 ulp(a)
b = o(a^2) error(b) < 5 ulp(b)
c = o(x^2) error(c) < 1 ulp(c)
d = o(b+c) error(d) < 7 ulp(d)
e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
f = o(1-y) error(f) < 1 ulp(f)
g = o(f^2) error(g) < 5 ulp(g)
h = o(c+f) error(h) < 7 ulp(h)
i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
+ ki*2^{Exp(i)-Exp(j)}] ulp(j)
error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
+ 7*2^{3-Exp(j)}] ulp(j)
< [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
+ 7*2^{3-Exp(j)}] ulp(j)
k = j/4 exact
*/
err = 2;
p = prec; /* working precision */
do
{
p += mpc_ceil_log2 (p) + err;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (y, p);
/* a = upper bound for log(x^2 + (1+y)^2) */
ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
mpfr_sqr (a, a, GMP_RNDU);
mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
mpfr_add (a, a, y, GMP_RNDU);
mpfr_log (a, a, GMP_RNDU);
/* b = lower bound for log(x^2 + (1-y)^2) */
mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
mpfr_sqr (b, b, GMP_RNDZ);
/* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
more efficient to reuse the value of y (x^2) above and subtract
one ulp */
mpfr_nextbelow (y);
mpfr_add (b, b, y, GMP_RNDZ);
mpfr_log (b, b, GMP_RNDZ);
mpfr_sub (y, a, b, GMP_RNDU);
if (mpfr_zero_p (y))
/* FIXME: happens when x and y have very different magnitudes;
could be handled more efficiently */
ok = 0;
else
{
expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
expo = expo - mpfr_get_exp (y) + 1;
err = 3 - mpfr_get_exp (y);
/* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
err = (err < 0) ? 1 : err + 2;
else
err = (expo < 0) ? 1 : expo + 2;
mpfr_div_2ui (y, y, 2, GMP_RNDN);
MPC_ASSERT (!mpfr_zero_p (y));
/* FIXME: underflow. Since the main term of the Taylor series
in y=0 is 1/(x^2+1) * y, this means that y is very small
and/or x very large; but then the mpfr_zero_p (y) above
should be true. This needs a proof, or better yet,
special code. */
ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_IM (rnd) == GMP_RNDN));
}
} while (ok == 0);
inex = mpc_set_fr_fr (rop, x, y, rnd);
mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
return inex;
}
}
int
main (int argc, char **argv)
{
mpfr_t x, y;
double a, b;
mpfi_t i;
mpfi_init2 (i, 53);
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
a = -1;
b = +1;
mpfr_set_d (x, -1, MPFI_RNDD);
mpfr_set_d (y, +1, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, b, a, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, a, a, x, x, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
mpfi_set_prec (i, 4);
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
a = -1;
b = +40;
mpfr_set_d (x, -1, MPFI_RNDD);
mpfr_set_d (y, +40, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, b, a, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, a, a, x, x, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
a = -1;
b = +42.35;
mpfr_set_d (x, -1, MPFI_RNDD);
mpfr_set_d (y, +42.35, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_RIGHT_ENDPOINT_INEXACT);
check (i, b, a, x, y, MPFI_FLAGS_RIGHT_ENDPOINT_INEXACT);
a = -0.1;
mpfr_set_d (x, -0.1, MPFI_RNDD);
mpfr_set_d (y, +42.35, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_INEXACT);
check (i, b, a, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_INEXACT);
a = -1e-4;
b = +16;
mpfr_set_d (x, -1e-4, MPFI_RNDD);
mpfr_set_d (y, +16, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_LEFT_ENDPOINT_INEXACT);
check (i, b, a, x, y, MPFI_FLAGS_LEFT_ENDPOINT_INEXACT);
mpfr_set_nan (x);
a = mpfr_get_d (x, MPFI_RNDD); /* a = NaN, if supported */
check (i, a, b, y, x, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, b, a, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, a, a, x, x, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
mpfr_set_ui (x, 0, MPFI_RNDD);
mpfr_neg (x, x, MPFI_RNDD);
a = mpfr_get_d (x, MPFI_RNDD); /* a = -0, if supported */
mpfr_neg (x, x, MPFI_RNDU);
check (i, a, b, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
check (i, b, a, x, y, MPFI_FLAGS_BOTH_ENDPOINTS_EXACT);
mpfi_clear (i);
mpfr_clear (x);
mpfr_clear (y);
return 0;
}
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t xp;
mpfr_t arcs;
int signe, suplement;
mpfr_t tmp;
int Prec;
int prec_asin;
int good = 0;
int realprec;
int estimated_delta;
int compared;
/* Trivial cases */
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(asin);
MPFR_RET_NAN;
}
/* Set x_p=|x| */
signe = MPFR_SIGN(x);
mpfr_init2 (xp, MPFR_PREC(x));
mpfr_set (xp, x, rnd_mode);
if (signe == -1)
MPFR_CHANGE_SIGN(xp);
compared = mpfr_cmp_ui (xp, 1);
if (compared > 0) /* asin(x) = NaN for |x| > 1 */
{
MPFR_SET_NAN(asin);
mpfr_clear (xp);
MPFR_RET_NAN;
}
if (compared == 0) /* x = 1 or x = -1 */
{
if (signe > 0) /* asin(+1) = Pi/2 */
mpfr_const_pi (asin, rnd_mode);
else /* asin(-1) = -Pi/2 */
{
if (rnd_mode == GMP_RNDU)
rnd_mode = GMP_RNDD;
else if (rnd_mode == GMP_RNDD)
rnd_mode = GMP_RNDU;
mpfr_const_pi (asin, rnd_mode);
mpfr_neg (asin, asin, rnd_mode);
}
MPFR_EXP(asin)--;
mpfr_clear (xp);
return 1; /* inexact */
}
if (MPFR_IS_ZERO(x)) /* x = 0 */
{
mpfr_set_ui (asin, 0, GMP_RNDN);
mpfr_clear(xp);
return 0; /* exact result */
}
prec_asin = MPFR_PREC(asin);
mpfr_ui_sub (xp, 1, xp, GMP_RNDD);
suplement = 2 - MPFR_EXP(xp);
#ifdef DEBUG
printf("suplement=%d\n", suplement);
#endif
realprec = prec_asin + 10;
while (!good)
{
estimated_delta = 1 + suplement;
Prec = realprec+estimated_delta;
/* Initialisation */
mpfr_init2 (tmp, Prec);
mpfr_init2 (arcs, Prec);
#ifdef DEBUG
printf("Prec=%d\n", Prec);
printf(" x=");
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
#endif
mpfr_mul (tmp, x, x, GMP_RNDN);
#ifdef DEBUG
printf(" x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_ui_sub (tmp, 1, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" 1-x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: 1-x^2=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_sqrt (tmp, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: sqrt(1-x^2)=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_div (tmp, x, tmp, GMP_RNDN);
#ifdef DEBUG
printf("x/sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_atan (arcs, tmp, GMP_RNDN);
#ifdef DEBUG
printf("atan(x/..x^2)=");
mpfr_out_str (stdout, 2, 0, arcs, GMP_RNDN);
printf ("\n");
#endif
if (mpfr_can_round (arcs, realprec, GMP_RNDN, rnd_mode, MPFR_PREC(asin)))
{
mpfr_set (asin, arcs, rnd_mode);
#ifdef DEBUG
printf("asin =");
mpfr_out_str (stdout, 2, prec_asin, asin, GMP_RNDN);
printf ("\n");
#endif
good = 1;
}
else
{
realprec += _mpfr_ceil_log2 ((double) realprec);
#ifdef DEBUG
printf("RETRY\n");
#endif
}
mpfr_clear (tmp);
mpfr_clear (arcs);
}
mpfr_clear (xp);
return 1; /* inexact result */
}
static PyObject *
GMPy_Real_Sub(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *result;
CHECK_CONTEXT(context);
if (!(result = GMPy_MPFR_New(0, context)))
return NULL;
/* This only processes mpfr if the exponent is still in-bounds. Need
* to handle the rare case at the end. */
if (MPFR_Check(x) && MPFR_Check(y)) {
mpfr_clear_flags();
result->rc = mpfr_sub(result->f, MPFR(x), MPFR(y), GET_MPFR_ROUND(context));
goto done;
}
if (MPFR_Check(x)) {
if (PyIntOrLong_Check(y)) {
int error;
long temp = GMPy_Integer_AsLongAndError(y, &error);
if (!error) {
mpfr_clear_flags();
result->rc = mpfr_sub_si(result->f, MPFR(x), temp, GET_MPFR_ROUND(context));
goto done;
}
else {
mpz_t tempz;
mpz_inoc(tempz);
mpz_set_PyIntOrLong(tempz, y);
mpfr_clear_flags();
result->rc = mpfr_sub_z(result->f, MPFR(x), tempz, GET_MPFR_ROUND(context));
mpz_cloc(tempz);
goto done;
}
}
if (CHECK_MPZANY(y)) {
mpfr_clear_flags();
result->rc = mpfr_sub_z(result->f, MPFR(x), MPZ(y), GET_MPFR_ROUND(context));
goto done;
}
if (IS_RATIONAL(y)) {
MPQ_Object *tempy;
if (!(tempy = GMPy_MPQ_From_Number(y, context))) {
Py_DECREF((PyObject*)result);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_sub_q(result->f, MPFR(x), tempy->q, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempy);
goto done;
}
if (PyFloat_Check(y)) {
mpfr_clear_flags();
result->rc = mpfr_sub_d(result->f, MPFR(x), PyFloat_AS_DOUBLE(y), GET_MPFR_ROUND(context));
goto done;
}
}
if (MPFR_Check(y)) {
if (PyIntOrLong_Check(x)) {
int error;
long temp = GMPy_Integer_AsLongAndError(x, &error);
if (!error) {
mpfr_clear_flags();
result->rc = mpfr_sub_si(result->f, MPFR(y), temp, GET_MPFR_ROUND(context));
mpfr_neg(result->f, result->f, GET_MPFR_ROUND(context));
goto done;
}
else {
mpz_t tempz;
mpz_inoc(tempz);
mpz_set_PyIntOrLong(tempz, x);
mpfr_clear_flags();
result->rc = mpfr_sub_z(result->f, MPFR(y), tempz, GET_MPFR_ROUND(context));
mpfr_neg(result->f, result->f, GET_MPFR_ROUND(context));
mpz_cloc(tempz);
goto done;
}
}
if (CHECK_MPZANY(x)) {
mpfr_clear_flags();
result->rc = mpfr_sub_z(result->f, MPFR(y), MPZ(x), GET_MPFR_ROUND(context));
mpfr_neg(result->f, result->f, GET_MPFR_ROUND(context));
goto done;
}
if (IS_RATIONAL(x)) {
MPQ_Object *tempx;
if (!(tempx = GMPy_MPQ_From_Number(x, context))) {
Py_DECREF((PyObject*)result);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_sub_q(result->f, MPFR(y), tempx->q, GET_MPFR_ROUND(context));
mpfr_neg(result->f, result->f, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
goto done;
}
if (PyFloat_Check(x)) {
mpfr_clear_flags();
result->rc = mpfr_sub_d(result->f, MPFR(y), PyFloat_AS_DOUBLE(x), GET_MPFR_ROUND(context));
mpfr_neg(result->f, result->f, GET_MPFR_ROUND(context));
goto done;
}
}
if (IS_REAL(x) && IS_REAL(y)) {
MPFR_Object *tempx, *tempy;
tempx = GMPy_MPFR_From_Real(x, 1, context);
tempy = GMPy_MPFR_From_Real(y, 1, context);
if (!tempx || !tempy) {
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_DECREF((PyObject*)result);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_sub(result->f, MPFR(tempx), MPFR(tempy), GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
goto done;
}
Py_DECREF((PyObject*)result);
Py_RETURN_NOTIMPLEMENTED;
done:
GMPY_MPFR_CLEANUP(result, context, "subtraction");
return (PyObject*)result;
}
int
main (void)
{
mpfr_t x;
mpfr_exp_t emax;
tests_start_mpfr ();
mpfr_init (x);
mpfr_set_nan (x);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_inf (x, -1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));
emax = mpfr_get_emax ();
set_emax (0);
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "0.111");
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
set_emax (emax);
mpfr_set_prec (x, mp_bits_per_limb + 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_nextbelow (x);
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
if (mpfr_cmp_ui(x, 4))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 4\n");
exit (1);
}
/* check case when reallocation is needed */
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
mpfr_init2 (x, 3);
mpfr_set_si (x, -5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_si(x, -5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of -5\n");
exit (1);
}
/* check case when new precision needs less limbs */
mpfr_set_prec (x, mp_bits_per_limb + 1);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, 3, MPFR_RNDN); /* exact */
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mpfr_exp_t emin, emax;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
/* Check special case: An overflow in const_pi could occurs! */
set_emin (-125);
set_emax (128);
mpfr_set_prec (y, 24*2);
mpfr_set_prec (x, 24);
mpfr_set_str_binary (x, "0.111110101010101011110101E0");
test_log (y, x, MPFR_RNDN);
set_emin (emin);
set_emax (emax);
mpfr_set_prec (y, 53);
mpfr_set_prec (x, 53);
mpfr_set_ui (x, 3, MPFR_RNDD);
test_log (y, x, MPFR_RNDD);
if (mpfr_cmp_str1 (y, "1.09861228866810956"))
{
printf ("Error in mpfr_log(3) for MPFR_RNDD\n");
exit (1);
}
/* check large precision */
mpfr_set_prec (x, 3322);
mpfr_set_prec (y, 3322);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_sqrt (x, x, MPFR_RNDN);
test_log (y, x, MPFR_RNDN);
/* negative argument */
mpfr_set_si (x, -1, MPFR_RNDN);
test_log (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
/* infinite loop when */
set_emax (128);
mpfr_set_prec (x, 251);
mpfr_set_prec (y, 251);
mpfr_set_str_binary (x, "0.10010111000000000001101E8");
/* x = 4947981/32768, log(x) ~ 5.017282... */
test_log (y, x, MPFR_RNDN);
set_emax (emax);
mpfr_set_ui (x, 0, MPFR_RNDN);
inex = test_log (y, x, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
inex = test_log (y, x, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_clear (x);
mpfr_clear (y);
}
// arithmetic
void negate(ElementType &result, const ElementType& a) const
{
mpfr_neg(&result, &a, GMP_RNDN);
}
static void
check_nans (void)
{
mpfr_t x, y, m;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
mpfr_init2 (m, 123L);
/* agm(1,nan) == nan */
mpfr_set_ui (x, 1L, MPFR_RNDN);
mpfr_set_nan (y);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (m));
/* agm(1,+inf) == +inf */
mpfr_set_ui (x, 1L, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (m));
MPFR_ASSERTN (mpfr_sgn (m) > 0);
/* agm(+inf,+inf) == +inf */
mpfr_set_inf (x, 1);
mpfr_set_inf (y, 1);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (m));
MPFR_ASSERTN (mpfr_sgn (m) > 0);
/* agm(-inf,+inf) == nan */
mpfr_set_inf (x, -1);
mpfr_set_inf (y, 1);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (m));
/* agm(+0,+inf) == nan */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (m));
/* agm(+0,1) == +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_ZERO (m) && MPFR_IS_POS(m));
/* agm(-0,1) == +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_ZERO (m) && MPFR_IS_POS(m));
/* agm(-0,+0) == +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_ZERO (m) && MPFR_IS_POS(m));
/* agm(1,1) == 1 */
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (m ,1) == 0);
/* agm(-1,-2) == NaN */
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_si (y, -2, MPFR_RNDN);
mpfr_agm (m, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (m));
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (m);
}
static void
check_specials (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
mpfr_set_nan (x);
mpfr_sech (y, x, GMP_RNDN);
if (! mpfr_nan_p (y))
{
printf ("Error: sech(NaN) != NaN\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_sech (y, x, GMP_RNDN);
if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(+Inf) != +0\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_sech (y, x, GMP_RNDN);
if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(-Inf) != +0\n");
exit (1);
}
/* sec(+/-0) = 1 */
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error: sech(+0) != 1\n");
exit (1);
}
mpfr_neg (x, x, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error: sech(-0) != 1\n");
exit (1);
}
/* check huge x */
mpfr_set_str (x, "8e8", 10, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(8e8) != +0\n");
exit (1);
}
mpfr_set_str (x, "-8e8", 10, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(-8e8) != +0\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
static void
special (void)
{
mpfr_t x, y;
int inex;
int sign;
mp_exp_t emin, emax;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lgamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != -1)
{
printf ("Error for lgamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, GMP_RNDN);
sign = -17;
mpfr_lgamma (x, &sign, y, GMP_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (120)\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("Got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
sign = -17;
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lgamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(0.1100E-66)\n");
printf ("Expected ");
mpfr_dump (x);
printf ("Got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_add_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != -1)
{
printf ("Error for lgamma(-2^199-0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("with sign %d instead of ", sign);
mpfr_dump (x);
printf ("with sign -1.\n");
exit (1);
}
mpfr_set_prec (x, 10);
mpfr_set_prec (y, 10);
mpfr_set_str_binary (x, "-0.1101111000E-3");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "10.01001011");
if (mpfr_equal_p (x, y) == 0 || sign != -1 || inex >= 0)
{
printf ("Error for lgamma(-0.1101111000E-3)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
printf ("with sign %d instead of -1 (inex=%d).\n", sign, inex);
exit (1);
}
mpfr_set_prec (x, 18);
mpfr_set_prec (y, 28);
mpfr_set_str_binary (x, "-1.10001101010001101e-196");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 28);
mpfr_set_str_binary (x, "0.100001110110101011011010011E8");
MPFR_ASSERTN (mpfr_equal_p (x, y) && inex < 0);
/* values reported by Kaveh Ghazi on 14 Jul 2007, where mpfr_lgamma()
takes forever */
#define VAL1 "-0.11100001001010110111001010001001001011110100110000110E-55"
#define OUT1 "100110.01000000010111001110110101110101001001100110111"
#define VAL2 "-0.11100001001010110111001010001001001011110011111111100E-55"
#define OUT2 "100110.0100000001011100111011010111010100100110011111"
#define VAL3 "-0.11100001001010110111001010001001001001110101101010100E-55"
#define OUT3 "100110.01000000010111001110110101110101001011110111011"
#define VAL4 "-0.10001111110110110100100100000000001111110001001001011E-57"
#define OUT4 "101000.0001010111110011101101000101111111010001100011"
#define VAL5 "-0.10001111110110110100100100000000001111011111100001000E-57"
#define OUT5 "101000.00010101111100111011010001011111110100111000001"
#define VAL6 "-0.10001111110110110100100100000000001111011101100011001E-57"
#define OUT6 "101000.0001010111110011101101000101111111010011101111"
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, VAL1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT1);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p(x, y));
mpfr_set_str_binary (x, VAL2);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT2);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL3);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT3);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL4);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT4);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL5);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT5);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL6);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT6);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* further test from Kaveh Ghazi */
mpfr_set_str_binary (x, "-0.10011010101001010010001110010111010111011101010111001E-53");
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "100101.00111101101010000000101010111010001111001101111");
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* bug found by Kevin Rauch on 26 Oct 2007 */
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_set_emin (-1000000000);
mpfr_set_emax (1000000000);
mpfr_set_ui (x, 1, GMP_RNDN);
mpfr_lgamma (x, &sign, x, GMP_RNDN);
MPFR_ASSERTN(mpfr_get_emin () == -1000000000);
MPFR_ASSERTN(mpfr_get_emax () == 1000000000);
mpfr_set_emin (emin);
mpfr_set_emax (emax);
/* two other bugs reported by Kevin Rauch on 27 Oct 2007 */
mpfr_set_prec (x, 128);
mpfr_set_prec (y, 128);
mpfr_set_str_binary (x, "0.11000110011110111111110010100110000000000000000000000000000000000000000000000000000000000000000001000011000110100100110111101010E-765689");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "10000001100100101111011011010000111010001001110000111010011000101001011111011111110011011010110100101111110111001001010100011101E-108");
MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);
mpfr_set_prec (x, 128);
mpfr_set_prec (y, 256);
mpfr_set_str_binary (x, "0.1011111111111111100000111011111E-31871");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 256);
mpfr_set_str (x, "AC9729B83707E6797612D0D76DAF42B1240A677FF1B6E3783FD4E53037143B1P-237", 16, GMP_RNDN);
MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);
mpfr_clear (x);
mpfr_clear (y);
}
static void
test_round_near_x (void)
{
mpfr_t x, y, z, eps;
mpfr_exp_t e;
int failures = 0, mx, neg, err, dir, r, inex, inex2;
char buffer[7], *p;
mpfr_inits (x, y, z, eps, (mpfr_ptr) 0);
mpfr_set_prec (x, 5);
mpfr_set_prec (y, 3);
mpfr_set_prec (z, 3);
mpfr_set_prec (eps, 2);
mpfr_set_ui_2exp (eps, 1, -32, MPFR_RNDN);
for (mx = 16; mx < 32; mx++)
{
mpfr_set_ui_2exp (x, mx, -2, MPFR_RNDN);
for (p = buffer, neg = 0;
neg <= 1;
mpfr_neg (x, x, MPFR_RNDN), p++, neg++)
for (err = 2; err <= 6; err++)
for (dir = 0; dir <= 1; dir++)
RND_LOOP(r)
{
inex = mpfr_round_near_x (y, x, err, dir, (mpfr_rnd_t) r);
if (inex == 0 && err < 6)
{
/* The test is more restrictive than necessary.
So, no failure in this case. */
continue;
}
inex2 = ((dir ^ neg) ? mpfr_add : mpfr_sub)
(z, x, eps, (mpfr_rnd_t) r);
if (inex * inex2 <= 0)
printf ("Bad return value (%d instead of %d) for:\n",
inex, inex2);
else if (mpfr_equal_p (y, z))
continue; /* correct inex and y */
else
{
printf ("Bad MPFR value (should have got ");
mpfr_out_str (stdout, 2, 3, z, MPFR_RNDZ);
printf (") for:\n");
}
if (!mpfr_get_str (buffer, &e, 2, 5, x, MPFR_RNDZ) || e != 3)
{
printf ("mpfr_get_str failed in test_round_near_x\n");
exit (1);
}
printf ("x = %c%c%c%c.%c%c, ", neg ? '-' : '+',
p[0], p[1], p[2], p[3], p[4]);
printf ("err = %d, dir = %d, r = %s --> inex = %2d",
err, dir, mpfr_print_rnd_mode ((mpfr_rnd_t) r), inex);
if (inex != 0)
{
printf (", y = ");
mpfr_out_str (stdout, 2, 3, y, MPFR_RNDZ);
}
printf ("\n");
if (inex == 0)
printf ("Rounding was possible!\n");
if (++failures == 10) /* show at most 10 failures */
exit (1);
}
}
if (failures)
exit (1);
mpfr_clears (x, y, z, eps, (mpfr_ptr) 0);
}
static void
test_underflow1 (void)
{
mpfr_t x, y, z, r;
int inex, signy, signz, rnd, err = 0;
mpfr_inits2 (8, x, y, z, r, (mpfr_ptr) 0);
MPFR_SET_POS (x);
mpfr_setmin (x, mpfr_get_emin ()); /* x = 0.1@emin */
for (signy = -1; signy <= 1; signy += 2)
{
mpfr_set_si_2exp (y, signy, -1, GMP_RNDN); /* |y| = 1/2 */
for (signz = -3; signz <= 3; signz += 2)
{
RND_LOOP (rnd)
{
mpfr_set_si (z, signz, GMP_RNDN);
if (ABS (signz) != 1)
mpfr_setmax (z, mpfr_get_emax ());
/* |z| = 1 or 2^emax - ulp */
mpfr_clear_flags ();
inex = mpfr_fms (r, x, y, z, rnd);
#define ERRTU1 "Error in test_underflow1 (signy = %d, signz = %d, %s)\n "
if (mpfr_nanflag_p ())
{
printf (ERRTU1 "NaN flag is set\n", signy, signz,
mpfr_print_rnd_mode (rnd));
err = 1;
}
mpfr_neg (z, z, GMP_RNDN);
if (signy < 0 && (rnd == GMP_RNDD ||
(rnd == GMP_RNDZ && signz < 0)))
mpfr_nextbelow (z);
if (signy > 0 && (rnd == GMP_RNDU ||
(rnd == GMP_RNDZ && signz > 0)))
mpfr_nextabove (z);
if ((mpfr_overflow_p () != 0) ^ (mpfr_inf_p (z) != 0))
{
printf (ERRTU1 "wrong overflow flag\n", signy, signz,
mpfr_print_rnd_mode (rnd));
err = 1;
}
if (mpfr_underflow_p ())
{
printf (ERRTU1 "underflow flag is set\n", signy, signz,
mpfr_print_rnd_mode (rnd));
err = 1;
}
if (! mpfr_equal_p (r, z))
{
printf (ERRTU1 "got ", signy, signz,
mpfr_print_rnd_mode (rnd));
mpfr_print_binary (r);
printf (" instead of ");
mpfr_print_binary (z);
printf ("\n");
err = 1;
}
if (inex >= 0 && (rnd == GMP_RNDD ||
(rnd == GMP_RNDZ && signz < 0) ||
(rnd == GMP_RNDN && signy > 0)))
{
printf (ERRTU1 "ternary value = %d instead of < 0\n",
signy, signz, mpfr_print_rnd_mode (rnd), inex);
err = 1;
}
if (inex <= 0 && (rnd == GMP_RNDU ||
(rnd == GMP_RNDZ && signz > 0) ||
(rnd == GMP_RNDN && signy < 0)))
{
printf (ERRTU1 "ternary value = %d instead of > 0\n",
signy, signz, mpfr_print_rnd_mode (rnd), inex);
err = 1;
}
}
}
}
if (err)
exit (1);
mpfr_clears (x, y, z, r, (mpfr_ptr) 0);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z;
mpfr_prec_t prec, yprec;
mpfr_t t, s;
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n, err;
mpfr_prec_t p0=2, p1=100;
unsigned int N=25;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init2 (y,sizeof(unsigned long int)*CHAR_BIT);
mpfr_init (z);
mpfr_init (s);
mpfr_init (t);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (s, sizeof(unsigned long int)*CHAR_BIT);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (n=0; n<N; n++)
{
mpfr_urandomb (x, RANDS);
mpfr_urandomb (s, RANDS);
if (randlimb () % 2)
mpfr_neg (s, s, MPFR_RNDN);
rnd = RND_RAND ();
mpfr_set_prec (y, yprec);
compare = mpfr_pow (y, x, s, rnd);
err = (rnd == MPFR_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = mpfr_pow (z, x, s, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x^y with x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf (" y=");
mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN);
printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if ((rnd != MPFR_RNDN) && (compare * compare2 >= 0))
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (((inexact == 0) && (compare != 0)) ||
((inexact > 0) && (compare <= 0)) ||
((inexact < 0) && (compare >= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d"
"\n", mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("t="); mpfr_print_binary (t); puts ("");
exit (1);
}
}
}
}
mpfr_clear (s);
mpfr_clear (t);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
tests_end_mpfr ();
return 0;
}