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_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 ( MPFR_PREC (MPC_RE (b)) == MPFR_PREC (MPC_IM (a))
&& MPFR_PREC (MPC_IM (b)) == MPFR_PREC (MPC_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, MPFR_PREC (MPC_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 int
mpc_sin_cos_real (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 real */
{
int inex_sin_re = 0, inex_cos_re = 0;
/* Until further notice, assume computations exact; in particular,
by definition, for not computed values. */
mpfr_t s, c;
int inex_s, inex_c;
int sign_im_op = mpfr_signbit (MPC_IM (op));
/* sin(x +-0*i) = sin(x) +-0*i*sign(cos(x)) */
/* cos(x +-i*0) = cos(x) -+i*0*sign(sin(x)) */
if (rop_sin != 0)
mpfr_init2 (s, MPC_PREC_RE (rop_sin));
else
mpfr_init2 (s, 2); /* We need only the sign. */
if (rop_cos != NULL)
mpfr_init2 (c, MPC_PREC_RE (rop_cos));
else
mpfr_init2 (c, 2);
inex_s = mpfr_sin (s, MPC_RE (op), MPC_RND_RE (rnd_sin));
inex_c = mpfr_cos (c, MPC_RE (op), MPC_RND_RE (rnd_cos));
/* We cannot use mpfr_sin_cos since we may need two distinct rounding
modes and the exact return values. If we need only the sign, an
arbitrary rounding mode will work. */
if (rop_sin != NULL) {
mpfr_set (MPC_RE (rop_sin), s, GMP_RNDN); /* exact */
inex_sin_re = inex_s;
mpfr_set_ui (MPC_IM (rop_sin), 0ul, GMP_RNDN);
if ( ( sign_im_op && !mpfr_signbit (c))
|| (!sign_im_op && mpfr_signbit (c)))
MPFR_CHANGE_SIGN (MPC_IM (rop_sin));
/* FIXME: simpler implementation with mpfr-3:
mpfr_set_zero (MPC_IM (rop_sin),
( ( mpfr_signbit (MPC_IM(op)) && !mpfr_signbit(c))
|| (!mpfr_signbit (MPC_IM(op)) && mpfr_signbit(c)) ? -1 : 1);
there is no need to use the variable sign_im_op then, needed now in
the case rop_sin == op */
}
if (rop_cos != NULL) {
mpfr_set (MPC_RE (rop_cos), c, GMP_RNDN); /* exact */
inex_cos_re = inex_c;
mpfr_set_ui (MPC_IM (rop_cos), 0ul, GMP_RNDN);
if ( ( sign_im_op && mpfr_signbit (s))
|| (!sign_im_op && !mpfr_signbit (s)))
MPFR_CHANGE_SIGN (MPC_IM (rop_cos));
/* FIXME: see previous MPFR_CHANGE_SIGN */
}
mpfr_clear (s);
mpfr_clear (c);
return MPC_INEX12 (MPC_INEX (inex_sin_re, 0), MPC_INEX (inex_cos_re, 0));
}
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_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_sin_cos_real (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 real */
{
int inex_sin_re = 0, inex_cos_re = 0;
/* Until further notice, assume computations exact; in particular,
by definition, for not computed values. */
mpfr_t s, c;
int inex_s, inex_c;
int sign_im = mpfr_signbit (mpc_imagref (op));
/* sin(x +-0*i) = sin(x) +-0*i*sign(cos(x)) */
/* cos(x +-i*0) = cos(x) -+i*0*sign(sin(x)) */
if (rop_sin != 0)
mpfr_init2 (s, MPC_PREC_RE (rop_sin));
else
mpfr_init2 (s, 2); /* We need only the sign. */
if (rop_cos != NULL)
mpfr_init2 (c, MPC_PREC_RE (rop_cos));
else
mpfr_init2 (c, 2);
inex_s = mpfr_sin (s, mpc_realref (op), MPC_RND_RE (rnd_sin));
inex_c = mpfr_cos (c, mpc_realref (op), MPC_RND_RE (rnd_cos));
/* We cannot use mpfr_sin_cos since we may need two distinct rounding
modes and the exact return values. If we need only the sign, an
arbitrary rounding mode will work. */
if (rop_sin != NULL) {
mpfr_set (mpc_realref (rop_sin), s, MPFR_RNDN); /* exact */
inex_sin_re = inex_s;
mpfr_set_zero (mpc_imagref (rop_sin),
( ( sign_im && !mpfr_signbit(c))
|| (!sign_im && mpfr_signbit(c)) ? -1 : 1));
}
if (rop_cos != NULL) {
mpfr_set (mpc_realref (rop_cos), c, MPFR_RNDN); /* exact */
inex_cos_re = inex_c;
mpfr_set_zero (mpc_imagref (rop_cos),
( ( sign_im && mpfr_signbit(s))
|| (!sign_im && !mpfr_signbit(s)) ? -1 : 1));
}
mpfr_clear (s);
mpfr_clear (c);
return MPC_INEX12 (MPC_INEX (inex_sin_re, 0), MPC_INEX (inex_cos_re, 0));
}
size_t
mpc_out_str (FILE *stream, int base, size_t n, mpc_srcptr op, mpc_rnd_t rnd) {
size_t size = 3; /* for '(', ' ' and ')' */
if (stream == NULL)
stream = stdout; /* fprintf does not allow NULL as first argument */
fprintf (stream, "(");
size += mpfr_out_str (stream, base, n, MPC_RE(op), MPC_RND_RE(rnd));
fprintf (stream, " ");
size += mpfr_out_str (stream, base, n, MPC_IM(op), MPC_RND_RE(rnd));
fprintf (stream, ")");
return size;
}
char *
mpc_get_str (int base, size_t n, mpc_srcptr op, mpc_rnd_t rnd)
{
size_t needed_size;
char *real_str;
char *imag_str;
char *complex_str = NULL;
if (base < 2 || base > 36)
return NULL;
real_str = get_pretty_str (base, n, MPC_RE (op), MPC_RND_RE (rnd));
imag_str = get_pretty_str (base, n, MPC_IM (op), MPC_RND_IM (rnd));
needed_size = strlen (real_str) + strlen (imag_str) + 4;
complex_str = mpc_alloc_str (needed_size);
MPC_ASSERT (complex_str != NULL);
strcpy (complex_str, "(");
strcat (complex_str, real_str);
strcat (complex_str, " ");
strcat (complex_str, imag_str);
strcat (complex_str, ")");
mpc_free_str (real_str);
mpc_free_str (imag_str);
return complex_str;
}
int
mpc_tanh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* tanh(op) = -i*tan(i*op) = conj(-i*tan(conj(-i*op))) */
mpc_t z;
mpc_t tan_z;
int inex;
/* z := conj(-i * op) and rop = conj(-i * tan(z)), in other words, we have
to switch real and imaginary parts. Let us set them without copying
significands. */
mpc_realref (z)[0] = mpc_imagref (op)[0];
mpc_imagref (z)[0] = mpc_realref (op)[0];
mpc_realref (tan_z)[0] = mpc_imagref (rop)[0];
mpc_imagref (tan_z)[0] = mpc_realref (rop)[0];
inex = mpc_tan (tan_z, z, MPC_RND (MPC_RND_IM (rnd), MPC_RND_RE (rnd)));
/* tan_z and rop parts share the same significands, copy the rest now. */
mpc_realref (rop)[0] = mpc_imagref (tan_z)[0];
mpc_imagref (rop)[0] = mpc_realref (tan_z)[0];
/* swap inexact flags for real and imaginary parts */
return MPC_INEX (MPC_INEX_IM (inex), MPC_INEX_RE (inex));
}
static PyObject *
GMPy_PyStr_From_MPC(MPC_Object *self, int base, int digits, CTXT_Object *context)
{
PyObject *tempreal = 0, *tempimag = 0, *result;
CHECK_CONTEXT(context);
if (!((base >= 2) && (base <= 62))) {
VALUE_ERROR("base must be in the interval [2,62]");
return NULL;
}
if ((digits < 0) || (digits == 1)) {
VALUE_ERROR("digits must be 0 or >= 2");
return NULL;
}
tempreal = mpfr_ascii(mpc_realref(self->c), base, digits,
MPC_RND_RE(GET_MPC_ROUND(context)));
tempimag = mpfr_ascii(mpc_imagref(self->c), base, digits,
MPC_RND_IM(GET_MPC_ROUND(context)));
if (!tempreal || !tempimag) {
Py_XDECREF(tempreal);
Py_XDECREF(tempimag);
return NULL;
}
result = Py_BuildValue("(NN)", tempreal, tempimag);
if (!result) {
Py_DECREF(tempreal);
Py_DECREF(tempimag);
}
return result;
}
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 int
mpc_div_real (mpc_ptr rop, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes z finite and w finite and non-zero, with imaginary part
of w a signed zero. */
{
int inex_re, inex_im;
/* 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));
/* warning: rop may overlap with z,w so treat the imaginary part first */
inex_im = mpfr_div (mpc_imagref(rop), mpc_imagref(z), mpc_realref(w), MPC_RND_IM(rnd));
inex_re = mpfr_div (mpc_realref(rop), mpc_realref(z), mpc_realref(w), MPC_RND_RE(rnd));
/* 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 (mpfr_zero_p (mpc_imagref (rop)))
mpfr_setsign (mpc_imagref (rop), mpc_imagref (rop), (zis != wrs && zrs == wis),
MPFR_RNDN);
return MPC_INEX(inex_re, inex_im);
}
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));
}
/* res <- x[0]*y[0] + ... + x[n-1]*y[n-1] */
int
mpc_dot (mpc_ptr res, const mpc_ptr *x, const mpc_ptr *y,
unsigned long n, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_ptr *t;
mpfr_t *z;
unsigned long i;
z = (mpfr_t *) malloc (2 * n * sizeof (mpfr_t));
MPC_ASSERT(z != NULL);
t = (mpfr_ptr *) malloc (2 * n * sizeof(mpfr_ptr));
MPC_ASSERT(t != NULL);
for (i = 0; i < 2 * n; i++)
t[i] = z[i];
/* we first store in z[i] the value of Re(x[i])*Re(y[i])
and in z[n+i] that of -Im(x[i])*Im(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_prec_t prec_y_max = MPC_MAX (prec_y_re, prec_y_im);
/* we allocate z[i] with prec_x_re + prec_y_max bits
so that the second loop below does not reallocate */
mpfr_init2 (z[i], prec_x_re + prec_y_max);
mpfr_set_prec (z[i], prec_x_re + prec_y_re);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
/* idem for z[n+i]: we allocate with prec_x_im + prec_y_max bits */
mpfr_init2 (z[n+i], prec_x_im + prec_y_max);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_im);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_neg (z[n+i], z[n+i], MPFR_RNDZ);
}
inex_re = mpfr_sum (mpc_realref (res), t, 2 * n, MPC_RND_RE (rnd));
/* we then store in z[i] the value of Re(x[i])*Im(y[i])
and in z[n+i] that of Im(x[i])*Re(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_set_prec (z[i], prec_x_re + prec_y_im);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_re);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
}
inex_im = mpfr_sum (mpc_imagref (res), t, 2 * n, MPC_RND_IM (rnd));
for (i = 0; i < 2 * n; i++)
mpfr_clear (z[i]);
free (t);
free (z);
return MPC_INEX(inex_re, inex_im);
}
static int
is_valid_mpc_rnd_mode (mpc_rnd_t rnd)
/* returns 1 if curr is a valid rounding mode, and 0 otherwise */
{
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd);
mpfr_rnd_t rnd_im = MPC_RND_IM (rnd);
return is_valid_mpfr_rnd_mode (rnd_re) && is_valid_mpfr_rnd_mode (rnd_im);
}
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));
}
/* 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);
}
/* return 0 iff both the real and imaginary parts are exact */
int
mpc_add_ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_add_ui (mpc_realref(a), mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(a), mpc_imagref(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
int
mpc_neg (mpc_ptr a, mpc_srcptr b, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_neg (MPC_RE(a), MPC_RE(b), MPC_RND_RE(rnd));
inex_im = mpfr_neg (MPC_IM(a), MPC_IM(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
/* return 0 iff both the real and imaginary parts are exact */
int
mpc_add_fr (mpc_ptr a, mpc_srcptr b, mpfr_srcptr c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_add (MPC_RE(a), MPC_RE(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (MPC_IM(a), MPC_IM(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
int
mpc_mul_ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_mul_ui (MPC_RE(a), MPC_RE(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_mul_ui (MPC_IM(a), MPC_IM(b), c, MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
/* this routine deals with the case where w is zero */
static int
mpc_div_zero (mpc_ptr a, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes w==0, implementation according to C99 G.5.1.8 */
{
int sign = MPFR_SIGNBIT (mpc_realref (w));
mpfr_t infty;
mpfr_init2 (infty, MPFR_PREC_MIN);
mpfr_set_inf (infty, sign);
mpfr_mul (mpc_realref (a), infty, mpc_realref (z), MPC_RND_RE (rnd));
mpfr_mul (mpc_imagref (a), infty, mpc_imagref (z), MPC_RND_IM (rnd));
mpfr_clear (infty);
return MPC_INEX (0, 0); /* exact */
}
static mpc_rnd_t
next_mpc_rnd_mode (mpc_rnd_t rnd)
{
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd);
mpfr_rnd_t rnd_im = MPC_RND_IM (rnd);
rnd_im = next_mpfr_rnd_mode (rnd_im);
if (!is_valid_mpfr_rnd_mode (rnd_im))
{
rnd_re = next_mpfr_rnd_mode (rnd_re);
rnd_im = FIRST_MPFR_RND_MODE;
}
return MPC_RND(rnd_re, rnd_im);
}
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);
}
int
mpc_mul_fr (mpc_ptr a, mpc_srcptr b, mpfr_srcptr c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_t real;
if (c == mpc_realref (a))
/* We have to use a temporary variable. */
mpfr_init2 (real, MPC_PREC_RE (a));
else
real [0] = mpc_realref (a) [0];
inex_re = mpfr_mul (real, mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_mul (mpc_imagref(a), mpc_imagref(b), c, MPC_RND_IM(rnd));
mpfr_set (mpc_realref (a), real, GMP_RNDN); /* exact */
if (c == mpc_realref (a))
mpfr_clear (real);
return MPC_INEX(inex_re, inex_im);
}
static void
cmpmul (mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
/* computes the product of x and y with the naive and Karatsuba methods */
/* using the rounding mode rnd and compares the results and return */
/* values. */
/* In our current test suite, the real and imaginary parts of x and y */
/* all have the same precision, and we use this precision also for the */
/* result. */
{
mpc_t z, t;
int inex_z, inex_t;
mpc_init2 (z, MPC_MAX_PREC (x));
mpc_init2 (t, MPC_MAX_PREC (x));
inex_z = mpc_mul_naive (z, x, y, rnd);
inex_t = mpc_mul_karatsuba (t, x, y, rnd);
if (mpc_cmp (z, t) != 0 || inex_z != inex_t) {
fprintf (stderr, "mul_naive and mul_karatsuba differ for rnd=(%s,%s)\n",
mpfr_print_rnd_mode(MPC_RND_RE(rnd)),
mpfr_print_rnd_mode(MPC_RND_IM(rnd)));
MPC_OUT (x);
MPC_OUT (y);
MPC_OUT (z);
MPC_OUT (t);
if (inex_z != inex_t) {
fprintf (stderr, "inex_re (z): %s\n", MPC_INEX_STR (inex_z));
fprintf (stderr, "inex_re (t): %s\n", MPC_INEX_STR (inex_t));
}
exit (1);
}
mpc_clear (z);
mpc_clear (t);
}
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
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);
}
/* 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;
}
/* If x^y is exactly representable (with maybe a larger precision than z),
round it in z and return the (mpc) inexact flag in [0, 10].
If x^y is not exactly representable, return -1.
If intermediate computations lead to numbers of more than maxprec bits,
then abort and return -2 (in that case, to avoid loops, mpc_pow_exact
should be called again with a larger value of maxprec).
Assume one of Re(x) or Im(x) is non-zero, and y is non-zero (y is real).
Warning: z and x might be the same variable, same for Re(z) or Im(z) and y.
In case -1 or -2 is returned, z is not modified.
*/
static int
mpc_pow_exact (mpc_ptr z, mpc_srcptr x, mpfr_srcptr y, mpc_rnd_t rnd,
mpfr_prec_t maxprec)
{
mpfr_exp_t ec, ed, ey;
mpz_t my, a, b, c, d, u;
unsigned long int t;
int ret = -2;
int sign_rex = mpfr_signbit (mpc_realref(x));
int sign_imx = mpfr_signbit (mpc_imagref(x));
int x_imag = mpfr_zero_p (mpc_realref(x));
int z_is_y = 0;
mpfr_t copy_of_y;
if (mpc_realref (z) == y || mpc_imagref (z) == y)
{
z_is_y = 1;
mpfr_init2 (copy_of_y, mpfr_get_prec (y));
mpfr_set (copy_of_y, y, MPFR_RNDN);
}
mpz_init (my);
mpz_init (a);
mpz_init (b);
mpz_init (c);
mpz_init (d);
mpz_init (u);
ey = mpfr_get_z_exp (my, y);
/* normalize so that my is odd */
t = mpz_scan1 (my, 0);
ey += (mpfr_exp_t) t;
mpz_tdiv_q_2exp (my, my, t);
/* y = my*2^ey with my odd */
if (x_imag)
{
mpz_set_ui (c, 0);
ec = 0;
}
else
ec = mpfr_get_z_exp (c, mpc_realref(x));
if (mpfr_zero_p (mpc_imagref(x)))
{
mpz_set_ui (d, 0);
ed = ec;
}
else
{
ed = mpfr_get_z_exp (d, mpc_imagref(x));
if (x_imag)
ec = ed;
}
/* x = c*2^ec + I * d*2^ed */
/* equalize the exponents of x */
if (ec < ed)
{
mpz_mul_2exp (d, d, (unsigned long int) (ed - ec));
if ((mpfr_prec_t) mpz_sizeinbase (d, 2) > maxprec)
goto end;
}
else if (ed < ec)
{
mpz_mul_2exp (c, c, (unsigned long int) (ec - ed));
if ((mpfr_prec_t) mpz_sizeinbase (c, 2) > maxprec)
goto end;
ec = ed;
}
/* now ec=ed and x = (c + I * d) * 2^ec */
/* divide by two if possible */
if (mpz_cmp_ui (c, 0) == 0)
{
t = mpz_scan1 (d, 0);
mpz_tdiv_q_2exp (d, d, t);
ec += (mpfr_exp_t) t;
}
else if (mpz_cmp_ui (d, 0) == 0)
{
t = mpz_scan1 (c, 0);
mpz_tdiv_q_2exp (c, c, t);
ec += (mpfr_exp_t) t;
}
else /* neither c nor d is zero */
{
unsigned long v;
t = mpz_scan1 (c, 0);
v = mpz_scan1 (d, 0);
if (v < t)
t = v;
mpz_tdiv_q_2exp (c, c, t);
mpz_tdiv_q_2exp (d, d, t);
ec += (mpfr_exp_t) t;
}
/* now either one of c, d is odd */
while (ey < 0)
{
/* check if x is a square */
if (ec & 1)
{
mpz_mul_2exp (c, c, 1);
mpz_mul_2exp (d, d, 1);
ec --;
}
/* now ec is even */
if (mpc_perfect_square_p (a, b, c, d) == 0)
break;
mpz_swap (a, c);
mpz_swap (b, d);
ec /= 2;
ey ++;
}
if (ey < 0)
{
ret = -1; /* not representable */
goto end;
}
/* Now ey >= 0, it thus suffices to check that x^my is representable.
If my > 0, this is always true. If my < 0, we first try to invert
(c+I*d)*2^ec.
*/
if (mpz_cmp_ui (my, 0) < 0)
{
/* If my < 0, 1 / (c + I*d) = (c - I*d)/(c^2 + d^2), thus a sufficient
condition is that c^2 + d^2 is a power of two, assuming |c| <> |d|.
Assume a prime p <> 2 divides c^2 + d^2,
then if p does not divide c or d, 1 / (c + I*d) cannot be exact.
If p divides both c and d, then we can write c = p*c', d = p*d',
and 1 / (c + I*d) = 1/p * 1/(c' + I*d'). This shows that if 1/(c+I*d)
is exact, then 1/(c' + I*d') is exact too, and we are back to the
previous case. In conclusion, a necessary and sufficient condition
is that c^2 + d^2 is a power of two.
*/
/* FIXME: we could first compute c^2+d^2 mod a limb for example */
mpz_mul (a, c, c);
mpz_addmul (a, d, d);
t = mpz_scan1 (a, 0);
if (mpz_sizeinbase (a, 2) != 1 + t) /* a is not a power of two */
{
ret = -1; /* not representable */
goto end;
}
/* replace (c,d) by (c/(c^2+d^2), -d/(c^2+d^2)) */
mpz_neg (d, d);
ec = -ec - (mpfr_exp_t) t;
mpz_neg (my, my);
}
/* now ey >= 0 and my >= 0, and we want to compute
[(c + I * d) * 2^ec] ^ (my * 2^ey).
We first compute [(c + I * d) * 2^ec]^my, then square ey times. */
t = mpz_sizeinbase (my, 2) - 1;
mpz_set (a, c);
mpz_set (b, d);
ed = ec;
/* invariant: (a + I*b) * 2^ed = ((c + I*d) * 2^ec)^trunc(my/2^t) */
while (t-- > 0)
{
unsigned long int v, w;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
if (mpz_tstbit (my, t)) /* multiply by c + I*d */
{
mpz_mul (u, a, c);
mpz_submul (u, b, d); /* ac-bd */
mpz_mul (b, b, c);
mpz_addmul (b, a, d); /* bc+ad */
mpz_swap (a, u);
ed += ec;
}
/* remove powers of two in (a,b) */
if (mpz_cmp_ui (a, 0) == 0)
{
w = mpz_scan1 (b, 0);
mpz_tdiv_q_2exp (b, b, w);
ed += (mpfr_exp_t) w;
}
else if (mpz_cmp_ui (b, 0) == 0)
{
w = mpz_scan1 (a, 0);
mpz_tdiv_q_2exp (a, a, w);
ed += (mpfr_exp_t) w;
}
else
{
w = mpz_scan1 (a, 0);
v = mpz_scan1 (b, 0);
if (v < w)
w = v;
mpz_tdiv_q_2exp (a, a, w);
mpz_tdiv_q_2exp (b, b, w);
ed += (mpfr_exp_t) w;
}
if ( (mpfr_prec_t) mpz_sizeinbase (a, 2) > maxprec
|| (mpfr_prec_t) mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
/* now a+I*b = (c+I*d)^my */
while (ey-- > 0)
{
unsigned long sa, sb;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
/* divide by largest 2^n possible, to avoid many loops for e.g.,
(2+2*I)^16777216 */
sa = mpz_scan1 (a, 0);
sb = mpz_scan1 (b, 0);
sa = (sa <= sb) ? sa : sb;
mpz_tdiv_q_2exp (a, a, sa);
mpz_tdiv_q_2exp (b, b, sa);
ed += (mpfr_exp_t) sa;
if ( (mpfr_prec_t) mpz_sizeinbase (a, 2) > maxprec
|| (mpfr_prec_t) mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
ret = mpfr_set_z (mpc_realref(z), a, MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_z (mpc_imagref(z), b, MPC_RND_IM(rnd)));
mpfr_mul_2si (mpc_realref(z), mpc_realref(z), ed, MPC_RND_RE(rnd));
mpfr_mul_2si (mpc_imagref(z), mpc_imagref(z), ed, MPC_RND_IM(rnd));
end:
mpz_clear (my);
mpz_clear (a);
mpz_clear (b);
mpz_clear (c);
mpz_clear (d);
mpz_clear (u);
if (ret >= 0 && x_imag)
fix_sign (z, sign_rex, sign_imx, (z_is_y) ? copy_of_y : y);
if (z_is_y)
mpfr_clear (copy_of_y);
return ret;
}
