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; }