int
mpc_mul_i (mpc_ptr a, mpc_srcptr b, int sign, mpc_rnd_t rnd)
/* if sign is >= 0, multiply by i, otherwise by -i */
{
int inex_re, inex_im;
mpfr_t tmp;
/* Treat the most probable case of compatible precisions first */
if ( MPC_PREC_RE (b) == MPC_PREC_IM (a)
&& MPC_PREC_IM (b) == MPC_PREC_RE (a))
{
if (a == b)
mpfr_swap (MPC_RE (a), MPC_IM (a));
else
{
mpfr_set (MPC_RE (a), MPC_IM (b), GMP_RNDN);
mpfr_set (MPC_IM (a), MPC_RE (b), GMP_RNDN);
}
if (sign >= 0)
MPFR_CHANGE_SIGN (MPC_RE (a));
else
MPFR_CHANGE_SIGN (MPC_IM (a));
inex_re = 0;
inex_im = 0;
}
else
{
if (a == b)
{
mpfr_init2 (tmp, MPC_PREC_RE (a));
if (sign >= 0)
{
inex_re = mpfr_neg (tmp, MPC_IM (b), MPC_RND_RE (rnd));
inex_im = mpfr_set (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
}
else
{
inex_re = mpfr_set (tmp, MPC_IM (b), MPC_RND_RE (rnd));
inex_im = mpfr_neg (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
}
mpfr_clear (MPC_RE (a));
MPC_RE (a)[0] = tmp [0];
}
else if (sign >= 0)
{
inex_re = mpfr_neg (MPC_RE (a), MPC_IM (b), MPC_RND_RE (rnd));
inex_im = mpfr_set (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
}
else
{
inex_re = mpfr_set (MPC_RE (a), MPC_IM (b), MPC_RND_RE (rnd));
inex_im = mpfr_neg (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
}
}
return MPC_INEX(inex_re, inex_im);
}
static void
tgeneric_cc_c (mpc_function *function, mpc_ptr op, mpc_ptr rop1, mpc_ptr rop2,
mpc_ptr rop14, mpc_ptr rop24, mpc_ptr rop14rnd, mpc_ptr rop24rnd,
mpc_rnd_t rnd1, mpc_rnd_t rnd2)
{
/* same as the previous function, but for mpc functions computing two
results from one argument */
known_signs_t ks = {1, 1};
function->pointer.CC_C (rop14, rop24, op, rnd1, rnd2);
function->pointer.CC_C (rop1, rop2, op, rnd1, rnd2);
if ( MPFR_CAN_ROUND (mpc_realref (rop14), 1, MPC_PREC_RE (rop1),
MPC_RND_RE (rnd1))
&& MPFR_CAN_ROUND (mpc_imagref (rop14), 1, MPC_PREC_IM (rop1),
MPC_RND_IM (rnd1))
&& MPFR_CAN_ROUND (mpc_realref (rop24), 1, MPC_PREC_RE (rop2),
MPC_RND_RE (rnd2))
&& MPFR_CAN_ROUND (mpc_imagref (rop24), 1, MPC_PREC_IM (rop2),
MPC_RND_IM (rnd2))) {
mpc_set (rop14rnd, rop14, rnd1);
mpc_set (rop24rnd, rop24, rnd2);
}
else
return;
if (!same_mpc_value (rop1, rop14rnd, ks)) {
/* rounding failed for first result */
printf ("Rounding might be incorrect for the first result of %s at\n", function->name);
MPC_OUT (op);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd1)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd1)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop1);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop14);
printf ("and is rounded to ");
MPC_OUT (rop14rnd);
exit (1);
}
else if (!same_mpc_value (rop2, rop24rnd, ks)) {
/* rounding failed for second result */
printf ("Rounding might be incorrect for the second result of %s at\n", function->name);
MPC_OUT (op);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd2)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd2)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop2);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop24);
printf ("and is rounded to ");
MPC_OUT (rop24rnd);
exit (1);
}
}
int
mpc_atanh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* atanh(op) = -i*atan(i*op) */
int inex;
mpfr_t tmp;
mpc_t z, a;
MPC_RE (z)[0] = MPC_IM (op)[0];
MPC_IM (z)[0] = MPC_RE (op)[0];
MPFR_CHANGE_SIGN (MPC_RE (z));
/* Note reversal of precisions due to later multiplication by -i */
mpc_init3 (a, MPC_PREC_IM(rop), MPC_PREC_RE(rop));
inex = mpc_atan (a, z,
RNDC (INV_RND (MPC_RND_IM (rnd)), MPC_RND_RE (rnd)));
/* change a to -i*a, i.e., x+i*y to y-i*x */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_IM (a));
mpc_set (rop, a, rnd);
mpc_clear (a);
return MPC_INEX (MPC_INEX_IM (inex), -MPC_INEX_RE (inex));
}
static void
tgeneric_cci (mpc_function *function, mpc_ptr op1, int op2,
mpc_ptr rop, mpc_ptr rop4, mpc_ptr rop4rnd, mpc_rnd_t rnd)
{
known_signs_t ks = {1, 1};
function->pointer.CCI (rop4, op1, op2, rnd);
function->pointer.CCI (rop, op1, op2, rnd);
if (MPFR_CAN_ROUND (mpc_realref (rop4), 1, MPC_PREC_RE (rop),
MPC_RND_RE (rnd))
&& MPFR_CAN_ROUND (mpc_imagref (rop4), 1, MPC_PREC_IM (rop),
MPC_RND_IM (rnd)))
mpc_set (rop4rnd, rop4, rnd);
else
return;
if (same_mpc_value (rop, rop4rnd, ks))
return;
printf ("Rounding in %s might be incorrect for\n", function->name);
MPC_OUT (op1);
printf ("op2=%d\n", op2);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop4);
printf ("and is rounded to ");
MPC_OUT (rop4rnd);
exit (1);
}
int
mpc_asinh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* asinh(op) = -i*asin(i*op) */
int inex;
mpc_t z, a;
mpfr_t tmp;
/* z = i*op */
MPC_RE (z)[0] = MPC_IM (op)[0];
MPC_IM (z)[0] = MPC_RE (op)[0];
MPFR_CHANGE_SIGN (MPC_RE (z));
/* Note reversal of precisions due to later multiplication by -i */
mpc_init3 (a, MPC_PREC_IM(rop), MPC_PREC_RE(rop));
inex = mpc_asin (a, z,
RNDC (INV_RND (MPC_RND_IM (rnd)), MPC_RND_RE (rnd)));
/* if a = asin(i*op) = x+i*y, and we want y-i*x */
/* change a to -i*a */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_IM (a));
mpc_set (rop, a, MPC_RNDNN); /* exact */
mpc_clear (a);
return MPC_INEX (MPC_INEX_IM (inex), -MPC_INEX_RE (inex));
}
int
mpc_acosh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* acosh(z) =
NaN + i*NaN, if z=0+i*NaN
-i*acos(z), if sign(Im(z)) = -
i*acos(z), if sign(Im(z)) = +
http://functions.wolfram.com/ElementaryFunctions/ArcCosh/27/02/03/01/01/
*/
mpc_t a;
mpfr_t tmp;
int inex;
if (mpfr_zero_p (MPC_RE (op)) && mpfr_nan_p (MPC_IM (op)))
{
mpfr_set_nan (MPC_RE (rop));
mpfr_set_nan (MPC_IM (rop));
return 0;
}
/* Note reversal of precisions due to later multiplication by i or -i */
mpc_init3 (a, MPC_PREC_IM(rop), MPC_PREC_RE(rop));
if (mpfr_signbit (MPC_IM (op)))
{
inex = mpc_acos (a, op,
RNDC (INV_RND (MPC_RND_IM (rnd)), MPC_RND_RE (rnd)));
/* change a to -i*a, i.e., -y+i*x to x+i*y */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_IM (a));
inex = MPC_INEX (MPC_INEX_IM (inex), -MPC_INEX_RE (inex));
}
else
{
inex = mpc_acos (a, op,
RNDC (MPC_RND_IM (rnd), INV_RND(MPC_RND_RE (rnd))));
/* change a to i*a, i.e., y-i*x to x+i*y */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_RE (a));
inex = MPC_INEX (-MPC_INEX_IM (inex), MPC_INEX_RE (inex));
}
mpc_set (rop, a, rnd);
mpc_clear (a);
return inex;
}
static int
mpc_div_imag (mpc_ptr rop, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes z finite and w finite and non-zero, with real part
of w a signed zero. */
{
int inex_re, inex_im;
int overlap = (rop == z) || (rop == w);
int imag_z = mpfr_zero_p (mpc_realref (z));
mpfr_t wloc;
mpc_t tmprop;
mpc_ptr dest = (overlap) ? tmprop : rop;
/* save signs of operands in case there are overlaps */
int zrs = MPFR_SIGNBIT (mpc_realref (z));
int zis = MPFR_SIGNBIT (mpc_imagref (z));
int wrs = MPFR_SIGNBIT (mpc_realref (w));
int wis = MPFR_SIGNBIT (mpc_imagref (w));
if (overlap)
mpc_init3 (tmprop, MPC_PREC_RE (rop), MPC_PREC_IM (rop));
wloc[0] = mpc_imagref(w)[0]; /* copies mpfr struct IM(w) into wloc */
inex_re = mpfr_div (mpc_realref(dest), mpc_imagref(z), wloc, MPC_RND_RE(rnd));
mpfr_neg (wloc, wloc, MPFR_RNDN);
/* changes the sign only in wloc, not in w; no need to correct later */
inex_im = mpfr_div (mpc_imagref(dest), mpc_realref(z), wloc, MPC_RND_IM(rnd));
if (overlap) {
/* Note: we could use mpc_swap here, but this might cause problems
if rop and tmprop have been allocated using different methods, since
it will swap the significands of rop and tmprop. See
http://lists.gforge.inria.fr/pipermail/mpc-discuss/2009-August/000504.html */
mpc_set (rop, tmprop, MPC_RNDNN); /* exact */
mpc_clear (tmprop);
}
/* correct signs of zeroes if necessary, which does not affect the
inexact flags */
if (mpfr_zero_p (mpc_realref (rop)))
mpfr_setsign (mpc_realref (rop), mpc_realref (rop), (zrs != wrs && zis != wis),
MPFR_RNDN); /* exact */
if (imag_z)
mpfr_setsign (mpc_imagref (rop), mpc_imagref (rop), (zis != wrs && zrs == wis),
MPFR_RNDN);
return MPC_INEX(inex_re, inex_im);
}
/* functions with one input, one output */
static void
tgeneric_cc (mpc_function *function, mpc_ptr op, mpc_ptr rop,
mpc_ptr rop4, mpc_ptr rop4rnd, mpc_rnd_t rnd)
{
known_signs_t ks = {1, 1};
/* We compute the result with four times the precision and check whether the
rounding is correct. Error reports in this part of the algorithm might
still be wrong, though, since there are two consecutive roundings (but we
try to avoid them). */
function->pointer.CC (rop4, op, rnd);
function->pointer.CC (rop, op, rnd);
/* can't use the mpfr_can_round function when argument is singular,
use a custom macro instead. */
if (MPFR_CAN_ROUND (mpc_realref (rop4), 1, MPC_PREC_RE (rop),
MPC_RND_RE (rnd))
&& MPFR_CAN_ROUND (mpc_imagref (rop4), 1, MPC_PREC_IM (rop),
MPC_RND_IM (rnd)))
mpc_set (rop4rnd, rop4, rnd);
else
/* avoid double rounding error */
return;
if (same_mpc_value (rop, rop4rnd, ks))
return;
/* rounding failed */
printf ("Rounding in %s might be incorrect for\n", function->name);
MPC_OUT (op);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop4);
printf ("and is rounded to ");
MPC_OUT (rop4rnd);
exit (1);
}
static int
mpc_sin_cos_imag (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* assumes that op is purely imaginary */
{
int inex_sin_im = 0, inex_cos_re = 0;
/* assume exact if not computed */
int overlap;
mpc_t op_loc;
overlap = (rop_sin == op || rop_cos == op);
if (overlap) {
mpc_init3 (op_loc, MPC_PREC_RE (op), MPC_PREC_IM (op));
mpc_set (op_loc, op, MPC_RNDNN);
}
else
op_loc [0] = op [0];
if (rop_sin != NULL) {
/* sin(+-O +i*y) = +-0 +i*sinh(y) */
mpfr_set (MPC_RE(rop_sin), MPC_RE(op_loc), GMP_RNDN);
inex_sin_im = mpfr_sinh (MPC_IM(rop_sin), MPC_IM(op_loc), MPC_RND_IM(rnd_sin));
}
if (rop_cos != NULL) {
/* cos(-0 - i * y) = cos(+0 + i * y) = cosh(y) - i * 0,
cos(-0 + i * y) = cos(+0 - i * y) = cosh(y) + i * 0,
where y >= 0 */
if (mpfr_zero_p (MPC_IM (op_loc)))
inex_cos_re = mpfr_set_ui (MPC_RE (rop_cos), 1ul, MPC_RND_RE (rnd_cos));
else
inex_cos_re = mpfr_cosh (MPC_RE (rop_cos), MPC_IM (op_loc), MPC_RND_RE (rnd_cos));
mpfr_set_ui (MPC_IM (rop_cos), 0ul, MPC_RND_IM (rnd_cos));
if (mpfr_signbit (MPC_RE (op_loc)) == mpfr_signbit (MPC_IM (op_loc)))
MPFR_CHANGE_SIGN (MPC_IM (rop_cos));
}
if (overlap)
mpc_clear (op_loc);
return MPC_INEX12 (MPC_INEX (0, inex_sin_im), MPC_INEX (inex_cos_re, 0));
}
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);
}
/* put in rop the value of exp(2*i*pi*k/n) rounded according to rnd */
int
mpc_rootofunity (mpc_ptr rop, unsigned long n, unsigned long k, mpc_rnd_t rnd)
{
unsigned long g;
mpq_t kn;
mpfr_t t, s, c;
mpfr_prec_t prec;
int inex_re, inex_im;
mpfr_rnd_t rnd_re, rnd_im;
if (n == 0) {
/* Compute exp (0 + i*inf). */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX (0, 0);
}
/* Eliminate common denominator. */
k %= n;
g = gcd (k, n);
k /= g;
n /= g;
/* Now 0 <= k < n and gcd(k,n)=1. */
/* We assume that only n=1, 2, 3, 4, 6 and 12 may yield exact results
and treat them separately; n=8 is also treated here for efficiency
reasons. */
if (n == 1)
{
/* necessarily k=0 thus we want exp(0)=1 */
MPC_ASSERT (k == 0);
return mpc_set_ui_ui (rop, 1, 0, rnd);
}
else if (n == 2)
{
/* since gcd(k,n)=1, necessarily k=1, thus we want exp(i*pi)=-1 */
MPC_ASSERT (k == 1);
return mpc_set_si_si (rop, -1, 0, rnd);
}
else if (n == 4)
{
/* since gcd(k,n)=1, necessarily k=1 or k=3, thus we want
exp(2*i*pi/4)=i or exp(2*i*pi*3/4)=-i */
MPC_ASSERT (k == 1 || k == 3);
if (k == 1)
return mpc_set_ui_ui (rop, 0, 1, rnd);
else
return mpc_set_si_si (rop, 0, -1, rnd);
}
else if (n == 3 || n == 6)
{
MPC_ASSERT ((n == 3 && (k == 1 || k == 2)) ||
(n == 6 && (k == 1 || k == 5)));
/* for n=3, necessarily k=1 or k=2: -1/2+/-1/2*sqrt(3)*i;
for n=6, necessarily k=1 or k=5: 1/2+/-1/2*sqrt(3)*i */
inex_re = mpfr_set_si (mpc_realref (rop), (n == 3 ? -1 : 1),
MPC_RND_RE (rnd));
/* inverse the rounding mode for -sqrt(3)/2 for zeta_3^2 and zeta_6^5 */
rnd_im = MPC_RND_IM (rnd);
if (k != 1)
rnd_im = INV_RND (rnd_im);
inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 3, rnd_im);
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k != 1)
{
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
inex_im = -inex_im;
}
return MPC_INEX (inex_re, inex_im);
}
else if (n == 12)
{
/* necessarily k=1, 5, 7, 11:
k=1: 1/2*sqrt(3) + 1/2*I
k=5: -1/2*sqrt(3) + 1/2*I
k=7: -1/2*sqrt(3) - 1/2*I
k=11: 1/2*sqrt(3) - 1/2*I */
MPC_ASSERT (k == 1 || k == 5 || k == 7 || k == 11);
/* inverse the rounding mode for -sqrt(3)/2 for zeta_12^5 and zeta_12^7 */
rnd_re = MPC_RND_RE (rnd);
if (k == 5 || k == 7)
rnd_re = INV_RND (rnd_re);
inex_re = mpfr_sqrt_ui (mpc_realref (rop), 3, rnd_re);
inex_im = mpfr_set_si (mpc_imagref (rop), k < 6 ? 1 : -1,
MPC_RND_IM (rnd));
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k == 5 || k == 7)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = -inex_re;
}
return MPC_INEX (inex_re, inex_im);
}
else if (n == 8)
{
/* k=1, 3, 5 or 7:
k=1: (1/2*I + 1/2)*sqrt(2)
k=3: (1/2*I - 1/2)*sqrt(2)
k=5: -(1/2*I + 1/2)*sqrt(2)
k=7: -(1/2*I - 1/2)*sqrt(2) */
MPC_ASSERT (k == 1 || k == 3 || k == 5 || k == 7);
rnd_re = MPC_RND_RE (rnd);
if (k == 3 || k == 5)
rnd_re = INV_RND (rnd_re);
rnd_im = MPC_RND_IM (rnd);
if (k > 4)
rnd_im = INV_RND (rnd_im);
inex_re = mpfr_sqrt_ui (mpc_realref (rop), 2, rnd_re);
inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 2, rnd_im);
mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
if (k == 3 || k == 5)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = -inex_re;
}
if (k > 4)
{
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
inex_im = -inex_im;
}
return MPC_INEX (inex_re, inex_im);
}
prec = MPC_MAX_PREC(rop);
/* For the error analysis justifying the following algorithm,
see algorithms.tex. */
mpfr_init2 (t, 67);
mpfr_init2 (s, 67);
mpfr_init2 (c, 67);
mpq_init (kn);
mpq_set_ui (kn, k, n);
mpq_mul_2exp (kn, kn, 1); /* kn=2*k/n < 2 */
do {
prec += mpc_ceil_log2 (prec) + 5; /* prec >= 6 */
mpfr_set_prec (t, prec);
mpfr_set_prec (s, prec);
mpfr_set_prec (c, prec);
mpfr_const_pi (t, MPFR_RNDN);
mpfr_mul_q (t, t, kn, MPFR_RNDN);
mpfr_sin_cos (s, c, t, MPFR_RNDN);
}
while ( !mpfr_can_round (c, prec - (4 - mpfr_get_exp (c)),
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN))
|| !mpfr_can_round (s, prec - (4 - mpfr_get_exp (s)),
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN)));
inex_re = mpfr_set (mpc_realref(rop), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), s, MPC_RND_IM(rnd));
mpfr_clear (t);
mpfr_clear (s);
mpfr_clear (c);
mpq_clear (kn);
return MPC_INEX(inex_re, inex_im);
}
static int
mpc_sin_cos_nonfinite (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* assumes that op (that is, its real or imaginary part) is not finite */
{
int overlap;
mpc_t op_loc;
overlap = (rop_sin == op || rop_cos == op);
if (overlap) {
mpc_init3 (op_loc, MPC_PREC_RE (op), MPC_PREC_IM (op));
mpc_set (op_loc, op, MPC_RNDNN);
}
else
op_loc [0] = op [0];
if (rop_sin != NULL) {
if (mpfr_nan_p (MPC_RE (op_loc)) || mpfr_nan_p (MPC_IM (op_loc))) {
mpc_set (rop_sin, op_loc, rnd_sin);
if (mpfr_nan_p (MPC_IM (op_loc))) {
/* sin(x +i*NaN) = NaN +i*NaN, except for x=0 */
/* sin(-0 +i*NaN) = -0 +i*NaN */
/* sin(+0 +i*NaN) = +0 +i*NaN */
if (!mpfr_zero_p (MPC_RE (op_loc)))
mpfr_set_nan (MPC_RE (rop_sin));
}
else /* op = NaN + i*y */
if (!mpfr_inf_p (MPC_IM (op_loc)) && !mpfr_zero_p (MPC_IM (op_loc)))
/* sin(NaN -i*Inf) = NaN -i*Inf */
/* sin(NaN -i*0) = NaN -i*0 */
/* sin(NaN +i*0) = NaN +i*0 */
/* sin(NaN +i*Inf) = NaN +i*Inf */
/* sin(NaN +i*y) = NaN +i*NaN, when 0<|y|<Inf */
mpfr_set_nan (MPC_IM (rop_sin));
}
else if (mpfr_inf_p (MPC_RE (op_loc))) {
mpfr_set_nan (MPC_RE (rop_sin));
if (!mpfr_inf_p (MPC_IM (op_loc)) && !mpfr_zero_p (MPC_IM (op_loc)))
/* sin(+/-Inf +i*y) = NaN +i*NaN, when 0<|y|<Inf */
mpfr_set_nan (MPC_IM (rop_sin));
else
/* sin(+/-Inf -i*Inf) = NaN -i*Inf */
/* sin(+/-Inf +i*Inf) = NaN +i*Inf */
/* sin(+/-Inf -i*0) = NaN -i*0 */
/* sin(+/-Inf +i*0) = NaN +i*0 */
mpfr_set (MPC_IM (rop_sin), MPC_IM (op_loc), MPC_RND_IM (rnd_sin));
}
else if (mpfr_zero_p (MPC_RE (op_loc))) {
/* sin(-0 -i*Inf) = -0 -i*Inf */
/* sin(+0 -i*Inf) = +0 -i*Inf */
/* sin(-0 +i*Inf) = -0 +i*Inf */
/* sin(+0 +i*Inf) = +0 +i*Inf */
mpc_set (rop_sin, op_loc, rnd_sin);
}
else {
/* sin(x -i*Inf) = +Inf*(sin(x) -i*cos(x)) */
/* sin(x +i*Inf) = +Inf*(sin(x) +i*cos(x)) */
mpfr_t s, c;
mpfr_init2 (s, 2);
mpfr_init2 (c, 2);
mpfr_sin_cos (s, c, MPC_RE (op_loc), GMP_RNDZ);
mpfr_set_inf (MPC_RE (rop_sin), MPFR_SIGN (s));
mpfr_set_inf (MPC_IM (rop_sin), MPFR_SIGN (c)*MPFR_SIGN (MPC_IM (op_loc)));
mpfr_clear (s);
mpfr_clear (c);
}
}
if (rop_cos != NULL) {
if (mpfr_nan_p (MPC_RE (op_loc))) {
/* cos(NaN + i * NaN) = NaN + i * NaN */
/* cos(NaN - i * Inf) = +Inf + i * NaN */
/* cos(NaN + i * Inf) = +Inf + i * NaN */
/* cos(NaN - i * 0) = NaN - i * 0 */
/* cos(NaN + i * 0) = NaN + i * 0 */
/* cos(NaN + i * y) = NaN + i * NaN, when y != 0 */
if (mpfr_inf_p (MPC_IM (op_loc)))
mpfr_set_inf (MPC_RE (rop_cos), +1);
else
mpfr_set_nan (MPC_RE (rop_cos));
if (mpfr_zero_p (MPC_IM (op_loc)))
mpfr_set (MPC_IM (rop_cos), MPC_IM (op_loc), MPC_RND_IM (rnd_cos));
else
mpfr_set_nan (MPC_IM (rop_cos));
}
else if (mpfr_nan_p (MPC_IM (op_loc))) {
/* cos(-Inf + i * NaN) = NaN + i * NaN */
/* cos(+Inf + i * NaN) = NaN + i * NaN */
/* cos(-0 + i * NaN) = NaN - i * 0 */
/* cos(+0 + i * NaN) = NaN + i * 0 */
/* cos(x + i * NaN) = NaN + i * NaN, when x != 0 */
if (mpfr_zero_p (MPC_RE (op_loc)))
mpfr_set (MPC_IM (rop_cos), MPC_RE (op_loc), MPC_RND_IM (rnd_cos));
else
mpfr_set_nan (MPC_IM (rop_cos));
mpfr_set_nan (MPC_RE (rop_cos));
}
else if (mpfr_inf_p (MPC_RE (op_loc))) {
/* cos(-Inf -i*Inf) = cos(+Inf +i*Inf) = -Inf +i*NaN */
/* cos(-Inf +i*Inf) = cos(+Inf -i*Inf) = +Inf +i*NaN */
/* cos(-Inf -i*0) = cos(+Inf +i*0) = NaN -i*0 */
/* cos(-Inf +i*0) = cos(+Inf -i*0) = NaN +i*0 */
/* cos(-Inf +i*y) = cos(+Inf +i*y) = NaN +i*NaN, when y != 0 */
const int same_sign =
mpfr_signbit (MPC_RE (op_loc)) == mpfr_signbit (MPC_IM (op_loc));
if (mpfr_inf_p (MPC_IM (op_loc)))
mpfr_set_inf (MPC_RE (rop_cos), (same_sign ? -1 : +1));
else
mpfr_set_nan (MPC_RE (rop_cos));
if (mpfr_zero_p (MPC_IM (op_loc)))
mpfr_setsign (MPC_IM (rop_cos), MPC_IM (op_loc), same_sign,
MPC_RND_IM(rnd_cos));
else
mpfr_set_nan (MPC_IM (rop_cos));
}
else if (mpfr_zero_p (MPC_RE (op_loc))) {
/* cos(-0 -i*Inf) = cos(+0 +i*Inf) = +Inf -i*0 */
/* cos(-0 +i*Inf) = cos(+0 -i*Inf) = +Inf +i*0 */
const int same_sign =
mpfr_signbit (MPC_RE (op_loc)) == mpfr_signbit (MPC_IM (op_loc));
mpfr_setsign (MPC_IM (rop_cos), MPC_RE (op_loc), same_sign,
MPC_RND_IM (rnd_cos));
mpfr_set_inf (MPC_RE (rop_cos), +1);
}
else {
/* cos(x -i*Inf) = +Inf*cos(x) +i*Inf*sin(x), when x != 0 */
/* cos(x +i*Inf) = +Inf*cos(x) -i*Inf*sin(x), when x != 0 */
mpfr_t s, c;
mpfr_init2 (c, 2);
mpfr_init2 (s, 2);
mpfr_sin_cos (s, c, MPC_RE (op_loc), GMP_RNDN);
mpfr_set_inf (MPC_RE (rop_cos), mpfr_sgn (c));
mpfr_set_inf (MPC_IM (rop_cos),
(mpfr_sgn (MPC_IM (op_loc)) == mpfr_sgn (s) ? -1 : +1));
mpfr_clear (s);
mpfr_clear (c);
}
}
if (overlap)
mpc_clear (op_loc);
return MPC_INEX12 (MPC_INEX (0,0), MPC_INEX (0,0));
/* everything is exact */
}
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
mpc_sin_cos (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* Feature not documented in the texinfo file: One of rop_sin or
rop_cos may be NULL, in which case it is not computed, and the
corresponding ternary inexact value is set to 0 (exact). */
{
if (!mpc_fin_p (op))
return mpc_sin_cos_nonfinite (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else if (mpfr_zero_p (MPC_IM (op)))
return mpc_sin_cos_real (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else if (mpfr_zero_p (MPC_RE (op)))
return mpc_sin_cos_imag (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else {
/* let op = a + i*b, then sin(op) = sin(a)*cosh(b) + i*cos(a)*sinh(b)
and cos(op) = cos(a)*cosh(b) - i*sin(a)*sinh(b).
For Re(sin(op)) (and analogously, the other parts), we use the
following algorithm, with rounding to nearest for all operations
and working precision w:
(1) x = o(sin(a))
(2) y = o(cosh(b))
(3) r = o(x*y)
then the error on r is at most 4 ulps, since we can write
r = sin(a)*cosh(b)*(1+t)^3 with |t| <= 2^(-w),
thus for w >= 2, r = sin(a)*cosh(b)*(1+4*t) with |t| <= 2^(-w),
thus the relative error is bounded by 4*2^(-w) <= 4*ulp(r).
*/
mpfr_t s, c, sh, ch, sch, csh;
mpfr_prec_t prec;
int ok;
int inex_re, inex_im, inex_sin, inex_cos;
prec = 2;
if (rop_sin != NULL)
prec = MPC_MAX (prec, MPC_MAX_PREC (rop_sin));
if (rop_cos != NULL)
prec = MPC_MAX (prec, MPC_MAX_PREC (rop_cos));
mpfr_init2 (s, 2);
mpfr_init2 (c, 2);
mpfr_init2 (sh, 2);
mpfr_init2 (ch, 2);
mpfr_init2 (sch, 2);
mpfr_init2 (csh, 2);
do {
ok = 1;
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (s, prec);
mpfr_set_prec (c, prec);
mpfr_set_prec (sh, prec);
mpfr_set_prec (ch, prec);
mpfr_set_prec (sch, prec);
mpfr_set_prec (csh, prec);
mpfr_sin_cos (s, c, MPC_RE(op), GMP_RNDN);
mpfr_sinh_cosh (sh, ch, MPC_IM(op), GMP_RNDN);
if (rop_sin != NULL) {
/* real part of sine */
mpfr_mul (sch, s, ch, GMP_RNDN);
ok = (!mpfr_number_p (sch))
|| mpfr_can_round (sch, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE (rop_sin)
+ (MPC_RND_RE (rnd_sin) == GMP_RNDN));
if (ok) {
/* imaginary part of sine */
mpfr_mul (csh, c, sh, GMP_RNDN);
ok = (!mpfr_number_p (csh))
|| mpfr_can_round (csh, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM (rop_sin)
+ (MPC_RND_IM (rnd_sin) == GMP_RNDN));
}
}
if (rop_cos != NULL && ok) {
/* real part of cosine */
mpfr_mul (c, c, ch, GMP_RNDN);
ok = (!mpfr_number_p (c))
|| mpfr_can_round (c, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE (rop_cos)
+ (MPC_RND_RE (rnd_cos) == GMP_RNDN));
if (ok) {
/* imaginary part of cosine */
mpfr_mul (s, s, sh, GMP_RNDN);
mpfr_neg (s, s, GMP_RNDN);
ok = (!mpfr_number_p (s))
|| mpfr_can_round (s, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM (rop_cos)
+ (MPC_RND_IM (rnd_cos) == GMP_RNDN));
}
}
} while (ok == 0);
if (rop_sin != NULL) {
inex_re = mpfr_set (MPC_RE (rop_sin), sch, MPC_RND_RE (rnd_sin));
if (mpfr_inf_p (sch))
inex_re = mpfr_sgn (sch);
inex_im = mpfr_set (MPC_IM (rop_sin), csh, MPC_RND_IM (rnd_sin));
if (mpfr_inf_p (csh))
inex_im = mpfr_sgn (csh);
inex_sin = MPC_INEX (inex_re, inex_im);
}
else
inex_sin = MPC_INEX (0,0); /* return exact if not computed */
if (rop_cos != NULL) {
inex_re = mpfr_set (MPC_RE (rop_cos), c, MPC_RND_RE (rnd_cos));
if (mpfr_inf_p (c))
inex_re = mpfr_sgn (c);
inex_im = mpfr_set (MPC_IM (rop_cos), s, MPC_RND_IM (rnd_cos));
if (mpfr_inf_p (s))
inex_im = mpfr_sgn (s);
inex_cos = MPC_INEX (inex_re, inex_im);
}
else
inex_cos = MPC_INEX (0,0); /* return exact if not computed */
mpfr_clear (s);
mpfr_clear (c);
mpfr_clear (sh);
mpfr_clear (ch);
mpfr_clear (sch);
mpfr_clear (csh);
return (MPC_INEX12 (inex_sin, inex_cos));
}
}
int
mpc_exp (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_t x, y, z;
mpfr_prec_t prec;
int ok = 0;
int inex_re, inex_im;
int saved_underflow, saved_overflow;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
/* NaNs
exp(nan +i*y) = nan -i*0 if y = -0,
nan +i*0 if y = +0,
nan +i*nan otherwise
exp(x+i*nan) = +/-0 +/-i*0 if x=-inf,
+/-inf +i*nan if x=+inf,
nan +i*nan otherwise */
{
if (mpfr_zero_p (mpc_imagref (op)))
return mpc_set (rop, op, MPC_RNDNN);
if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_signbit (mpc_realref (op)))
return mpc_set_ui_ui (rop, 0, 0, MPC_RNDNN);
else
{
mpfr_set_inf (mpc_realref (rop), +1);
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* Inf/NaN are exact */
}
}
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
if (mpfr_zero_p (mpc_imagref(op)))
/* special case when the input is real
exp(x-i*0) = exp(x) -i*0, even if x is NaN
exp(x+i*0) = exp(x) +i*0, even if x is NaN */
{
inex_re = mpfr_exp (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref(op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref (op)))
/* special case when the input is imaginary */
{
inex_re = mpfr_cos (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE(rnd));
inex_im = mpfr_sin (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_realref (op)))
/* real part is an infinity,
exp(-inf +i*y) = 0*(cos y +i*sin y)
exp(+inf +i*y) = +/-inf +i*nan if y = +/-inf
+inf*(cos y +i*sin y) if 0 < |y| < inf */
{
mpfr_t n;
mpfr_init2 (n, 2);
if (mpfr_signbit (mpc_realref (op)))
mpfr_set_ui (n, 0, GMP_RNDN);
else
mpfr_set_inf (n, +1);
if (mpfr_inf_p (mpc_imagref (op)))
{
inex_re = mpfr_set (mpc_realref (rop), n, GMP_RNDN);
if (mpfr_signbit (mpc_realref (op)))
inex_im = mpfr_set (mpc_imagref (rop), n, GMP_RNDN);
else
{
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* NaN is exact */
}
}
else
{
mpfr_t c, s;
mpfr_init2 (c, 2);
mpfr_init2 (s, 2);
mpfr_sin_cos (s, c, mpc_imagref (op), GMP_RNDN);
inex_re = mpfr_copysign (mpc_realref (rop), n, c, GMP_RNDN);
inex_im = mpfr_copysign (mpc_imagref (rop), n, s, GMP_RNDN);
mpfr_clear (s);
mpfr_clear (c);
}
mpfr_clear (n);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_imagref (op)))
/* real part is finite non-zero number, imaginary part is an infinity */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
/* from now on, both parts of op are regular numbers */
prec = MPC_MAX_PREC(rop)
+ MPC_MAX (MPC_MAX (-mpfr_get_exp (mpc_realref (op)), 0),
-mpfr_get_exp (mpc_imagref (op)));
/* When op is close to 0, then exp is close to 1+Re(op), while
cos is close to 1-Im(op); to decide on the ternary value of exp*cos,
we need a high enough precision so that none of exp or cos is
computed as 1. */
mpfr_init2 (x, 2);
mpfr_init2 (y, 2);
mpfr_init2 (z, 2);
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
/* FIXME: x may overflow so x.y does overflow too, while Re(exp(op))
could be represented in the precision of rop. */
mpfr_clear_overflow ();
mpfr_clear_underflow ();
mpfr_exp (x, mpc_realref(op), GMP_RNDN); /* error <= 0.5ulp */
mpfr_sin_cos (z, y, mpc_imagref(op), GMP_RNDN); /* errors <= 0.5ulp */
mpfr_mul (y, y, x, GMP_RNDN); /* error <= 2ulp */
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (y, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == GMP_RNDN));
if (ok) /* compute imaginary part */
{
mpfr_mul (z, z, x, GMP_RNDN);
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (z, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == GMP_RNDN));
}
}
while (ok == 0);
inex_re = mpfr_set (mpc_realref(rop), y, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), z, MPC_RND_IM(rnd));
if (mpfr_overflow_p ()) {
/* overflow in real exponential, inex is sign of infinite result */
inex_re = mpfr_sgn (y);
inex_im = mpfr_sgn (z);
}
else if (mpfr_underflow_p ()) {
/* underflow in real exponential, inex is opposite of sign of 0 result */
inex_re = (mpfr_signbit (y) ? +1 : -1);
inex_im = (mpfr_signbit (z) ? +1 : -1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX(inex_re, inex_im);
}
void
mpc_get_prec2 (mpfr_prec_t *pr, mpfr_prec_t *pi, mpc_srcptr x)
{
*pr = MPC_PREC_RE (x);
*pi = MPC_PREC_IM (x);
}
int
mpc_tan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpc_t x, y;
mpfr_prec_t prec;
mpfr_exp_t err;
int ok = 0;
int inex;
/* special values */
if (!mpc_fin_p (op))
{
if (mpfr_nan_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(NaN -i*Inf) = +/-0 -i */
/* tan(NaN +i*Inf) = +/-0 +i */
{
/* exact unless 1 is not in exponent range */
inex = mpc_set_si_si (rop, 0,
(MPFR_SIGN (mpc_imagref (op)) < 0) ? -1 : +1,
rnd);
}
else
/* tan(NaN +i*y) = NaN +i*NaN, when y is finite */
/* tan(NaN +i*NaN) = NaN +i*NaN */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_cmp_ui (mpc_realref (op), 0) == 0)
/* tan(-0 +i*NaN) = -0 +i*NaN */
/* tan(+0 +i*NaN) = +0 +i*NaN */
{
mpc_set (rop, op, rnd);
inex = MPC_INEX (0, 0); /* always exact */
}
else
/* tan(x +i*NaN) = NaN +i*NaN, when x != 0 */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(-Inf -i*Inf) = -/+0 -i */
/* tan(-Inf +i*Inf) = -/+0 +i */
/* tan(+Inf -i*Inf) = +/-0 -i */
/* tan(+Inf +i*Inf) = +/-0 +i */
{
const int sign_re = mpfr_signbit (mpc_realref (op));
int inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop), sign_re, MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
mpfr_signbit (mpc_imagref (op)) ? -1 : +1,
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
}
else
/* tan(-Inf +i*y) = tan(+Inf +i*y) = NaN +i*NaN, when y is
finite */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else
/* tan(x -i*Inf) = +0*sin(x)*cos(x) -i, when x is finite */
/* tan(x +i*Inf) = +0*sin(x)*cos(x) +i, when x is finite */
{
mpfr_t c;
mpfr_t s;
int inex_im;
mpfr_init (c);
mpfr_init (s);
mpfr_sin_cos (s, c, mpc_realref (op), MPFR_RNDN);
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop),
mpfr_signbit (c) != mpfr_signbit (s), MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
(mpfr_signbit (mpc_imagref (op)) ? -1 : +1),
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
mpfr_clear (s);
mpfr_clear (c);
}
return inex;
}
if (mpfr_zero_p (mpc_realref (op)))
/* tan(-0 -i*y) = -0 +i*tanh(y), when y is finite. */
/* tan(+0 +i*y) = +0 +i*tanh(y), when y is finite. */
{
int inex_im;
mpfr_set (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_tanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
if (mpfr_zero_p (mpc_imagref (op)))
/* tan(x -i*0) = tan(x) -i*0, when x is finite. */
/* tan(x +i*0) = tan(x) +i*0, when x is finite. */
{
int inex_re;
inex_re = mpfr_tan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (inex_re, 0);
}
/* ordinary (non-zero) numbers */
/* tan(op) = sin(op) / cos(op).
We use the following algorithm with rounding away from 0 for all
operations, and working precision w:
(1) x = A(sin(op))
(2) y = A(cos(op))
(3) z = A(x/y)
the error on Im(z) is at most 81 ulp,
the error on Re(z) is at most
7 ulp if k < 2,
8 ulp if k = 2,
else 5+k ulp, where
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
see proof in algorithms.tex.
*/
prec = MPC_MAX_PREC(rop);
mpc_init2 (x, 2);
mpc_init2 (y, 2);
err = 7;
do
{
mpfr_exp_t k, exr, eyr, eyi, ezr;
ok = 0;
/* FIXME: prevent addition overflow */
prec += mpc_ceil_log2 (prec) + err;
mpc_set_prec (x, prec);
mpc_set_prec (y, prec);
/* rounding away from zero: except in the cases x=0 or y=0 (processed
above), sin x and cos y are never exact, so rounding away from 0 is
rounding towards 0 and adding one ulp to the absolute value */
mpc_sin_cos (x, y, op, MPC_RNDZZ, MPC_RNDZZ);
MPFR_ADD_ONE_ULP (mpc_realref (x));
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPFR_ADD_ONE_ULP (mpc_realref (y));
MPFR_ADD_ONE_ULP (mpc_imagref (y));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
if ( mpfr_inf_p (mpc_realref (x)) || mpfr_inf_p (mpc_imagref (x))
|| mpfr_inf_p (mpc_realref (y)) || mpfr_inf_p (mpc_imagref (y))) {
/* If the real or imaginary part of x is infinite, it means that
Im(op) was large, in which case the result is
sign(tan(Re(op)))*0 + sign(Im(op))*I,
where sign(tan(Re(op))) = sign(Re(x))*sign(Re(y)). */
int inex_re, inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
if (mpfr_sgn (mpc_realref (x)) * mpfr_sgn (mpc_realref (y)) < 0)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = 1;
}
else
inex_re = -1; /* +0 is rounded down */
if (mpfr_sgn (mpc_imagref (op)) > 0)
{
mpfr_set_ui (mpc_imagref (rop), 1, MPFR_RNDN);
inex_im = 1;
}
else
{
mpfr_set_si (mpc_imagref (rop), -1, MPFR_RNDN);
inex_im = -1;
}
inex = MPC_INEX(inex_re, inex_im);
goto end;
}
exr = mpfr_get_exp (mpc_realref (x));
eyr = mpfr_get_exp (mpc_realref (y));
eyi = mpfr_get_exp (mpc_imagref (y));
/* some parts of the quotient may be exact */
inex = mpc_div (x, x, y, MPC_RNDZZ);
/* OP is no pure real nor pure imaginary, so in theory the real and
imaginary parts of its tangent cannot be null. However due to
rouding errors this might happen. Consider for example
tan(1+14*I) = 1.26e-10 + 1.00*I. For small precision sin(op) and
cos(op) differ only by a factor I, thus after mpc_div x = I and
its real part is zero. */
if (mpfr_zero_p (mpc_realref (x)) || mpfr_zero_p (mpc_imagref (x)))
{
err = prec; /* double precision */
continue;
}
if (MPC_INEX_RE (inex))
MPFR_ADD_ONE_ULP (mpc_realref (x));
if (MPC_INEX_IM (inex))
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
ezr = mpfr_get_exp (mpc_realref (x));
/* FIXME: compute
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
avoiding overflow */
k = exr - ezr + MPC_MAX(-eyr, eyr - 2 * eyi);
err = k < 2 ? 7 : (k == 2 ? 8 : (5 + k));
/* Can the real part be rounded? */
ok = (!mpfr_number_p (mpc_realref (x)))
|| mpfr_can_round (mpc_realref(x), prec - err, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN));
if (ok)
{
/* Can the imaginary part be rounded? */
ok = (!mpfr_number_p (mpc_imagref (x)))
|| mpfr_can_round (mpc_imagref(x), prec - 6, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN));
}
}
while (ok == 0);
inex = mpc_set (rop, x, rnd);
end:
mpc_clear (x);
mpc_clear (y);
return inex;
}
mpfr_prec_t
mpc_get_prec (mpc_srcptr x)
{
mpfr_prec_t precre = MPC_PREC_RE (x);
return (MPC_PREC_IM (x) == precre ? precre : 0);
}
static void
check_file (const char* file_name)
{
FILE *fp;
int tmp;
int base;
int inex_re;
int inex_im;
mpc_t expected, got;
mpc_rnd_t rnd = MPC_RNDNN;
int inex = 0, expected_inex;
size_t expected_size, size;
known_signs_t ks = {1, 1};
fp = open_data_file (file_name);
mpc_init2 (expected, 53);
mpc_init2 (got, 53);
/* read data file */
line_number = 1;
nextchar = getc (fp);
skip_whitespace_comments (fp);
while (nextchar != EOF)
{
/* 1. read a line of data: expected result, base, rounding mode */
read_ternary (fp, &inex_re);
read_ternary (fp, &inex_im);
read_mpc (fp, expected, &ks);
if (inex_re == TERNARY_ERROR || inex_im == TERNARY_ERROR)
expected_inex = -1;
else
expected_inex = MPC_INEX (inex_re, inex_im);
read_int (fp, &tmp, "size");
expected_size = (size_t)tmp;
read_int (fp, &base, "base");
read_mpc_rounding_mode (fp, &rnd);
/* 2. read string at the same precision as the expected result */
while (nextchar != '"')
nextchar = getc (fp);
mpfr_set_prec (MPC_RE (got), MPC_PREC_RE (expected));
mpfr_set_prec (MPC_IM (got), MPC_PREC_IM (expected));
inex = mpc_inp_str (got, fp, &size, base, rnd);
/* 3. compare this result with the expected one */
if (inex != expected_inex || !same_mpc_value (got, expected, ks)
|| size != expected_size)
{
printf ("mpc_inp_str failed (line %lu) with rounding mode %s\n",
line_number, rnd_mode[rnd]);
if (inex != expected_inex)
printf(" got inexact value: %d\nexpected inexact value: %d\n",
inex, expected_inex);
if (size != expected_size)
printf (" got size: %lu\nexpected size: %lu\n ",
(unsigned long int) size, (unsigned long int) expected_size);
printf (" ");
OUT (got);
OUT (expected);
exit (1);
}
while ((nextchar = getc (fp)) != '"');
nextchar = getc (fp);
skip_whitespace_comments (fp);
}
mpc_clear (expected);
mpc_clear (got);
close_data_file (fp);
}
