int
main (void)
{
mpfr_t x;
mp_prec_t i, j;
tests_start_mpfr ();
/* checks that rounds to nearest sets the last
bit to zero in case of equal distance */
mpfr_init2 (x, 59);
mpfr_set_str_binary (x, "-0.10010001010111000011110010111010111110000000111101100111111E663");
if (mpfr_can_round (x, 54, GMP_RNDZ, GMP_RNDZ, 53) != 0)
{
printf ("Error (1) in mpfr_can_round\n");
exit (1);
}
mpfr_set_str_binary (x, "-Inf");
if (mpfr_can_round (x, 2000, GMP_RNDZ, GMP_RNDZ, 2000) != 0)
{
printf ("Error (2) in mpfr_can_round\n");
exit (1);
}
mpfr_set_prec (x, 64);
mpfr_set_str_binary (x, "0.1011001000011110000110000110001111101011000010001110011000000000");
if (mpfr_can_round (x, 65, GMP_RNDN, GMP_RNDN, 54))
{
printf ("Error (3) in mpfr_can_round\n");
exit (1);
}
mpfr_set_prec (x, 62);
mpfr_set_str (x, "0.ff4ca619c76ba69", 16, GMP_RNDZ);
for (i = 30; i < 99; i++)
for (j = 30; j < 99; j++)
{
int r1, r2;
for (r1 = 0; r1 < GMP_RND_MAX ; r1++)
for (r2 = 0; r2 < GMP_RND_MAX ; r2++)
mpfr_can_round (x, i, (mp_rnd_t) r1, (mp_rnd_t) r2, j); /* test for assertions */
}
mpfr_clear (x);
check_round_p ();
tests_end_mpfr ();
return 0;
}
/* the rounding mode is mpfr_rnd_t here since we return an mpfr number */
int
mpc_norm (mpfr_ptr a, mpc_srcptr b, mpfr_rnd_t rnd)
{
mpfr_t u, v;
mp_prec_t prec;
int inexact, overflow;
prec = MPFR_PREC(a);
/* handling of special values; consistent with abs in that
norm = abs^2; so norm (+-inf, nan) = norm (nan, +-inf) = +inf */
if ( (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
|| (mpfr_inf_p (MPC_RE (b)) || mpfr_inf_p (MPC_IM (b))))
return mpc_abs (a, b, rnd);
mpfr_init (u);
mpfr_init (v);
if (!mpfr_zero_p(MPC_RE(b)) && !mpfr_zero_p(MPC_IM(b)) &&
2 * SAFE_ABS (mp_exp_t, MPFR_EXP (MPC_RE (b)) - MPFR_EXP (MPC_IM (b)))
> (mp_exp_t)prec)
/* If real and imaginary part have very different magnitudes, then the */
/* generic code increases the precision too much. Instead, compute the */
/* squarings _exactly_. */
{
mpfr_set_prec (u, 2 * MPFR_PREC (MPC_RE (b)));
mpfr_set_prec (v, 2 * MPFR_PREC (MPC_IM (b)));
mpfr_sqr (u, MPC_RE (b), GMP_RNDN);
mpfr_sqr (v, MPC_IM (b), GMP_RNDN);
inexact = mpfr_add (a, u, v, rnd);
}
else
{
do
{
prec += mpc_ceil_log2 (prec) + 3;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
inexact = mpfr_sqr (u, MPC_RE(b), GMP_RNDN); /* err<=1/2ulp */
inexact |= mpfr_sqr (v, MPC_IM(b), GMP_RNDN); /* err<=1/2ulp*/
inexact |= mpfr_add (u, u, v, GMP_RNDN); /* err <= 3/2 ulps */
overflow = mpfr_inf_p (u);
}
while (!overflow && inexact &&
mpfr_can_round (u, prec - 2, GMP_RNDN, rnd, MPFR_PREC(a)) == 0);
inexact |= mpfr_set (a, u, rnd);
}
mpfr_clear (u);
mpfr_clear (v);
return inexact;
}
void
check_inexact (mp_prec_t p)
{
mpfr_t x, y, z, t;
unsigned long u;
mp_prec_t q;
int inexact, cmp;
mp_rnd_t rnd;
mpfr_init2 (x, p);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_random (x);
u = LONG_RAND() % 2;
for (q=2; q<=p; q++)
for (rnd=0; rnd<4; rnd++)
{
mpfr_set_prec (y, q);
mpfr_set_prec (z, q + 10);
mpfr_set_prec (t, q);
inexact = mpfr_pow_ui (y, x, u, rnd);
cmp = mpfr_pow_ui (z, x, u, rnd);
if (mpfr_can_round (z, q + 10, rnd, rnd, q))
{
cmp = mpfr_set (t, z, rnd) || cmp;
if (mpfr_cmp (y, t))
{
fprintf (stderr, "results differ for u=%lu rnd=%s\n", u,
mpfr_print_rnd_mode(rnd));
printf ("x="); mpfr_print_binary (x); putchar ('\n');
printf ("y="); mpfr_print_binary (y); putchar ('\n');
printf ("t="); mpfr_print_binary (t); putchar ('\n');
printf ("z="); mpfr_print_binary (z); putchar ('\n');
exit (1);
}
if (((inexact == 0) && (cmp != 0)) ||
((inexact != 0) && (cmp == 0)))
{
fprintf (stderr, "Wrong inexact flag for p=%u, q=%u, rnd=%s\n",
(unsigned) p, (unsigned) q, mpfr_print_rnd_mode (rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("u=%lu x=", u); mpfr_print_binary (x); putchar ('\n');
printf ("y="); mpfr_print_binary (y); putchar ('\n');
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
static void
check (mp_prec_t p0, mp_prec_t p1)
{
mpfr_t x, y, z;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, GMP_RNDN);
mpfr_clear_cache (__gmpfr_cache_const_log2);
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
{
rnd = (mp_rnd_t) RND_RAND ();
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if (mpfr_cmp (x, y) && mpfr_can_round (z, mpfr_get_prec(z), GMP_RNDN,
rnd, p0))
{
printf ("mpfr_const_log2 fails for prec=%u, rnd=%s\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd));
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, GMP_RNDN);
printf ("\ngot ");
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
void
check (mp_prec_t p0, mp_prec_t p1)
{
mpfr_t x, y, z;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, GMP_RNDN);
__mpfr_const_log2_prec = 1;
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
for (rnd = 0; rnd < 4; rnd++)
{
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if (mpfr_cmp (x, y) && mpfr_can_round (z, mpfr_get_prec(z), GMP_RNDN,
rnd, p0))
{
fprintf (stderr, "mpfr_const_log2 fails for prec=%u, rnd=%s\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd));
fprintf (stderr, "expected ");
mpfr_out_str (stderr, 2, 0, y, GMP_RNDN);
fprintf (stderr, "\ngot ");
mpfr_out_str (stderr, 2, 0, x, GMP_RNDN);
fprintf (stderr, "\n");
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
static void
check (mpfr_prec_t p0, mpfr_prec_t p1)
{
mpfr_t x, y, z;
mpfr_rnd_t rnd;
int dif;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, MPFR_RNDN);
mpfr_clear_cache (__gmpfr_cache_const_log2);
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
{
rnd = RND_RAND ();
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if ((dif = mpfr_cmp (x, y))
&& mpfr_can_round (z, mpfr_get_prec(z), MPFR_RNDN,
rnd, p0))
{
printf ("mpfr_const_log2 fails for prec=%u, rnd=%s Diff=%d\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd), dif);
printf ("expected "), mpfr_dump (y);
printf ("got "), mpfr_dump (x);
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact
ie, iff x = 0 */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mp_prec_t prec, m;
int neg, reduce;
mpfr_t c, xr;
mpfr_srcptr xx;
mp_exp_t err, expx;
MPFR_ZIV_DECL (loop);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN (y);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
/* y = 0, thus exact, but z is inexact in case of underflow
or overflow */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("sin[%#R]=%R cos[%#R]=%R", y, y, z, z));
prec = MAX (MPFR_PREC (y), MPFR_PREC (z));
m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* the following is copied from sin.c */
if (expx >= 2) /* reduce the argument */
{
reduce = 1;
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN);
mpfr_remainder (xr, x, c, GMP_RNDN);
mpfr_div_2ui (c, c, 1, GMP_RNDN);
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, GMP_RNDZ);
else
mpfr_add (c, c, xr, GMP_RNDZ);
if (MPFR_IS_ZERO(xr) || MPFR_EXP(xr) < (mp_exp_t) 3 - (mp_exp_t) m
|| MPFR_EXP(c) < (mp_exp_t) 3 - (mp_exp_t) m)
goto next_step;
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
neg = MPFR_IS_NEG (xx); /* gives sign of sin(x) */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, GMP_RNDZ);
/* If no argument reduction was performed, the error is at most ulp(c),
otherwise it is at most ulp(c) + 2^(2-m). Since |c| < 1, we have
ulp(c) <= 2^(-m), thus the error is bounded by 2^(3-m) in that later
case. */
if (reduce == 0)
err = m;
else
err = MPFR_GET_EXP (c) + (mp_exp_t) (m - 3);
if (!mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (z) + (rnd_mode == GMP_RNDN)))
goto next_step;
mpfr_set (z, c, rnd_mode);
mpfr_sqr (c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
err = 2 + (- MPFR_GET_EXP (c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
MPFR_CHANGE_SIGN (c);
/* the absolute error on c is at most 2^(err-m), which we must put
in the form 2^(EXP(c)-err). If there was an argument reduction,
we need to add 2^(2-m); since err >= 2, the error is bounded by
2^(err+1-m) in that case. */
err = MPFR_GET_EXP (c) + (mp_exp_t) m - (err + reduce);
if (mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (y) + (rnd_mode == GMP_RNDN)))
break;
/* check for huge cancellation */
if (err < (mp_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1
&& MPFR_MANT (c)[MPFR_LIMB_SIZE (c)-1] == MPFR_LIMB_HIGHBIT)
m += m;
next_step:
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (c, m);
}
MPFR_ZIV_FREE (loop);
mpfr_set (y, c, rnd_mode);
mpfr_clear (c);
mpfr_clear (xr);
MPFR_RET (1); /* Always inexact */
}
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd_mode)
{
if (n > 0)
return mpfr_pow_ui(y, x, n, rnd_mode);
else
{
int inexact = 0;
if (MPFR_IS_NAN(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
MPFR_CLEAR_NAN(y);
if (n == 0)
return mpfr_set_ui(y, 1, GMP_RNDN);
if (MPFR_IS_INF(x))
{
MPFR_SET_ZERO(y);
if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0)
MPFR_SET_POS(y);
else
MPFR_SET_NEG(y);
MPFR_RET(0);
}
if (MPFR_IS_ZERO(x))
{
MPFR_SET_INF(y);
if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0)
MPFR_SET_POS(y);
else
MPFR_SET_NEG(y);
MPFR_RET(0);
}
MPFR_CLEAR_INF(y);
n = -n;
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, ti;
/* Declaration of the size variable */
mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */
mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
/* compute the precision of intermediary variable */
Nt=MAX(Nx,Ny);
/* the optimal number of bits : see algorithms.ps */
Nt=Nt+3+_mpfr_ceil_log2(Nt);
/* initialise of intermediary variable */
mpfr_init(t);
mpfr_init(ti);
do {
/* reactualisation of the precision */
mpfr_set_prec(t,Nt);
mpfr_set_prec(ti,Nt);
/* compute 1/(x^n) n>0*/
mpfr_pow_ui(ti,x,(unsigned long int)(n),GMP_RNDN);
mpfr_ui_div(t,1,ti,GMP_RNDN);
/* estimation of the error -- see pow function in algorithms.ps*/
err = Nt - 3;
/* actualisation of the precision */
Nt += 10;
} while (err<0 || !mpfr_can_round(t,err,GMP_RNDN,rnd_mode,Ny));
inexact = mpfr_set(y,t,rnd_mode);
mpfr_clear(t);
mpfr_clear(ti);
}
return inexact;
}
}
int
mpfr_fac_ui (mpfr_ptr y, unsigned long int x , mp_rnd_t rnd_mode)
{
/****** Declaration ******/
mpfr_t t; /* Variable of Intermediary Calculation*/
int i;
int round, inexact = 0;
int boucle = 1;
mp_prec_t Ny; /* Precision of output variable */
mp_prec_t Nt; /* Precision of Intermediary Calculation variable */
mp_prec_t err; /* Precision of error */
/***** test x = 0 ******/
if (x == 0)
{
mpfr_set_ui (y, 1, GMP_RNDN); /* 0! = 1 */
return 0;
}
else
{
/* Initialisation of the Precision */
Ny=MPFR_PREC(y);
Nt=Ny+2*(int)_mpfr_ceil_log2((double)x)+10; /*compute the size of intermediary variable */
mpfr_init2(t, Nt);/* initialise of intermediary variable */
while (boucle)
{
inexact = mpfr_set_ui (t, 1, GMP_RNDZ);
for(i=2;i<=x;i++) /* compute factorial */
{
round = mpfr_mul_ui (t, t, i, GMP_RNDZ);
/* assume the first inexact product gives the sign
of difference: is that always correct? */
if (inexact == 0)
inexact = round;
}
err = Nt - 1 - (int) _mpfr_ceil_log2 ((double) Nt);
round = !inexact || mpfr_can_round (t,err,GMP_RNDZ,rnd_mode,Ny);
if (round)
{
round = mpfr_set (y, t, rnd_mode);
if (inexact == 0)
inexact = round;
boucle=0;
}
else
{
Nt=Nt+10;
/*initialise of intermediary variable */
mpfr_set_prec(t, Nt);
}
}
mpfr_clear(t);
return inexact;
}
}
/* Put in z the value of x^y, rounded according to 'rnd'.
Return the inexact flag in [0, 10]. */
int
mpc_pow (mpc_ptr z, mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
{
int ret = -2, loop, x_real, x_imag, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mpfr_prec_t p, pr, pi, maxprec;
int saved_underflow, saved_overflow;
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
x_real = mpfr_zero_p (mpc_imagref(x));
y_real = mpfr_zero_p (mpc_imagref(y));
if (y_real && mpfr_zero_p (mpc_realref(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (mpc_realref(x)))
{
/* we define 0^0 to be (1, +0) since the real part is
coherent with MPFR where 0^0 gives 1, and the sign of the
imaginary part cannot be determined */
mpc_set_ui_ui (z, 1, 0, MPC_RNDNN);
return 0;
}
else /* x^0 = 1 +/- i*0 even for x=NaN see algorithms.tex for the
sign of zero */
{
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (mpc_imagref (x)) != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* warning: mpc_set_ui_ui does not set Im(z) to -0 if Im(rnd)=RNDD */
ret = mpc_set_ui_ui (z, 1, 0, rnd);
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (!mpc_fin_p (x) || !mpc_fin_p (y))
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
if (x_real) /* case x real */
{
if (mpfr_zero_p (mpc_realref(x))) /* x is zero */
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
/* Special case 1^y = 1 */
if (mpfr_cmp_ui (mpc_realref(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpc_set_ui (z, +1, rnd);
/* the sign of the zero imaginary part is known in some cases (see
algorithm.tex). In such cases we have
(x +s*0i)^(y+/-0i) = x^y + s*sign(y)*0i
where s = +/-1. We extend here this rule to fix the sign of the
zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM (rnd) == MPFR_RNDD || s1 != s2)
mpc_conj (z, z, MPC_RNDNN);
goto end;
}
/* x^y is real when:
(a) x is real and y is integer
(b) x is real non-negative and y is real */
if (y_real && (mpfr_integer_p (mpc_realref(y)) ||
mpfr_cmp_ui (mpc_realref(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpfr_pow (mpc_realref(z), mpc_realref(x), mpc_realref(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (mpc_imagref(z), 0, MPC_RND_IM(rnd)));
/* the sign of the zero imaginary part is known in some cases
(see algorithm.tex). In such cases we have (x +s*0i)^(y+/-0i)
= x^y + s*sign(y)*0i where s = +/-1.
We extend here this rule to fix the sign of the zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM(rnd) == MPFR_RNDD || s1 != s2)
mpfr_neg (mpc_imagref(z), mpc_imagref(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (mpc_realref(x), -1) == 0 && mpfr_integer_p (mpc_realref(y)))
z_real = 1;
/* for x real, x^y is imaginary when:
(a) x is negative and y is half-an-integer
(b) x = -1 and Re(y) is half-an-integer
*/
if ((mpfr_cmp_ui (mpc_realref(x), 0) < 0) && is_odd (mpc_realref(y), 1)
&& (y_real || mpfr_cmp_si (mpc_realref(x), -1) == 0))
z_imag = 1;
}
else /* x non real */
/* I^(t*I) and (-I)^(t*I) are real for t real,
I^(n+t*I) and (-I)^(n+t*I) are real for n even and t real, and
I^(n+t*I) and (-I)^(n+t*I) are imaginary for n odd and t real
(s*I)^n is real for n even and imaginary for n odd */
if ((mpc_cmp_si_si (x, 0, 1) == 0 || mpc_cmp_si_si (x, 0, -1) == 0 ||
(mpfr_cmp_ui (mpc_realref(x), 0) == 0 && y_real)) &&
mpfr_integer_p (mpc_realref(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (mpc_realref(y), 0))
z_imag = 1; /* Re(y) odd: z is imaginary */
else
z_real = 1; /* Re(y) even: z is real */
}
else /* (t+/-t*I)^(2n) is imaginary for n odd and real for n even */
if (mpfr_cmpabs (mpc_realref(x), mpc_imagref(x)) == 0 && y_real &&
mpfr_integer_p (mpc_realref(y)) && is_odd (mpc_realref(y), 0) == 0)
{
if (is_odd (mpc_realref(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
pr = mpfr_get_prec (mpc_realref(z));
pi = mpfr_get_prec (mpc_imagref(z));
p = (pr > pi) ? pr : pi;
p += 12; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy; probably wrong now since q is not computed */
if (p < 64)
p = 64;
mpc_init2 (u, p);
mpc_init2 (t, p);
pr += MPC_RND_RE(rnd) == MPFR_RNDN;
pi += MPC_RND_IM(rnd) == MPFR_RNDN;
maxprec = MPC_MAX_PREC (z);
x_imag = mpfr_zero_p (mpc_realref(x));
for (loop = 0;; loop++)
{
int ret_exp;
mpfr_exp_t dr, di;
mpfr_prec_t q;
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* Compute q such that |Re (y log x)|, |Im (y log x)| < 2^q.
We recompute it at each loop since we might get different
bounds if the precision is not enough. */
q = mpfr_get_exp (mpc_realref(t)) > 0 ? mpfr_get_exp (mpc_realref(t)) : 0;
if (mpfr_get_exp (mpc_imagref(t)) > (mpfr_exp_t) q)
q = mpfr_get_exp (mpc_imagref(t));
mpfr_clear_overflow ();
mpfr_clear_underflow ();
ret_exp = mpc_exp (u, t, MPC_RNDNN);
if (mpfr_underflow_p () || mpfr_overflow_p ()) {
/* under- and overflow flags are set by mpc_exp */
mpc_set (z, u, MPC_RNDNN);
ret = ret_exp;
goto exact;
}
/* Since the error bound is global, we have to take into account the
exponent difference between the real and imaginary parts. We assume
either the real or the imaginary part of u is not zero.
*/
dr = mpfr_zero_p (mpc_realref(u)) ? mpfr_get_exp (mpc_imagref(u))
: mpfr_get_exp (mpc_realref(u));
di = mpfr_zero_p (mpc_imagref(u)) ? dr : mpfr_get_exp (mpc_imagref(u));
if (dr > di)
{
di = dr - di;
dr = 0;
}
else
{
dr = di - dr;
di = 0;
}
/* the term -3 takes into account the factor 4 in the complex error
(see algorithms.tex) plus one due to the exponent difference: if
z = a + I*b, where the relative error on z is at most 2^(-p), and
EXP(a) = EXP(b) + k, the relative error on b is at most 2^(k-p) */
if ((z_imag || (p > q + 3 + dr && mpfr_can_round (mpc_realref(u), p - q - 3 - dr, MPFR_RNDN, MPFR_RNDZ, pr))) &&
(z_real || (p > q + 3 + di && mpfr_can_round (mpc_imagref(u), p - q - 3 - di, MPFR_RNDN, MPFR_RNDZ, pi))))
break;
/* if Re(u) is not known to be zero, assume it is a normal number, i.e.,
neither zero, Inf or NaN, otherwise we might enter an infinite loop */
MPC_ASSERT (z_imag || mpfr_number_p (mpc_realref(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (mpc_imagref(u)));
if (ret == -2) /* we did not yet call mpc_pow_exact, or it aborted
because intermediate computations had > maxprec bits */
{
/* check exact cases (see algorithms.tex) */
if (y_real)
{
maxprec *= 2;
ret = mpc_pow_exact (z, x, mpc_realref(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p);
mpc_set_prec (u, p);
}
if (z_real)
{
/* When the result is real (see algorithm.tex for details),
Im(x^y) =
+ sign(imag(y))*0i, if |x| > 1
+ sign(imag(x))*sign(real(y))*0i, if |x| = 1
- sign(imag(y))*0i, if |x| < 1
*/
mpfr_t n;
int inex, cx1;
int sign_zi, sign_rex, sign_imx;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
sign_rex = mpfr_signbit (mpc_realref (x));
sign_imx = mpfr_signbit (mpc_imagref (x));
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0 && sign_imx != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* copy RE(y) to n since if z==y we will destroy Re(y) below */
mpfr_set_prec (n, mpfr_get_prec (mpc_realref (y)));
mpfr_set (n, mpc_realref (y), MPFR_RNDN);
ret = mpfr_set (mpc_realref(z), mpc_realref(u), MPC_RND_RE(rnd));
if (y_real && (x_real || x_imag))
{
/* FIXME: with y_real we assume Im(y) is really 0, which is the case
for example when y comes from pow_fr, but in case Im(y) is +0 or
-0, we might get different results */
mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd));
fix_sign (z, sign_rex, sign_imx, n);
ret = MPC_INEX(ret, 0); /* imaginary part is exact */
}
else
{
ret = MPC_INEX (ret, mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd)));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
}
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (mpc_imagref(z), mpc_imagref(u), MPC_RND_IM(rnd));
/* if z is imaginary and y real, then x cannot be real */
if (y_real && x_imag)
{
int sign_rex = mpfr_signbit (mpc_realref (x));
/* If z overlaps with y we set Re(z) before checking Re(y) below,
but in that case y=0, which was dealt with above. */
mpfr_set_ui (mpc_realref (z), 0, MPC_RND_RE (rnd));
/* Note: fix_sign only does something when y is an integer,
then necessarily y = 1 or 3 (mod 4), and in that case the
sign of Im(x) is irrelevant. */
fix_sign (z, sign_rex, 0, mpc_realref (y));
ret = MPC_INEX(0, ret);
}
else
ret = MPC_INEX(mpfr_set_ui (mpc_realref(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
end:
return ret;
}
int
mpc_log10 (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok = 0, loops = 0, check_exact = 0, special_re, special_im,
inex, inex_re, inex_im;
mpfr_prec_t prec;
mpfr_t log10;
mpc_t log;
mpfr_init2 (log10, 2);
mpc_init2 (log, 2);
prec = MPC_MAX_PREC (rop);
/* compute log(op)/log(10) */
while (ok == 0) {
loops ++;
prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
mpfr_set_prec (log10, prec);
mpc_set_prec (log, prec);
inex = mpc_log (log, op, rnd); /* error <= 1 ulp */
if (!mpfr_number_p (mpc_imagref (log))
|| mpfr_zero_p (mpc_imagref (log))) {
/* no need to divide by log(10) */
special_im = 1;
ok = 1;
}
else {
special_im = 0;
mpfr_const_log10 (log10);
mpfr_div (mpc_imagref (log), mpc_imagref (log), log10, MPFR_RNDN);
ok = mpfr_can_round (mpc_imagref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM (rnd) == MPFR_RNDN));
}
if (ok) {
if (!mpfr_number_p (mpc_realref (log))
|| mpfr_zero_p (mpc_realref (log)))
special_re = 1;
else {
special_re = 0;
if (special_im)
/* log10 not yet computed */
mpfr_const_log10 (log10);
mpfr_div (mpc_realref (log), mpc_realref (log), log10, MPFR_RNDN);
/* error <= 24/7 ulp < 4 ulp for prec >= 4, see algorithms.tex */
ok = mpfr_can_round (mpc_realref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
}
/* Special code to deal with cases where the real part of log10(x+i*y)
is exact, like x=3 and y=1. Since Re(log10(x+i*y)) = log10(x^2+y^2)/2
this happens whenever x^2+y^2 is a nonnegative power of 10.
Indeed x^2+y^2 cannot equal 10^(a/2^b) for a, b integers, a odd, b>0,
since x^2+y^2 is rational, and 10^(a/2^b) is irrational.
Similarly, for b=0, x^2+y^2 cannot equal 10^a for a < 0 since x^2+y^2
is a rational with denominator a power of 2.
Now let x^2+y^2 = 10^s. Without loss of generality we can assume
x = u/2^e and y = v/2^e with u, v, e integers: u^2+v^2 = 10^s*2^(2e)
thus u^2+v^2 = 0 mod 2^(2e). By recurrence on e, necessarily
u = v = 0 mod 2^e, thus x and y are necessarily integers.
*/
if (!ok && !check_exact && mpfr_integer_p (mpc_realref (op)) &&
mpfr_integer_p (mpc_imagref (op))) {
mpz_t x, y;
unsigned long s, v;
check_exact = 1;
mpz_init (x);
mpz_init (y);
mpfr_get_z (x, mpc_realref (op), MPFR_RNDN); /* exact */
mpfr_get_z (y, mpc_imagref (op), MPFR_RNDN); /* exact */
mpz_mul (x, x, x);
mpz_mul (y, y, y);
mpz_add (x, x, y); /* x^2+y^2 */
v = mpz_scan1 (x, 0);
/* if x = 10^s then necessarily s = v */
s = mpz_sizeinbase (x, 10);
/* since s is either the number of digits of x or one more,
then x = 10^(s-1) or 10^(s-2) */
if (s == v + 1 || s == v + 2) {
mpz_div_2exp (x, x, v);
mpz_ui_pow_ui (y, 5, v);
if (mpz_cmp (y, x) == 0) {
/* Re(log10(x+i*y)) is exactly v/2
we reset the precision of Re(log) so that v can be
represented exactly */
mpfr_set_prec (mpc_realref (log),
sizeof(unsigned long)*CHAR_BIT);
mpfr_set_ui_2exp (mpc_realref (log), v, -1, MPFR_RNDN);
/* exact */
ok = 1;
}
}
mpz_clear (x);
mpz_clear (y);
}
}
}
inex_re = mpfr_set (mpc_realref(rop), mpc_realref (log), MPC_RND_RE (rnd));
if (special_re)
inex_re = MPC_INEX_RE (inex);
/* recover flag from call to mpc_log above */
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref (log), MPC_RND_IM (rnd));
if (special_im)
inex_im = MPC_INEX_IM (inex);
mpfr_clear (log10);
mpc_clear (log);
return MPC_INEX(inex_re, inex_im);
}
int
main (int argc, char *argv[])
{
#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
unsigned int prec, yprec;
int rnd;
mpfr_t x, y, z, t;
int inexact;
unsigned long n;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
if (argc >= 3) /* tzeta_ui n prec [rnd] */
{
mpfr_set_prec (x, atoi (argv[2]));
mpfr_zeta_ui (x, atoi (argv[1]),
argc > 3 ? (mp_rnd_t) atoi (argv[3]) : GMP_RNDN);
mpfr_out_str (stdout, 10, 0, x, GMP_RNDN);
printf ("\n");
goto clear_and_exit;
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 33);
mpfr_zeta_ui (x, 3, GMP_RNDZ);
mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1");
if (mpfr_cmp (x, y))
{
printf ("Error for zeta(3), prec=33, GMP_RNDZ\n");
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (x);
exit (1);
}
for (prec = MPFR_PREC_MIN; prec <= 100; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
for (n = 0; n < 50; n++)
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
inexact = mpfr_zeta_ui (y, n, GMP_RNDN);
if (mpfr_can_round (y, yprec, GMP_RNDN, GMP_RNDZ, prec
+ (rnd == GMP_RNDN)))
{
mpfr_set (t, y, (mp_rnd_t) rnd);
inexact = mpfr_zeta_ui (z, n, (mp_rnd_t) rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for n=%lu", n);
printf (" prec=%u rnd_mode=%s\n", prec,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf (" got ");
mpfr_dump (z);
printf (" expected ");
mpfr_dump (t);
printf (" approx ");
mpfr_dump (y);
exit (1);
}
}
}
}
clear_and_exit:
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
tests_end_mpfr ();
#endif
return 0;
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int K0, K, precy, m, k, l, inexact;
mpfr_t r, s;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
mpfr_set_ui (y, 1, GMP_RNDN);
return 0;
}
precy = MPFR_PREC(y);
K0 = _mpfr_isqrt(precy / 2);
/* we need at least K + log2(precy/K) extra bits */
m = precy + 3 * K0 + 3;
mpfr_init2 (r, m);
mpfr_init2 (s, m);
do
{
mpfr_mul (r, x, x, GMP_RNDU); /* err <= 1 ulp */
/* we need that |r| < 1 for mpfr_cos2_aux, i.e. up(x^2)/2^(2K) < 1 */
K = K0 + MAX(MPFR_EXP(r), 0);
mpfr_div_2ui (r, r, 2 * K, GMP_RNDN); /* r = (x/2^K)^2, err <= 1 ulp */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
for (k = 0; k < K; k++)
{
mpfr_mul (s, s, s, GMP_RNDU); /* err <= 2*olderr */
mpfr_mul_2ui (s, s, 1, GMP_RNDU); /* err <= 4*olderr */
mpfr_sub_ui (s, s, 1, GMP_RNDN);
}
/* absolute error on s is bounded by (2l+1/3)*2^(2K-m) */
for (k = 2 * K, l = 2 * l + 1; l > 1; k++, l = (l + 1) >> 1);
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
l = mpfr_can_round (s, MPFR_EXP(s) + m - k, GMP_RNDN, rnd_mode, precy);
if (l == 0)
{
m += BITS_PER_MP_LIMB;
mpfr_set_prec (r, m);
mpfr_set_prec (s, m);
}
}
while (l == 0);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
return inexact;
}
static void
check_inexact (mp_prec_t p)
{
mpfr_t x, y, z, t;
unsigned long u;
mp_prec_t q;
int inexact, cmp;
int rnd;
mpfr_init2 (x, p);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_random (x);
u = randlimb () % 2;
for (q = 2; q <= p; q++)
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
mpfr_set_prec (y, q);
mpfr_set_prec (z, q + 10);
mpfr_set_prec (t, q);
inexact = mpfr_pow_ui (y, x, u, (mp_rnd_t) rnd);
cmp = mpfr_pow_ui (z, x, u, (mp_rnd_t) rnd);
if (mpfr_can_round (z, q + 10, (mp_rnd_t) rnd, (mp_rnd_t) rnd, q))
{
cmp = mpfr_set (t, z, (mp_rnd_t) rnd) || cmp;
if (mpfr_cmp (y, t))
{
printf ("results differ for u=%lu rnd=%s\n",
u, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf ("x=");
mpfr_print_binary (x);
puts ("");
printf ("y=");
mpfr_print_binary (y);
puts ("");
printf ("t=");
mpfr_print_binary (t);
puts ("");
printf ("z=");
mpfr_print_binary (z);
puts ("");
exit (1);
}
if (((inexact == 0) && (cmp != 0)) ||
((inexact != 0) && (cmp == 0)))
{
printf ("Wrong inexact flag for p=%u, q=%u, rnd=%s\n",
(unsigned int) p, (unsigned int) q,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("u=%lu x=", u);
mpfr_print_binary (x);
puts ("");
printf ("y=");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
}
/* check exact power */
mpfr_set_prec (x, p);
mpfr_set_prec (y, p);
mpfr_set_prec (z, p);
mpfr_set_ui (x, 4, GMP_RNDN);
mpfr_set_str (y, "0.5", 10, GMP_RNDN);
test_pow (z, x, y, GMP_RNDZ);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
int
main (int argc, char *argv[])
{
mpfr_t gamma, y, z, t;
unsigned int err, prec, yprec, p0 = 2, p1 = 200;
int rnd;
tests_start_mpfr ();
prec = (argc < 2) ? 53 : atoi(argv[1]);
if (argc > 1)
{
mpfr_init2 (gamma, prec);
mpfr_const_euler (gamma, GMP_RNDN);
printf("gamma="); mpfr_out_str (stdout, 10, 0, gamma, GMP_RNDD);
puts ("");
mpfr_clear (gamma);
return 0;
}
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_set_prec (y, 32);
mpfr_set_prec (z, 32);
mpfr_const_euler (y, GMP_RNDN);
mpfr_set_str_binary (z, "0.10010011110001000110011111100011");
if (mpfr_cmp (y, z))
{
printf ("Error for prec=32\n");
exit (1);
}
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
mpfr_set_prec (y, yprec);
mpfr_const_euler (y, (mp_rnd_t) rnd);
err = (rnd == GMP_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, (mp_rnd_t) rnd, (mp_rnd_t) rnd, prec))
{
mpfr_set (t, y, (mp_rnd_t) rnd);
mpfr_const_euler (z, (mp_rnd_t) rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for prec=%u rnd_mode=%s\n", prec,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf (" got ");
mpfr_out_str (stdout, 2, prec, z, GMP_RNDN);
puts ("");
printf (" expected ");
mpfr_out_str (stdout, 2, prec, t, GMP_RNDN);
puts ("");
printf (" approximation was ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
}
}
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
tests_end_mpfr ();
return 0;
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int prec, m, ok, e, inexact, neg;
mpfr_t c, k;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_SET_NAN(z);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
MPFR_CLEAR_FLAGS(y);
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y, x);
mpfr_set_ui (z, 1, GMP_RNDN);
MPFR_RET(0);
}
prec = MAX(MPFR_PREC(y), MPFR_PREC(z));
m = prec + _mpfr_ceil_log2 ((double) prec) + ABS(MPFR_EXP(x)) + 13;
mpfr_init2 (c, m);
mpfr_init2 (k, m);
/* first determine sign */
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN); /* 2*Pi */
mpfr_div (k, x, c, GMP_RNDN); /* x/(2*Pi) */
mpfr_floor (k, k); /* floor(x/(2*Pi)) */
mpfr_mul (c, k, c, GMP_RNDN);
mpfr_sub (k, x, c, GMP_RNDN); /* 0 <= k < 2*Pi */
mpfr_const_pi (c, GMP_RNDN); /* cached */
neg = mpfr_cmp (k, c) > 0;
mpfr_clear (k);
do
{
mpfr_cos (c, x, GMP_RNDZ);
if ((ok = mpfr_can_round (c, m, GMP_RNDZ, rnd_mode, MPFR_PREC(z))))
{
inexact = mpfr_set (z, c, rnd_mode);
mpfr_mul (c, c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
e = 2 + (-MPFR_EXP(c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
mpfr_neg (c, c, GMP_RNDN);
/* the absolute error on c is at most 2^(e-m) = 2^(EXP(c)-err) */
e = MPFR_EXP(c) + m - e;
ok = (e >= 0) && mpfr_can_round (c, e, GMP_RNDN, rnd_mode,
MPFR_PREC(y));
}
if (ok == 0)
{
m += _mpfr_ceil_log2 ((double) m);
mpfr_set_prec (c, m);
}
}
while (ok == 0);
inexact = mpfr_set (y, c, rnd_mode) || inexact;
mpfr_clear (c);
return inexact; /* inexact */
}
static void
test_genericq (mpfr_prec_t p0, mpfr_prec_t p1, unsigned int N,
int (*func)(mpfr_ptr, mpfr_srcptr, mpq_srcptr, mpfr_rnd_t),
const char *op)
{
mpfr_prec_t prec;
mpfr_t arg1, dst_big, dst_small, tmp;
mpq_t arg2;
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n;
mpfr_inits (arg1, dst_big, dst_small, tmp, (mpfr_ptr) 0);
mpq_init (arg2);
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (arg1, prec);
mpfr_set_prec (tmp, prec);
mpfr_set_prec (dst_small, prec);
for (n=0; n<N; n++)
{
mpfr_urandomb (arg1, RANDS);
mpq_set_ui (arg2, randlimb (), randlimb() );
mpq_canonicalize (arg2);
rnd = RND_RAND ();
mpfr_set_prec (dst_big, prec+10);
compare = func(dst_big, arg1, arg2, rnd);
if (mpfr_can_round (dst_big, prec+10, rnd, rnd, prec))
{
mpfr_set (tmp, dst_big, rnd);
inexact = func(dst_small, arg1, arg2, rnd);
if (mpfr_cmp (tmp, dst_small))
{
printf ("Results differ for prec=%u rnd_mode=%s and %s_q:\n"
"arg1=",
(unsigned) prec, mpfr_print_rnd_mode (rnd), op);
mpfr_print_binary (arg1);
printf("\narg2=");
mpq_out_str(stdout, 2, arg2);
printf ("\ngot ");
mpfr_print_binary (dst_small);
printf ("\nexpected ");
mpfr_print_binary (tmp);
printf ("\napprox ");
mpfr_print_binary (dst_big);
putchar('\n');
exit (1);
}
compare2 = mpfr_cmp (tmp, dst_big);
/* 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 (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 and %s_q:\n"
"expected %d, got %d",
mpfr_print_rnd_mode (rnd), op, compare, inexact);
printf ("\narg1="); mpfr_print_binary (arg1);
printf ("\narg2="); mpq_out_str(stdout, 2, arg2);
printf ("\ndstl="); mpfr_print_binary (dst_big);
printf ("\ndsts="); mpfr_print_binary (dst_small);
printf ("\ntmp ="); mpfr_print_binary (tmp);
putchar('\n');
exit (1);
}
}
}
}
mpq_clear (arg2);
mpfr_clears (arg1, dst_big, dst_small, tmp, (mpfr_ptr) 0);
}
static void
test_generic_ui (mpfr_prec_t p0, mpfr_prec_t p1, unsigned int N)
{
mpfr_prec_t prec, yprec;
mpfr_t x, y, z, t;
INTEGER_TYPE u;
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (n = 0; n <= N; n++)
{
if (n > 1 || prec < p1)
RAND_FUNCTION (x);
else
{
/* Special cases tested in precision p1 if n <= 1. */
mpfr_set_si (x, n == 0 ? 1 : -1, MPFR_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
}
u = INT_RAND_FUNCTION ();
rnd = RND_RAND ();
mpfr_set_prec (y, yprec);
compare = TEST_FUNCTION (y, x, u, rnd);
if (mpfr_can_round (y, yprec, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = TEST_FUNCTION (z, x, u, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf ("\nu=%lu", (unsigned long) u);
printf (" prec=%lu rnd_mode=%s\n",
(unsigned long ) prec, mpfr_print_rnd_mode (rnd));
#ifdef TEST_FUNCTION_NAME
printf ("Function: %s\n", TEST_FUNCTION_NAME);
#endif
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 (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 ("u=%lu", (unsigned long) u);
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("t="); mpfr_print_binary (t); puts ("");
exit (1);
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
int
mpfr_fac_ui (mpfr_ptr y, unsigned long int x, mpfr_rnd_t rnd_mode)
{
mpfr_t t; /* Variable of Intermediary Calculation*/
unsigned long i;
int round, inexact;
mpfr_prec_t Ny; /* Precision of output variable */
mpfr_prec_t Nt; /* Precision of Intermediary Calculation variable */
mpfr_prec_t err; /* Precision of error */
mpfr_rnd_t rnd;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
/***** test x = 0 and x == 1******/
if (MPFR_UNLIKELY (x <= 1))
return mpfr_set_ui (y, 1, rnd_mode); /* 0! = 1 and 1! = 1 */
MPFR_SAVE_EXPO_MARK (expo);
/* Initialisation of the Precision */
Ny = MPFR_PREC (y);
/* compute the size of intermediary variable */
Nt = Ny + 2 * MPFR_INT_CEIL_LOG2 (x) + 7;
mpfr_init2 (t, Nt); /* initialise of intermediary variable */
rnd = MPFR_RNDZ;
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute factorial */
inexact = mpfr_set_ui (t, 1, rnd);
for (i = 2 ; i <= x ; i++)
{
round = mpfr_mul_ui (t, t, i, rnd);
/* assume the first inexact product gives the sign
of difference: is that always correct? */
if (inexact == 0)
inexact = round;
}
err = Nt - 1 - MPFR_INT_CEIL_LOG2 (Nt);
round = !inexact || mpfr_can_round (t, err, rnd, MPFR_RNDZ,
Ny + (rnd_mode == MPFR_RNDN));
if (MPFR_LIKELY (round))
{
/* If inexact = 0, then t is exactly x!, so round is the
correct inexact flag.
Otherwise, t != x! since we rounded to zero or away. */
round = mpfr_set (y, t, rnd_mode);
if (inexact == 0)
{
inexact = round;
break;
}
else if ((inexact < 0 && round <= 0)
|| (inexact > 0 && round >= 0))
break;
else /* inexact and round have opposite signs: we cannot
compute the inexact flag. Restart using the
symmetric rounding. */
rnd = (rnd == MPFR_RNDZ) ? MPFR_RNDU : MPFR_RNDZ;
}
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
where x = n*log(2)+(2^K)*r
together with Brent-Kung O(t^(1/2)) algorithm for the evaluation of
power series. The resulting complexity is O(n^(1/3)*M(n)).
*/
int
mpfr_exp_2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
long n;
unsigned long K, k, l, err; /* FIXME: Which type ? */
int error_r;
mp_exp_t exps;
mp_prec_t q, precy;
int inexact;
mpfr_t r, s, t;
mpz_t ss;
TMP_DECL(marker);
precy = MPFR_PREC(y);
MPFR_TRACE ( printf("Py=%d Px=%d", MPFR_PREC(y), MPFR_PREC(x)) );
MPFR_TRACE ( MPFR_DUMP (x) );
n = (long) (mpfr_get_d1 (x) / LOG2);
/* error bounds the cancelled bits in x - n*log(2) */
if (MPFR_UNLIKELY(n == 0))
error_r = 0;
else
count_leading_zeros (error_r, (mp_limb_t) (n < 0) ? -n : n);
error_r = BITS_PER_MP_LIMB - error_r + 2;
/* for the O(n^(1/2)*M(n)) method, the Taylor series computation of
n/K terms costs about n/(2K) multiplications when computed in fixed
point */
K = (precy < SWITCH) ? __gmpfr_isqrt ((precy + 1) / 2)
: __gmpfr_cuberoot (4*precy);
l = (precy - 1) / K + 1;
err = K + MPFR_INT_CEIL_LOG2 (2 * l + 18);
/* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
q = precy + err + K + 5;
/*q = ( (q-1)/BITS_PER_MP_LIMB + 1) * BITS_PER_MP_LIMB; */
mpfr_init2 (r, q + error_r);
mpfr_init2 (s, q + error_r);
mpfr_init2 (t, q);
/* the algorithm consists in computing an upper bound of exp(x) using
a precision of q bits, and see if we can round to MPFR_PREC(y) taking
into account the maximal error. Otherwise we increase q. */
for (;;)
{
MPFR_TRACE ( printf("n=%d K=%d l=%d q=%d\n",n,K,l,q) );
/* if n<0, we have to get an upper bound of log(2)
in order to get an upper bound of r = x-n*log(2) */
mpfr_const_log2 (s, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* s is within 1 ulp of log(2) */
mpfr_mul_ui (r, s, (n < 0) ? -n : n, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* r is within 3 ulps of n*log(2) */
if (n < 0)
mpfr_neg (r, r, GMP_RNDD); /* exact */
/* r = floor(n*log(2)), within 3 ulps */
MPFR_TRACE ( MPFR_DUMP (x) );
MPFR_TRACE ( MPFR_DUMP (r) );
mpfr_sub (r, x, r, GMP_RNDU);
/* possible cancellation here: the error on r is at most
3*2^(EXP(old_r)-EXP(new_r)) */
while (MPFR_IS_NEG (r))
{ /* initial approximation n was too large */
n--;
mpfr_add (r, r, s, GMP_RNDU);
}
mpfr_prec_round (r, q, GMP_RNDU);
MPFR_TRACE ( MPFR_DUMP (r) );
MPFR_ASSERTD (MPFR_IS_POS (r));
mpfr_div_2ui (r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K, exact */
TMP_MARK(marker);
MY_INIT_MPZ(ss, 3 + 2*((q-1)/BITS_PER_MP_LIMB));
exps = mpfr_get_z_exp (ss, s);
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! */
l = (precy < SWITCH) ?
mpfr_exp2_aux (ss, r, q, &exps) /* naive method */
: mpfr_exp2_aux2 (ss, r, q, &exps); /* Brent/Kung method */
MPFR_TRACE(printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q));
for (k = 0; k < K; k++)
{
mpz_mul (ss, ss, ss);
exps <<= 1;
exps += mpz_normalize (ss, ss, q);
}
mpfr_set_z (s, ss, GMP_RNDN);
MPFR_SET_EXP(s, MPFR_GET_EXP (s) + exps);
TMP_FREE(marker); /* don't need ss anymore */
if (n>0)
mpfr_mul_2ui(s, s, n, GMP_RNDU);
else
mpfr_div_2ui(s, s, -n, GMP_RNDU);
/* error is at most 2^K*(3l*(l+1)) ulp for mpfr_exp2_aux */
l = (precy < SWITCH) ? 3*l*(l+1) : l*(l+4) ;
k = MPFR_INT_CEIL_LOG2 (l);
/* k = 0; while (l) { k++; l >>= 1; } */
/* now k = ceil(log(error in ulps)/log(2)) */
K += k;
MPFR_TRACE ( printf("after mult. by 2^n:\n") );
MPFR_TRACE ( MPFR_DUMP (s) );
MPFR_TRACE ( printf("err=%d bits\n", K) );
if (mpfr_can_round (s, q - K, GMP_RNDN, GMP_RNDZ,
precy + (rnd_mode == GMP_RNDN)) )
break;
MPFR_TRACE (printf("prec++, use %d\n", q+BITS_PER_MP_LIMB) );
MPFR_TRACE (printf("q=%d q-K=%d precy=%d\n",q,q-K,precy) );
q += BITS_PER_MP_LIMB;
mpfr_set_prec (r, q);
mpfr_set_prec (s, q);
mpfr_set_prec (t, q);
}
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
mpfr_clear (t);
return inexact;
}
/* Don't need to save / restore exponent range: the cache does it */
int
mpfr_const_log2_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
unsigned long n = MPFR_PREC (x);
mpfr_prec_t w; /* working precision */
unsigned long N;
mpz_t *T, *P, *Q;
mpfr_t t, q;
int inexact;
int ok = 1; /* ensures that the 1st try will give correct rounding */
unsigned long lgN, i;
MPFR_GROUP_DECL(group);
MPFR_TMP_DECL(marker);
MPFR_ZIV_DECL(loop);
MPFR_LOG_FUNC (
("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inex=%d", mpfr_get_prec(x), mpfr_log_prec, x, inexact));
if (n < 1253)
w = n + 10; /* ensures correct rounding for the four rounding modes,
together with N = w / 3 + 1 (see below). */
else if (n < 2571)
w = n + 11; /* idem */
else if (n < 3983)
w = n + 12;
else if (n < 4854)
w = n + 13;
else if (n < 26248)
w = n + 14;
else
{
w = n + 15;
ok = 0;
}
MPFR_TMP_MARK(marker);
MPFR_GROUP_INIT_2(group, w, t, q);
MPFR_ZIV_INIT (loop, w);
for (;;)
{
N = w / 3 + 1; /* Warning: do not change that (even increasing N!)
without checking correct rounding in the above
ranges for n. */
/* the following are needed for error analysis (see algorithms.tex) */
MPFR_ASSERTD(w >= 3 && N >= 2);
lgN = MPFR_INT_CEIL_LOG2 (N) + 1;
T = (mpz_t *) MPFR_TMP_ALLOC (3 * lgN * sizeof (mpz_t));
P = T + lgN;
Q = T + 2*lgN;
for (i = 0; i < lgN; i++)
{
mpz_init (T[i]);
mpz_init (P[i]);
mpz_init (Q[i]);
}
S (T, P, Q, 0, N, 0);
mpfr_set_z (t, T[0], MPFR_RNDN);
mpfr_set_z (q, Q[0], MPFR_RNDN);
mpfr_div (t, t, q, MPFR_RNDN);
for (i = 0; i < lgN; i++)
{
mpz_clear (T[i]);
mpz_clear (P[i]);
mpz_clear (Q[i]);
}
if (MPFR_LIKELY (ok != 0
|| mpfr_can_round (t, w - 2, MPFR_RNDN, rnd_mode, n)))
break;
MPFR_ZIV_NEXT (loop, w);
MPFR_GROUP_REPREC_2(group, w, t, q);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, t, rnd_mode);
MPFR_GROUP_CLEAR(group);
MPFR_TMP_FREE(marker);
return inexact;
}
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;
}
static void
check1 (mpfr_ptr x, mpfr_prec_t prec, unsigned long nt, mpfr_rnd_t rnd)
{
mpfr_t y, z, t;
int inexact, compare, compare2;
mpfr_prec_t yprec;
mpfr_exp_t err;
yprec = prec + 10;
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_set_prec (y, yprec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
compare = mpfr_ui_pow (y, nt, x, rnd);
err = (rnd == MPFR_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = mpfr_ui_pow (z, nt, x, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf (" n=%lu", nt);
printf (" prec=%u rnd_mode=%s\n", (unsigned) 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 (y);
mpfr_clear (z);
mpfr_clear (t);
}
int
mpc_log (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd){
int ok, underflow = 0;
mpfr_srcptr x, y;
mpfr_t v, w;
mpfr_prec_t prec;
int loops;
int re_cmp, im_cmp;
int inex_re, inex_im;
int err;
mpfr_exp_t expw;
int sgnw;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else if (mpfr_nan_p (mpc_imagref (op))) {
if (mpfr_inf_p (mpc_realref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else /* We have an infinity in at least one part. */ {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), +1);
}
return MPC_INEX(0, inex_im);
}
/* special cases: real and purely imaginary numbers */
re_cmp = mpfr_cmp_ui (mpc_realref (op), 0);
im_cmp = mpfr_cmp_ui (mpc_imagref (op), 0);
if (im_cmp == 0) {
if (re_cmp == 0) {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), -1);
inex_re = 0; /* -Inf is exact */
}
else if (re_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else {
/* op = x + 0*y; let w = -x = |x| */
int negative_zero;
mpfr_rnd_t rnd_im;
negative_zero = mpfr_signbit (mpc_imagref (op));
if (negative_zero)
rnd_im = INV_RND (MPC_RND_IM (rnd));
else
rnd_im = MPC_RND_IM (rnd);
w [0] = *mpc_realref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), rnd_im);
if (negative_zero) {
mpc_conj (rop, rop, MPC_RNDNN);
inex_im = -inex_im;
}
}
return MPC_INEX(inex_re, inex_im);
}
else if (re_cmp == 0) {
if (im_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), MPC_RND_IM (rnd));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
}
else {
w [0] = *mpc_imagref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), INV_RND (MPC_RND_IM (rnd)));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_im = -inex_im; /* negate the ternary flag */
}
return MPC_INEX(inex_re, inex_im);
}
prec = MPC_PREC_RE(rop);
mpfr_init2 (w, 2);
/* let op = x + iy; log = 1/2 log (x^2 + y^2) + i atan2 (y, x) */
/* loop for the real part: 1/2 log (x^2 + y^2), fast, but unsafe */
/* implementation */
ok = 0;
for (loops = 1; !ok && loops <= 2; loops++) {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (w, prec);
mpc_abs (w, op, GMP_RNDN);
/* error 0.5 ulp */
if (mpfr_inf_p (w))
/* intermediate overflow; the logarithm may be representable.
Intermediate underflow is impossible. */
break;
mpfr_log (w, w, GMP_RNDN);
/* generic error of log: (2^(- exp(w)) + 0.5) ulp */
if (mpfr_zero_p (w))
/* impossible to round, switch to second algorithm */
break;
err = MPC_MAX (-mpfr_get_exp (w), 0) + 1;
/* number of lost digits */
ok = mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN));
}
if (!ok) {
prec = MPC_PREC_RE(rop);
mpfr_init2 (v, 2);
/* compute 1/2 log (x^2 + y^2) = log |x| + 1/2 * log (1 + (y/x)^2)
if |x| >= |y|; otherwise, exchange x and y */
if (mpfr_cmpabs (mpc_realref (op), mpc_imagref (op)) >= 0) {
x = mpc_realref (op);
y = mpc_imagref (op);
}
else {
x = mpc_imagref (op);
y = mpc_realref (op);
}
do {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (v, prec);
mpfr_set_prec (w, prec);
mpfr_div (v, y, x, GMP_RNDD); /* error 1 ulp */
mpfr_sqr (v, v, GMP_RNDD);
/* generic error of multiplication:
1 + 2*1*(2+1*2^(1-prec)) <= 5.0625 since prec >= 6 */
mpfr_log1p (v, v, GMP_RNDD);
/* error 1 + 4*5.0625 = 21.25 , see algorithms.tex */
mpfr_div_2ui (v, v, 1, GMP_RNDD);
/* If the result is 0, then there has been an underflow somewhere. */
mpfr_abs (w, x, GMP_RNDN); /* exact */
mpfr_log (w, w, GMP_RNDN); /* error 0.5 ulp */
expw = mpfr_get_exp (w);
sgnw = mpfr_signbit (w);
mpfr_add (w, w, v, GMP_RNDN);
if (!sgnw) /* v is positive, so no cancellation;
error 22.25 ulp; error counts lost bits */
err = 5;
else
err = MPC_MAX (5 + mpfr_get_exp (v),
/* 21.25 ulp (v) rewritten in ulp (result, now in w) */
-1 + expw - mpfr_get_exp (w)
/* 0.5 ulp (previous w), rewritten in ulp (result) */
) + 2;
/* handle one special case: |x|=1, and (y/x)^2 underflows;
then 1/2*log(x^2+y^2) \approx 1/2*y^2 also underflows. */
if ( (mpfr_cmp_si (x, -1) == 0 || mpfr_cmp_ui (x, 1) == 0)
&& mpfr_zero_p (w))
underflow = 1;
} while (!underflow &&
!mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN)));
mpfr_clear (v);
}
/* imaginary part */
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
/* set the real part; cannot be done before if rop==op */
if (underflow)
/* create underflow in result */
inex_re = mpfr_set_ui_2exp (mpc_realref (rop), 1,
mpfr_get_emin_min () - 2, MPC_RND_RE (rnd));
else
inex_re = mpfr_set (mpc_realref (rop), w, MPC_RND_RE (rnd));
mpfr_clear (w);
return MPC_INEX(inex_re, inex_im);
}
int
main (int argc, char *argv[])
{
unsigned int prec, err, yprec, n, k, zeros;
int rnd;
mpfr_t x, y, z, t;
int inexact;
tests_start_mpfr ();
special ();
test_int ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_fac_ui (y, 0, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_fac_ui(0) does not give 1\n");
exit (1);
}
for (prec = 2; prec <= 100; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
for (n = 0; n < 50; n++)
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
inexact = mpfr_fac_ui (y, n, (mp_rnd_t) rnd);
err = (rnd == GMP_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, (mp_rnd_t) rnd, (mp_rnd_t) rnd, prec))
{
mpfr_set (t, y, (mp_rnd_t) rnd);
inexact = mpfr_fac_ui (z, n, (mp_rnd_t) rnd);
/* fact(n) ends with floor(n/2)+floor(n/4)+... zeros */
for (k=n/2, zeros=0; k; k >>= 1)
zeros += k;
if (MPFR_EXP(y) <= (mp_exp_t) (prec + zeros))
/* result should be exact */
{
if (inexact)
{
printf ("Wrong inexact flag: expected exact\n");
exit (1);
}
}
else /* result is inexact */
{
if (!inexact)
{
printf ("Wrong inexact flag: expected inexact\n");
printf ("n=%u prec=%u\n", n, prec);
mpfr_print_binary(z); puts ("");
exit (1);
}
}
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, GMP_RNDN);
printf (" prec=%u rnd_mode=%s\n", prec,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf (" got ");
mpfr_out_str (stdout, 2, prec, z, GMP_RNDN);
puts ("");
printf (" expected ");
mpfr_out_str (stdout, 2, prec, t, GMP_RNDN);
puts ("");
printf (" approximation was ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
}
}
int
mpc_sqrt (mpc_ptr a, mpc_srcptr b, mpc_rnd_t rnd)
{
int ok_w, ok_t = 0;
mpfr_t w, t;
mp_rnd_t rnd_w, rnd_t;
mp_prec_t prec_w, prec_t;
/* the rounding mode and the precision required for w and t, which can */
/* be either the real or the imaginary part of a */
mp_prec_t prec;
int inex_w, inex_t = 1, inex, loops = 0;
/* comparison of the real/imaginary part of b with 0 */
const int re_cmp = mpfr_cmp_ui (MPC_RE (b), 0);
const int im_cmp = mpfr_cmp_ui (MPC_IM (b), 0);
/* we need to know the sign of Im(b) when it is +/-0 */
const int im_sgn = mpfr_signbit (MPC_IM (b)) == 0? 0 : -1;
/* special values */
/* sqrt(x +i*Inf) = +Inf +I*Inf, even if x = NaN */
/* sqrt(x -i*Inf) = +Inf -I*Inf, even if x = NaN */
if (mpfr_inf_p (MPC_IM (b)))
{
mpfr_set_inf (MPC_RE (a), +1);
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
if (mpfr_inf_p (MPC_RE (b)))
{
if (mpfr_signbit (MPC_RE (b)))
{
if (mpfr_number_p (MPC_IM (b)))
{
/* sqrt(-Inf +i*y) = +0 +i*Inf, when y positive */
/* sqrt(-Inf +i*y) = +0 -i*Inf, when y positive */
mpfr_set_ui (MPC_RE (a), 0, GMP_RNDN);
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
else
{
/* sqrt(-Inf +i*NaN) = NaN +/-i*Inf */
mpfr_set_nan (MPC_RE (a));
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
}
else
{
if (mpfr_number_p (MPC_IM (b)))
{
/* sqrt(+Inf +i*y) = +Inf +i*0, when y positive */
/* sqrt(+Inf +i*y) = +Inf -i*0, when y positive */
mpfr_set_inf (MPC_RE (a), +1);
mpfr_set_ui (MPC_IM (a), 0, GMP_RNDN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (0, 0);
}
else
{
/* sqrt(+Inf -i*Inf) = +Inf -i*Inf */
/* sqrt(+Inf +i*Inf) = +Inf +i*Inf */
/* sqrt(+Inf +i*NaN) = +Inf +i*NaN */
return mpc_set (a, b, rnd);
}
}
}
/* sqrt(x +i*NaN) = NaN +i*NaN, if x is not infinite */
/* sqrt(NaN +i*y) = NaN +i*NaN, if y is not infinite */
if (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
{
mpfr_set_nan (MPC_RE (a));
mpfr_set_nan (MPC_IM (a));
return MPC_INEX (0, 0);
}
/* purely real */
if (im_cmp == 0)
{
if (re_cmp == 0)
{
mpc_set_ui_ui (a, 0, 0, MPC_RNDNN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (0, 0);
}
else if (re_cmp > 0)
{
inex_w = mpfr_sqrt (MPC_RE (a), MPC_RE (b), MPC_RND_RE (rnd));
mpfr_set_ui (MPC_IM (a), 0, GMP_RNDN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (inex_w, 0);
}
else
{
mpfr_init2 (w, MPFR_PREC (MPC_RE (b)));
mpfr_neg (w, MPC_RE (b), GMP_RNDN);
if (im_sgn)
{
inex_w = -mpfr_sqrt (MPC_IM (a), w, INV_RND (MPC_RND_IM (rnd)));
mpfr_neg (MPC_IM (a), MPC_IM (a), GMP_RNDN);
}
else
inex_w = mpfr_sqrt (MPC_IM (a), w, MPC_RND_IM (rnd));
mpfr_set_ui (MPC_RE (a), 0, GMP_RNDN);
mpfr_clear (w);
return MPC_INEX (0, inex_w);
}
}
/* purely imaginary */
if (re_cmp == 0)
{
mpfr_t y;
y[0] = MPC_IM (b)[0];
/* If y/2 underflows, so does sqrt(y/2) */
mpfr_div_2ui (y, y, 1, GMP_RNDN);
if (im_cmp > 0)
{
inex_w = mpfr_sqrt (MPC_RE (a), y, MPC_RND_RE (rnd));
inex_t = mpfr_sqrt (MPC_IM (a), y, MPC_RND_IM (rnd));
}
else
{
mpfr_neg (y, y, GMP_RNDN);
inex_w = mpfr_sqrt (MPC_RE (a), y, MPC_RND_RE (rnd));
inex_t = -mpfr_sqrt (MPC_IM (a), y, INV_RND (MPC_RND_IM (rnd)));
mpfr_neg (MPC_IM (a), MPC_IM (a), GMP_RNDN);
}
return MPC_INEX (inex_w, inex_t);
}
prec = MPC_MAX_PREC(a);
mpfr_init (w);
mpfr_init (t);
if (re_cmp >= 0)
{
rnd_w = MPC_RND_RE (rnd);
prec_w = MPFR_PREC (MPC_RE (a));
rnd_t = MPC_RND_IM(rnd);
prec_t = MPFR_PREC (MPC_IM (a));
}
else
{
rnd_w = MPC_RND_IM(rnd);
prec_w = MPFR_PREC (MPC_IM (a));
rnd_t = MPC_RND_RE(rnd);
prec_t = MPFR_PREC (MPC_RE (a));
if (im_cmp < 0)
{
rnd_w = INV_RND(rnd_w);
rnd_t = INV_RND(rnd_t);
}
}
do
{
loops ++;
prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
mpfr_set_prec (w, prec);
mpfr_set_prec (t, prec);
/* let b = x + iy */
/* w = sqrt ((|x| + sqrt (x^2 + y^2)) / 2), rounded down */
/* total error bounded by 3 ulps */
inex_w = mpc_abs (w, b, GMP_RNDD);
if (re_cmp < 0)
inex_w |= mpfr_sub (w, w, MPC_RE (b), GMP_RNDD);
else
inex_w |= mpfr_add (w, w, MPC_RE (b), GMP_RNDD);
inex_w |= mpfr_div_2ui (w, w, 1, GMP_RNDD);
inex_w |= mpfr_sqrt (w, w, GMP_RNDD);
ok_w = mpfr_can_round (w, (mp_exp_t) prec - 2, GMP_RNDD, GMP_RNDU,
prec_w + (rnd_w == GMP_RNDN));
if (!inex_w || ok_w)
{
/* t = y / 2w, rounded away */
/* total error bounded by 7 ulps */
const mp_rnd_t r = im_sgn ? GMP_RNDD : GMP_RNDU;
inex_t = mpfr_div (t, MPC_IM (b), w, r);
inex_t |= mpfr_div_2ui (t, t, 1, r);
ok_t = mpfr_can_round (t, (mp_exp_t) prec - 3, r, GMP_RNDZ,
prec_t + (rnd_t == GMP_RNDN));
/* As for w; since t was rounded away, we check whether rounding to 0
is possible. */
}
}
while ((inex_w && !ok_w) || (inex_t && !ok_t));
if (re_cmp > 0)
inex = MPC_INEX (mpfr_set (MPC_RE (a), w, MPC_RND_RE(rnd)),
mpfr_set (MPC_IM (a), t, MPC_RND_IM(rnd)));
else if (im_cmp > 0)
inex = MPC_INEX (mpfr_set (MPC_RE(a), t, MPC_RND_RE(rnd)),
mpfr_set (MPC_IM(a), w, MPC_RND_IM(rnd)));
else
inex = MPC_INEX (mpfr_neg (MPC_RE (a), t, MPC_RND_RE(rnd)),
mpfr_neg (MPC_IM (a), w, MPC_RND_IM(rnd)));
mpfr_clear (w);
mpfr_clear (t);
return inex;
}
int
mpc_asin (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_prec_t p, p_re, p_im, incr_p = 0;
mpfr_rnd_t rnd_re, rnd_im;
mpc_t z1;
int inex;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? -1 : +1);
}
else if (mpfr_zero_p (mpc_realref (op)))
{
mpfr_set (mpc_realref (rop), mpc_realref (op), GMP_RNDN);
mpfr_set_nan (mpc_imagref (rop));
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
return 0;
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
int inex_re;
if (mpfr_inf_p (mpc_realref (op)))
{
int inf_im = mpfr_inf_p (mpc_imagref (op));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
if (inf_im)
mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
}
else
{
mpfr_set_zero (mpc_realref (rop), (mpfr_signbit (mpc_realref (op)) ? -1 : 1));
inex_re = 0;
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
}
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
int inex_re;
int inex_im;
int s_im;
s_im = mpfr_signbit (mpc_imagref (op));
if (mpfr_cmp_ui (mpc_realref (op), 1) > 0)
{
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else if (mpfr_cmp_si (mpc_realref (op), -1) < 0)
{
mpfr_t minus_op_re;
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), minus_op_re,
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
{
inex_im = mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
if (s_im)
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_re = mpfr_asin (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
}
return MPC_INEX (inex_re, inex_im);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int inex_im;
int s;
s = mpfr_signbit (mpc_realref (op));
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_asinh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
/* regular complex: asin(z) = -i*log(i*z+sqrt(1-z^2)) */
p_re = mpfr_get_prec (mpc_realref(rop));
p_im = mpfr_get_prec (mpc_imagref(rop));
rnd_re = MPC_RND_RE(rnd);
rnd_im = MPC_RND_IM(rnd);
p = p_re >= p_im ? p_re : p_im;
mpc_init2 (z1, p);
while (1)
{
mpfr_exp_t ex, ey, err;
p += mpc_ceil_log2 (p) + 3 + incr_p; /* incr_p is zero initially */
incr_p = p / 2;
mpfr_set_prec (mpc_realref(z1), p);
mpfr_set_prec (mpc_imagref(z1), p);
/* z1 <- z^2 */
mpc_sqr (z1, op, MPC_RNDNN);
/* err(x) <= 1/2 ulp(x), err(y) <= 1/2 ulp(y) */
/* z1 <- 1-z1 */
ex = mpfr_get_exp (mpc_realref(z1));
mpfr_ui_sub (mpc_realref(z1), 1, mpc_realref(z1), GMP_RNDN);
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
ex = ex - mpfr_get_exp (mpc_realref(z1));
ex = (ex <= 0) ? 0 : ex;
/* err(x) <= 2^ex * ulp(x) */
ex = ex + mpfr_get_exp (mpc_realref(z1)) - p;
/* err(x) <= 2^ex */
ey = mpfr_get_exp (mpc_imagref(z1)) - p - 1;
/* err(y) <= 2^ey */
ex = (ex >= ey) ? ex : ey; /* err(x), err(y) <= 2^ex, i.e., the norm
of the error is bounded by |h|<=2^(ex+1/2) */
/* z1 <- sqrt(z1): if z1 = z + h, then sqrt(z1) = sqrt(z) + h/2/sqrt(t) */
ey = mpfr_get_exp (mpc_realref(z1)) >= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
/* we have |z1| >= 2^(ey-1) thus 1/|z1| <= 2^(1-ey) */
mpc_sqrt (z1, z1, MPC_RNDNN);
ex = (2 * ex + 1) - 2 - (ey - 1); /* |h^2/4/|t| <= 2^ex */
ex = (ex + 1) / 2; /* ceil(ex/2) */
/* express ex in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
ex = ex - ey + p;
/* take into account the rounding error in the mpc_sqrt call */
err = (ex <= 0) ? 1 : ex + 1;
/* err(x) <= 2^err * ulp(x), err(y) <= 2^err * ulp(y) */
/* z1 <- i*z + z1 */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
mpfr_sub (mpc_realref(z1), mpc_realref(z1), mpc_imagref(op), GMP_RNDN);
mpfr_add (mpc_imagref(z1), mpc_imagref(z1), mpc_realref(op), GMP_RNDN);
if (mpfr_cmp_ui (mpc_realref(z1), 0) == 0 || mpfr_cmp_ui (mpc_imagref(z1), 0) == 0)
continue;
ex -= mpfr_get_exp (mpc_realref(z1)); /* cancellation in x */
ey -= mpfr_get_exp (mpc_imagref(z1)); /* cancellation in y */
ex = (ex >= ey) ? ex : ey; /* maximum cancellation */
err += ex;
err = (err <= 0) ? 1 : err + 1; /* rounding error in sub/add */
/* z1 <- log(z1): if z1 = z + h, then log(z1) = log(z) + h/t with
|t| >= min(|z1|,|z|) */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
ex = (ex >= ey) ? ex : ey;
err += ex - p; /* revert to absolute error <= 2^err */
mpc_log (z1, z1, GMP_RNDN);
err -= ex - 1; /* 1/|t| <= 1/|z| <= 2^(1-ex) */
/* express err in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
err = err - ey + p;
/* take into account the rounding error in the mpc_log call */
err = (err <= 0) ? 1 : err + 1;
/* z1 <- -i*z1 */
mpfr_swap (mpc_realref(z1), mpc_imagref(z1));
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
if (mpfr_can_round (mpc_realref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_re + (rnd_re == GMP_RNDN)) &&
mpfr_can_round (mpc_imagref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN)))
break;
}
inex = mpc_set (rop, z1, rnd);
mpc_clear (z1);
return inex;
}
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mp_rnd_t rnd_mode)
{
int inexact = 0;
mpfr_t x;
mp_prec_t Nx = MPFR_PREC(xt); /* Precision of input variable */
/* Special cases */
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(xt) ))
{
/* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
between -1 and 1 */
if (MPFR_IS_NAN(xt) || MPFR_IS_INF(xt))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else /* necessarily xt is 0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(xt));
MPFR_SET_ZERO(y); /* atanh(0) = 0 */
MPFR_SET_SAME_SIGN(y,xt);
MPFR_RET(0);
}
}
/* Useless due to final mpfr_set
MPFR_CLEAR_FLAGS(y);*/
/* atanh(x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
if (MPFR_EXP(xt) > 0)
{
if (MPFR_EXP(xt) == 1 && mpfr_powerof2_raw (xt))
{
MPFR_SET_INF(y);
MPFR_SET_SAME_SIGN(y, xt);
MPFR_RET(0);
}
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
mpfr_init2 (x, Nx);
mpfr_abs (x, xt, GMP_RNDN);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te,ti;
/* Declaration of the size variable */
mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */
mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
/* compute the precision of intermediary variable */
Nt=MAX(Nx,Ny);
/* the optimal number of bits : see algorithms.ps */
Nt=Nt+4+__gmpfr_ceil_log2(Nt);
/* initialise of intermediary variable */
mpfr_init(t);
mpfr_init(te);
mpfr_init(ti);
/* First computation of cosh */
do
{
/* reactualisation of the precision */
mpfr_set_prec(t,Nt);
mpfr_set_prec(te,Nt);
mpfr_set_prec(ti,Nt);
/* compute atanh */
mpfr_ui_sub(te,1,x,GMP_RNDU); /* (1-xt)*/
mpfr_add_ui(ti,x,1,GMP_RNDD); /* (xt+1)*/
mpfr_div(te,ti,te,GMP_RNDN); /* (1+xt)/(1-xt)*/
mpfr_log(te,te,GMP_RNDN); /* ln((1+xt)/(1-xt))*/
mpfr_div_2ui(t,te,1,GMP_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/
/* error estimate see- algorithms.ps*/
/* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
/* actualisation of the precision */
Nt += 10;
}
while ((err < 0) || (!mpfr_can_round (t, err, GMP_RNDN, GMP_RNDZ,
Ny + (rnd_mode == GMP_RNDN))
|| MPFR_IS_ZERO(t)));
if (MPFR_IS_NEG(xt))
MPFR_CHANGE_SIGN(t);
inexact = mpfr_set (y, t, rnd_mode);
mpfr_clear(t);
mpfr_clear(ti);
mpfr_clear(te);
}
mpfr_clear(x);
return inexact;
}
