/* 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);
}
/* fix the sign of Re(z) or Im(z) in case it is zero,
and Re(x) is zero.
sign_eps is 0 if Re(x) = +0, 1 if Re(x) = -0
sign_a is the sign bit of Im(x).
Assume y is an integer (does nothing otherwise).
*/
static void
fix_sign (mpc_ptr z, int sign_eps, int sign_a, mpfr_srcptr y)
{
int ymod4 = -1;
mpfr_exp_t ey;
mpz_t my;
unsigned long int t;
mpz_init (my);
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 */
/* compute y mod 4 (in case y is an integer) */
if (ey >= 2)
ymod4 = 0;
else if (ey == 1)
ymod4 = mpz_tstbit (my, 0) * 2; /* correct if my < 0 */
else if (ey == 0)
{
ymod4 = mpz_tstbit (my, 1) * 2 + mpz_tstbit (my, 0);
if (mpz_cmp_ui (my , 0) < 0)
ymod4 = 4 - ymod4;
}
else /* y is not an integer */
goto end;
if (mpfr_zero_p (mpc_realref(z)))
{
/* we assume y is always integer in that case (FIXME: prove it):
(eps+I*a)^y = +0 + I*a^y for y = 1 mod 4 and sign_eps = 0
(eps+I*a)^y = -0 - I*a^y for y = 3 mod 4 and sign_eps = 0 */
MPC_ASSERT (ymod4 == 1 || ymod4 == 3);
if ((ymod4 == 3 && sign_eps == 0) ||
(ymod4 == 1 && sign_eps == 1))
mpfr_neg (mpc_realref(z), mpc_realref(z), MPFR_RNDZ);
}
else if (mpfr_zero_p (mpc_imagref(z)))
{
/* we assume y is always integer in that case (FIXME: prove it):
(eps+I*a)^y = a^y - 0*I for y = 0 mod 4 and sign_a = sign_eps
(eps+I*a)^y = -a^y +0*I for y = 2 mod 4 and sign_a = sign_eps */
MPC_ASSERT (ymod4 == 0 || ymod4 == 2);
if ((ymod4 == 0 && sign_a == sign_eps) ||
(ymod4 == 2 && sign_a != sign_eps))
mpfr_neg (mpc_imagref(z), mpc_imagref(z), MPFR_RNDZ);
}
end:
mpz_clear (my);
}
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;
}
void
tpl_copy_mpfr (mpfr_ptr dest, mpfr_srcptr src)
{
/* source and destination are assumed to be of the same precision , so the
copy is exact (no rounding) */
MPC_ASSERT(mpfr_get_prec (dest) == mpfr_get_prec (src));
mpfr_set (dest, src, GMP_RNDN);
}
int
mpc_pow_d (mpc_ptr z, mpc_srcptr x, double y, mpc_rnd_t rnd)
{
mpc_t yy;
int inex;
MPC_ASSERT(FLT_RADIX == 2);
mpc_init3 (yy, DBL_MANT_DIG, MPFR_PREC_MIN);
mpc_set_d (yy, y, MPC_RNDNN); /* exact */
inex = mpc_pow (z, x, yy, rnd);
mpc_clear (yy);
return inex;
}
void
tpl_read_mpfr (mpc_datafile_context_t* datafile_context, mpfr_ptr x,
int* known_sign)
{
int sign;
mpfr_set_prec (x, tpl_read_mpfr_prec (datafile_context));
sign = datafile_context->nextchar;
tpl_read_mpfr_mantissa (datafile_context, x);
/* the sign always matters for regular values ('+' is implicit),
but when no sign appears before 0 or Inf in the data file, it means
that only absolute value must be checked. */
MPC_ASSERT(known_sign != NULL);
*known_sign =
(!mpfr_zero_p (x) && !mpfr_inf_p (x)) || sign == '+' || sign == '-';
}
static char *
get_pretty_str (const int base, const size_t n, mpfr_srcptr x, mpfr_rnd_t rnd)
{
mp_exp_t expo;
char *ugly;
char *pretty;
if (mpfr_zero_p (x))
return pretty_zero (x);
ugly = mpfr_get_str (NULL, &expo, base, n, x, rnd);
MPC_ASSERT (ugly != NULL);
pretty = prettify (ugly, expo, base, !mpfr_number_p (x));
mpfr_free_str (ugly);
return pretty;
}
/* Return non-zero iff c+i*d is an exact square (a+i*b)^2,
with a, b both of the form m*2^e with m, e integers.
If so, returns in a+i*b the corresponding square root, with a >= 0.
The variables a, b must not overlap with c, d.
We have c = a^2 - b^2 and d = 2*a*b.
If one of a, b is exact, then both are (see algorithms.tex).
Case 1: a <> 0 and b <> 0.
Let a = m*2^e and b = n*2^f with m, e, n, f integers, m and n odd
(we will treat apart the case a = 0 or b = 0).
Then 2*a*b = m*n*2^(e+f+1), thus necessarily e+f >= -1.
Assume e < 0, then f >= 0, then a^2 - b^2 = m^2*2^(2e) - n^2*2^(2f) cannot
be an integer, since n^2*2^(2f) is an integer, and m^2*2^(2e) is not.
Similarly when f < 0 (and thus e >= 0).
Thus we have e, f >= 0, and a, b are both integers.
Let A = 2a^2, then eliminating b between c = a^2 - b^2 and d = 2*a*b
gives A^2 - 2c*A - d^2 = 0, which has solutions c +/- sqrt(c^2+d^2).
We thus need c^2+d^2 to be a square, and c + sqrt(c^2+d^2) --- the solution
we are interested in --- to be two times a square. Then b = d/(2a) is
necessarily an integer.
Case 2: a = 0. Then d is necessarily zero, thus it suffices to check
whether c = -b^2, i.e., if -c is a square.
Case 3: b = 0. Then d is necessarily zero, thus it suffices to check
whether c = a^2, i.e., if c is a square.
*/
static int
mpc_perfect_square_p (mpz_t a, mpz_t b, mpz_t c, mpz_t d)
{
if (mpz_cmp_ui (d, 0) == 0) /* case a = 0 or b = 0 */
{
/* necessarily c < 0 here, since we have already considered the case
where x is real non-negative and y is real */
MPC_ASSERT (mpz_cmp_ui (c, 0) < 0);
mpz_neg (b, c);
if (mpz_perfect_square_p (b)) /* case 2 above */
{
mpz_sqrt (b, b);
mpz_set_ui (a, 0);
return 1; /* c + i*d = (0 + i*b)^2 */
}
}
else /* both a and b are non-zero */
{
if (mpz_divisible_2exp_p (d, 1) == 0)
return 0; /* d must be even */
mpz_mul (a, c, c);
mpz_addmul (a, d, d); /* c^2 + d^2 */
if (mpz_perfect_square_p (a))
{
mpz_sqrt (a, a);
mpz_add (a, c, a); /* c + sqrt(c^2+d^2) */
if (mpz_divisible_2exp_p (a, 1))
{
mpz_tdiv_q_2exp (a, a, 1);
if (mpz_perfect_square_p (a))
{
mpz_sqrt (a, a);
mpz_tdiv_q_2exp (b, d, 1); /* d/2 */
mpz_divexact (b, b, a); /* d/(2a) */
return 1;
}
}
}
}
return 0; /* not a square */
}
/* 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;
}
/* Extract from the stream the longest string of characters which are neither
whitespace nor brackets (except for an optional bracketed n-char_sequence
directly following nan or @nan@ independently of case).
The user must free the returned string. */
static char *
extract_string (FILE *stream)
{
int c;
size_t nread = 0;
size_t strsize = 100;
char *str = mpc_alloc_str (strsize);
size_t lenstr;
c = getc (stream);
while (c != EOF && c != '\n'
&& !isspace ((unsigned char) c)
&& c != '(' && c != ')') {
str [nread] = (char) c;
nread++;
if (nread == strsize) {
str = mpc_realloc_str (str, strsize, 2 * strsize);
strsize *= 2;
}
c = getc (stream);
}
str = mpc_realloc_str (str, strsize, nread + 1);
strsize = nread + 1;
str [nread] = '\0';
if (nread == 0)
return str;
lenstr = nread;
if (c == '(') {
size_t n;
char *suffix;
int ret;
/* (n-char-sequence) only after a NaN */
if ((nread != 3
|| tolower ((unsigned char) (str[0])) != 'n'
|| tolower ((unsigned char) (str[1])) != 'a'
|| tolower ((unsigned char) (str[2])) != 'n')
&& (nread != 5
|| str[0] != '@'
|| tolower ((unsigned char) (str[1])) != 'n'
|| tolower ((unsigned char) (str[2])) != 'a'
|| tolower ((unsigned char) (str[3])) != 'n'
|| str[4] != '@')) {
ungetc (c, stream);
return str;
}
suffix = extract_suffix (stream);
nread += strlen (suffix) + 1;
if (nread >= strsize) {
str = mpc_realloc_str (str, strsize, nread + 1);
strsize = nread + 1;
}
/* Warning: the sprintf does not allow overlap between arguments. */
ret = sprintf (str + lenstr, "(%s", suffix);
MPC_ASSERT (ret >= 0);
n = lenstr + (size_t) ret;
MPC_ASSERT (n == nread);
c = getc (stream);
if (c == ')') {
str = mpc_realloc_str (str, strsize, nread + 2);
strsize = nread + 2;
str [nread] = (char) c;
str [nread+1] = '\0';
nread++;
}
else if (c != EOF)
ungetc (c, stream);
mpc_free_str (suffix);
}
else if (c != EOF)
ungetc (c, stream);
return str;
}
int
mpc_inp_str (mpc_ptr rop, FILE *stream, size_t *read, int base,
mpc_rnd_t rnd_mode)
{
size_t white, nread = 0;
int inex = -1;
int c;
char *str;
if (stream == NULL)
stream = stdin;
white = skip_whitespace (stream);
c = getc (stream);
if (c != EOF) {
if (c == '(') {
char *real_str;
char *imag_str;
size_t n;
int ret;
nread++; /* the opening parenthesis */
white = skip_whitespace (stream);
real_str = extract_string (stream);
nread += strlen(real_str);
c = getc (stream);
if (!isspace ((unsigned int) c)) {
if (c != EOF)
ungetc (c, stream);
mpc_free_str (real_str);
goto error;
}
else
ungetc (c, stream);
white += skip_whitespace (stream);
imag_str = extract_string (stream);
nread += strlen (imag_str);
str = mpc_alloc_str (nread + 2);
ret = sprintf (str, "(%s %s", real_str, imag_str);
MPC_ASSERT (ret >= 0);
n = (size_t) ret;
MPC_ASSERT (n == nread + 1);
mpc_free_str (real_str);
mpc_free_str (imag_str);
white += skip_whitespace (stream);
c = getc (stream);
if (c == ')') {
str = mpc_realloc_str (str, nread +2, nread + 3);
str [nread+1] = (char) c;
str [nread+2] = '\0';
nread++;
}
else if (c != EOF)
ungetc (c, stream);
}
else {
if (c != EOF)
ungetc (c, stream);
str = extract_string (stream);
nread += strlen (str);
}
inex = mpc_set_str (rop, str, base, rnd_mode);
mpc_free_str (str);
}
error:
if (inex == -1) {
mpfr_set_nan (MPC_RE(rop));
mpfr_set_nan (MPC_IM(rop));
}
if (read != NULL)
*read = white + nread;
return inex;
}
/* 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, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mp_prec_t p, q, pr, pi, maxprec;
long Q;
x_real = mpfr_zero_p (MPC_IM(x));
y_real = mpfr_zero_p (MPC_IM(y));
if (y_real && mpfr_zero_p (MPC_RE(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (MPC_RE(x))) /* 0^0 = NaN +i*NaN */
{
mpfr_set_nan (MPC_RE(z));
mpfr_set_nan (MPC_IM(z));
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, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (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) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (mpfr_nan_p (MPC_RE(x)) || mpfr_nan_p (MPC_IM(x)) ||
mpfr_nan_p (MPC_RE(y)) || mpfr_nan_p (MPC_IM(y)) ||
mpfr_inf_p (MPC_RE(x)) || mpfr_inf_p (MPC_IM(x)) ||
mpfr_inf_p (MPC_RE(y)) || mpfr_inf_p (MPC_IM(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_RE(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_RE(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (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) == GMP_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_RE(y)) ||
mpfr_cmp_ui (MPC_RE(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (x));
ret = mpfr_pow (MPC_RE(z), MPC_RE(x), MPC_RE(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (MPC_IM(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) == GMP_RNDD || s1 != s2)
mpfr_neg (MPC_IM(z), MPC_IM(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (MPC_RE(x), -1) == 0 && mpfr_integer_p (MPC_RE(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_RE(x), 0) < 0 && is_odd (MPC_RE(y), 1) &&
(y_real || mpfr_cmp_si (MPC_RE(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_RE(x), 0) == 0 && y_real)) &&
mpfr_integer_p (MPC_RE(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (MPC_RE(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_RE(x), MPC_IM(x)) == 0 && y_real &&
mpfr_integer_p (MPC_RE(y)) && is_odd (MPC_RE(y), 0) == 0)
{
if (is_odd (MPC_RE(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
/* first bound |Re(y log(x))|, |Im(y log(x)| < 2^q */
mpc_init2 (t, 64);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* the default maximum exponent for MPFR is emax=2^30-1, thus if
t > log(2^emax) = emax*log(2), then exp(t) will overflow */
if (mpfr_cmp_ui_2exp (MPC_RE(t), 372130558, 1) > 0)
goto overflow;
/* the default minimum exponent for MPFR is emin=-2^30+1, thus the
smallest representable value is 2^(emin-1), and if
t < log(2^(emin-1)) = (emin-1)*log(2), then exp(t) will underflow */
if (mpfr_cmp_si_2exp (MPC_RE(t), -372130558, 1) < 0)
goto underflow;
q = mpfr_get_exp (MPC_RE(t)) > 0 ? mpfr_get_exp (MPC_RE(t)) : 0;
if (mpfr_get_exp (MPC_IM(t)) > (mp_exp_t) q)
q = mpfr_get_exp (MPC_IM(t));
pr = mpfr_get_prec (MPC_RE(z));
pi = mpfr_get_prec (MPC_IM(z));
p = (pr > pi) ? pr : pi;
p += 11; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy */
mpc_init2 (u, p);
pr += MPC_RND_RE(rnd) == GMP_RNDN;
pi += MPC_RND_IM(rnd) == GMP_RNDN;
maxprec = MPFR_PREC(MPC_RE(z));
if (MPFR_PREC(MPC_IM(z)) > maxprec)
maxprec = MPFR_PREC(MPC_IM(z));
for (loop = 0;; loop++)
{
mp_exp_t dr, di;
if (p + q > 64) /* otherwise we reuse the initial approximation
t of y*log(x), avoiding two computations */
{
mpc_set_prec (t, p + q);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
}
mpc_exp (u, t, MPC_RNDNN);
/* 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_RE(u)) ? mpfr_get_exp (MPC_IM(u))
: mpfr_get_exp (MPC_RE(u));
di = mpfr_zero_p (MPC_IM(u)) ? dr : mpfr_get_exp (MPC_IM(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 || mpfr_can_round (MPC_RE(u), p - 3 - dr, GMP_RNDN, GMP_RNDZ, pr)) &&
(z_real || mpfr_can_round (MPC_IM(u), p - 3 - di, GMP_RNDN, GMP_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_RE(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (MPC_IM(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_RE(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p + q);
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;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (y)));
ret = mpfr_set (MPC_RE(z), MPC_RE(u), MPC_RND_RE(rnd));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
ret = MPC_INEX (ret, mpfr_set_ui (MPC_IM (z), 0, MPC_RND_IM (rnd)));
if (MPC_RND_IM (rnd) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (MPC_IM(z), MPC_IM(u), MPC_RND_IM(rnd));
ret = MPC_INEX(mpfr_set_ui (MPC_RE(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
end:
return ret;
underflow:
/* If we have an underflow, we know that |z| is too small to be
represented, but depending on arg(z), we should return +/-0 +/- I*0.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
mpfr_set_ui (MPC_RE(z), 0, GMP_RNDN);
mpfr_set_ui (MPC_IM(z), 0, GMP_RNDN);
switch (Q & 3)
{
case 0: /* first quadrant: round to (+0 +0) */
ret = MPC_INEX(-1, -1);
break;
case 1: /* second quadrant: round to (-0 +0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
ret = MPC_INEX(1, -1);
break;
case 2: /* third quadrant: round to (-0 -0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(1, 1);
break;
case 3: /* fourth quadrant: round to (+0 -0) */
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(-1, 1);
break;
}
goto clear_t_and_u;
overflow:
/* If we have an overflow, we know that |z| is too large to be
represented, but depending on arg(z), we should return +/-Inf +/- I*Inf.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
/* the quotient is rounded to the nearest integer in mpfr_remquo */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
switch (Q & 3)
{
case 0: /* first quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(1, 1);
break;
case 1: /* second quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(-1, 1);
break;
case 2: /* third quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(-1, -1);
break;
case 3: /* fourth quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(1, -1);
break;
}
clear_t_and_u:
mpc_clear (t);
mpc_clear (u);
return ret;
}
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;
}
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int s_re;
int s_im;
int inex_re;
int inex_im;
int inex;
inex_re = 0;
inex_im = 0;
s_re = mpfr_signbit (mpc_realref (op));
s_im = mpfr_signbit (mpc_imagref (op));
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_nan_p (mpc_realref (op)))
{
mpfr_set_nan (mpc_realref (rop));
if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
mpfr_set_nan (mpc_imagref (rop));
}
else
{
if (mpfr_inf_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int cmp_1;
if (s_im)
cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
else
cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);
if (cmp_1 < 0)
{
/* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s_re)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else if (cmp_1 == 0)
{
/* atan(+/-0+i) = NaN +i*inf
atan(+/-0-i) = NaN -i*inf */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
}
else
{
/* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
mpfr_rnd_t rnd_im, rnd_away;
mpfr_t y;
mpfr_prec_t p, p_im;
int ok;
rnd_im = MPC_RND_IM (rnd);
mpfr_init (y);
p_im = mpfr_get_prec (mpc_imagref (rop));
p = p_im;
/* a = o(1/y) with error(a) < 1 ulp(a)
b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)
As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
2 bits of precision are lost.
We round atanh(1/y) away from 0.
*/
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (y, p);
rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
/* FIXME: should we consider the case with unreasonably huge
precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
representable while 1/Im(op) underflows ?
This corresponds to |y| = 0.5*2^emin, in which case the
result may be wrong. */
/* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
inex_im |= mpfr_atanh (y, y, rnd_away);
ok = inex_im == 0
|| mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN));
} while (ok == 0);
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
mpfr_clear (y);
}
return MPC_INEX (inex_re, inex_im);
}
/* regular number argument */
{
mpfr_t a, b, x, y;
mpfr_prec_t prec, p;
mpfr_exp_t err, expo;
int ok = 0;
mpfr_t minus_op_re;
mpfr_exp_t op_re_exp, op_im_exp;
mpfr_rnd_t rnd1, rnd2;
mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);
/* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
op_re_exp = mpfr_get_exp (mpc_realref (op));
op_im_exp = mpfr_get_exp (mpc_imagref (op));
prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */
/* a = o(1-y) error(a) < 1 ulp(a)
b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
= kb ulp(b)
c = o(1+y) error(c) < 1 ulp(c)
d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
= kd ulp(d)
e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
+ kd*2^{Exp(d)-Exp(e)}] ulp(e)
error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
+ 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
because |atan(u)| < |u|
< [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
-Exp(e)}] ulp(e)
f = e/2 exact
*/
/* p: working precision */
p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
: (prec - op_im_exp);
rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (x, p);
/* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
x positive, and an upper bound on 1-y for x negative */
mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
expo will be 1 or 2 below */
{
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
/* check for intermediate underflow */
err = 2; /* ensures err will be expo below */
}
else
err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);
/* b = lower bound for atan (-x/(1+y)): for x negative, we need a
lower bound on -x/(1+y), i.e., an upper bound on 1+y */
mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
/* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
and we can simply ignore the terms involving Exp(a) in the error */
if (mpfr_sgn (a) == 0)
{
MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
/* check for intermediate underflow */
expo = err; /* will leave err unchanged below */
}
else
expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);
err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
mpfr_sub (x, x, b, GMP_RNDU);
err = 5 + op_re_exp - err - mpfr_get_exp (x);
/* error is bounded by [1 + 2^err] ulp(e) */
err = err < 0 ? 1 : err + 1;
mpfr_div_2ui (x, x, 1, GMP_RNDU);
/* Note: using RND2=RNDD guarantees that if x is exactly representable
on prec + ... bits, mpfr_can_round will return 0 */
ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
/* Imaginary part
Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */
/* a = o(1+y) error(a) < 1 ulp(a)
b = o(a^2) error(b) < 5 ulp(b)
c = o(x^2) error(c) < 1 ulp(c)
d = o(b+c) error(d) < 7 ulp(d)
e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
f = o(1-y) error(f) < 1 ulp(f)
g = o(f^2) error(g) < 5 ulp(g)
h = o(c+f) error(h) < 7 ulp(h)
i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
+ ki*2^{Exp(i)-Exp(j)}] ulp(j)
error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
+ 7*2^{3-Exp(j)}] ulp(j)
< [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
+ 7*2^{3-Exp(j)}] ulp(j)
k = j/4 exact
*/
err = 2;
p = prec; /* working precision */
do
{
p += mpc_ceil_log2 (p) + err;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (y, p);
/* a = upper bound for log(x^2 + (1+y)^2) */
ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
mpfr_sqr (a, a, GMP_RNDU);
mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
mpfr_add (a, a, y, GMP_RNDU);
mpfr_log (a, a, GMP_RNDU);
/* b = lower bound for log(x^2 + (1-y)^2) */
mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
mpfr_sqr (b, b, GMP_RNDZ);
/* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
more efficient to reuse the value of y (x^2) above and subtract
one ulp */
mpfr_nextbelow (y);
mpfr_add (b, b, y, GMP_RNDZ);
mpfr_log (b, b, GMP_RNDZ);
mpfr_sub (y, a, b, GMP_RNDU);
if (mpfr_zero_p (y))
/* FIXME: happens when x and y have very different magnitudes;
could be handled more efficiently */
ok = 0;
else
{
expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
expo = expo - mpfr_get_exp (y) + 1;
err = 3 - mpfr_get_exp (y);
/* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
err = (err < 0) ? 1 : err + 2;
else
err = (expo < 0) ? 1 : expo + 2;
mpfr_div_2ui (y, y, 2, GMP_RNDN);
MPC_ASSERT (!mpfr_zero_p (y));
/* FIXME: underflow. Since the main term of the Taylor series
in y=0 is 1/(x^2+1) * y, this means that y is very small
and/or x very large; but then the mpfr_zero_p (y) above
should be true. This needs a proof, or better yet,
special code. */
ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_IM (rnd) == GMP_RNDN));
}
} while (ok == 0);
inex = mpc_set_fr_fr (rop, x, y, rnd);
mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
return inex;
}
}
int
mpc_acos (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int inex_re, inex_im, inex;
mpfr_prec_t p_re, p_im, p;
mpc_t z1;
mpfr_t pi_over_2;
mpfr_exp_t e1, e2;
mpfr_rnd_t rnd_im;
mpc_rnd_t rnd1;
inex_re = 0;
inex_im = 0;
/* 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_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? +1 : -1);
mpfr_set_nan (mpc_realref (rop));
}
else if (mpfr_zero_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
mpfr_set_nan (mpc_imagref (rop));
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
{
if (mpfr_sgn (mpc_realref (op)) > 0)
{
inex_re =
set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
}
else
{
/* the real part of the result is 3*pi/4
a = o(pi) error(a) < 1 ulp(a)
b = o(3*a) error(b) < 2 ulp(b)
c = b/4 exact
thus 1 bit is lost */
mpfr_t x;
mpfr_prec_t prec;
int ok;
mpfr_init (x);
prec = mpfr_get_prec (mpc_realref (rop));
p = prec;
do
{
p += mpc_ceil_log2 (p);
mpfr_set_prec (x, p);
mpfr_const_pi (x, GMP_RNDD);
mpfr_mul_ui (x, x, 3, GMP_RNDD);
ok =
mpfr_can_round (x, p - 1, GMP_RNDD, MPC_RND_RE (rnd),
prec+(MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
inex_re =
mpfr_div_2ui (mpc_realref (rop), x, 2, MPC_RND_RE (rnd));
mpfr_clear (x);
}
}
else
{
if (mpfr_sgn (mpc_realref (op)) > 0)
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
else
inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
}
}
else
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
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 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),
MPC_RND_IM (rnd));
else
inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
INV_RND (MPC_RND_IM (rnd)));
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
}
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,
MPC_RND_IM (rnd));
else
inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
INV_RND (MPC_RND_IM (rnd)));
inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
}
else
{
inex_re = mpfr_acos (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
}
if (!s_im)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX (inex_re, inex_im);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
inex_im = -mpfr_asinh (mpc_imagref (rop), mpc_imagref (op),
INV_RND (MPC_RND_IM (rnd)));
mpc_conj (rop,rop, MPC_RNDNN);
return MPC_INEX (inex_re, inex_im);
}
/* regular complex argument: acos(z) = Pi/2 - asin(z) */
p_re = mpfr_get_prec (mpc_realref(rop));
p_im = mpfr_get_prec (mpc_imagref(rop));
p = p_re;
mpc_init3 (z1, p, p_im); /* we round directly the imaginary part to p_im,
with rounding mode opposite to rnd_im */
rnd_im = MPC_RND_IM(rnd);
/* the imaginary part of asin(z) has the same sign as Im(z), thus if
Im(z) > 0 and rnd_im = RNDZ, we want to round the Im(asin(z)) to -Inf
so that -Im(asin(z)) is rounded to zero */
if (rnd_im == GMP_RNDZ)
rnd_im = mpfr_sgn (mpc_imagref(op)) > 0 ? GMP_RNDD : GMP_RNDU;
else
rnd_im = rnd_im == GMP_RNDU ? GMP_RNDD
: rnd_im == GMP_RNDD ? GMP_RNDU
: rnd_im; /* both RNDZ and RNDA map to themselves for -asin(z) */
rnd1 = MPC_RND (GMP_RNDN, rnd_im);
mpfr_init2 (pi_over_2, p);
for (;;)
{
p += mpc_ceil_log2 (p) + 3;
mpfr_set_prec (mpc_realref(z1), p);
mpfr_set_prec (pi_over_2, p);
set_pi_over_2 (pi_over_2, +1, GMP_RNDN);
e1 = 1; /* Exp(pi_over_2) */
inex = mpc_asin (z1, op, rnd1); /* asin(z) */
MPC_ASSERT (mpfr_sgn (mpc_imagref(z1)) * mpfr_sgn (mpc_imagref(op)) > 0);
inex_im = MPC_INEX_IM(inex); /* inex_im is in {-1, 0, 1} */
e2 = mpfr_get_exp (mpc_realref(z1));
mpfr_sub (mpc_realref(z1), pi_over_2, mpc_realref(z1), GMP_RNDN);
if (!mpfr_zero_p (mpc_realref(z1)))
{
/* the error on x=Re(z1) is bounded by 1/2 ulp(x) + 2^(e1-p-1) +
2^(e2-p-1) */
e1 = e1 >= e2 ? e1 + 1 : e2 + 1;
/* the error on x is bounded by 1/2 ulp(x) + 2^(e1-p-1) */
e1 -= mpfr_get_exp (mpc_realref(z1));
/* the error on x is bounded by 1/2 ulp(x) [1 + 2^e1] */
e1 = e1 <= 0 ? 0 : e1;
/* the error on x is bounded by 2^e1 * ulp(x) */
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN); /* exact */
inex_im = -inex_im;
if (mpfr_can_round (mpc_realref(z1), p - e1, GMP_RNDN, GMP_RNDZ,
p_re + (MPC_RND_RE(rnd) == GMP_RNDN)))
break;
}
}
inex = mpc_set (rop, z1, rnd);
inex_re = MPC_INEX_RE(inex);
mpc_clear (z1);
mpfr_clear (pi_over_2);
return MPC_INEX(inex_re, inex_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 void
check_special (void)
{
mpc_t z[3], res;
mpc_ptr t[3];
int i, inex;
/* z[0] = (1,2), z[1] = (2,3), z[2] = (3,4) */
for (i = 0; i < 3; i++)
{
mpc_init2 (z[i], 17);
mpc_set_ui_ui (z[i], i+1, i+2, MPC_RNDNN);
t[i] = z[i];
}
mpc_init2 (res, 17);
/* dot product of empty vectors is 0 */
inex = mpc_dot (res, t, t, 0, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_zero_p (mpc_realref (res)));
MPC_ASSERT (mpfr_zero_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_signbit (mpc_realref (res)) == 0);
MPC_ASSERT (mpfr_signbit (mpc_imagref (res)) == 0);
/* (1,2)*(1,2) = (-3,4) */
inex = mpc_dot (res, t, t, 1, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -3) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 4) == 0);
/* (1,2)*(1,2) + (2,3)*(2,3) = (-8,16) */
inex = mpc_dot (res, t, t, 2, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -8) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 16) == 0);
/* (1,2)*(1,2) + (2,3)*(2,3) + (3,4)*(3,4) = (-15,40) */
inex = mpc_dot (res, t, t, 3, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -15) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 40) == 0);
for (i = 0; i < 3; i++)
mpc_clear (z[i]);
mpc_clear (res);
}
