static void check_get_d_2exp_inf_nan (void) { double var_d; long exp; mpfr_t var; mpfr_init2 (var, MPFR_PREC_MIN); mpfr_set_nan (var); var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN); if (!DOUBLE_ISNAN (var_d)) { printf ("mpfr_get_d_2exp with a NAN mpfr value returned a wrong value :\n" " waiting for %g got %g\n", MPFR_DBL_NAN, var_d); exit (1); } mpfr_set_zero (var, 1); var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN); if ((exp != 0) || (var_d != 0.0)) { printf ("mpfr_get_d_2exp with a +0.0 mpfr value returned a wrong value :\n" " double waiting for 0.0 got %g\n exp waiting for 0 got %ld\n", var_d, exp); exit (1); } mpfr_set_zero (var, -1); var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN); if ((exp != 0) || (var_d != DBL_NEG_ZERO)) { printf ("mpfr_get_d_2exp with a +0.0 mpfr value returned a wrong value :\n" " double waiting for %g got %g\n exp waiting for 0 got %ld\n", DBL_NEG_ZERO, var_d, exp); exit (1); } mpfr_set_inf (var, 1); var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN); if (var_d != MPFR_DBL_INFP) { printf ("mpfr_get_d_2exp with a +Inf mpfr value returned a wrong value :\n" " waiting for %g got %g\n", MPFR_DBL_INFP, var_d); exit (1); } mpfr_set_inf (var, -1); var_d = mpfr_get_d_2exp (&exp, var, MPFR_RNDN); if (var_d != MPFR_DBL_INFM) { printf ("mpfr_get_d_2exp with a -Inf mpfr value returned a wrong value :\n" " waiting for %g got %g\n", MPFR_DBL_INFM, var_d); exit (1); } mpfr_clear (var); }
static void check_special (void) { mpfr_t x, y; int inexact; mpfr_init (x); mpfr_init (y); mpfr_set_inf (x, 1); PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) < 0, "ERROR: mpfr_set_inf failed to set variable to +infinity.\n"); inexact = mpfr_set (y, x, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || inexact != 0, "ERROR: mpfr_set failed to set variable to +infinity.\n"); inexact = mpfr_set_ui (y, 0, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0, "ERROR: mpfr_set_ui failed to set variable to +0.\n"); mpfr_set_inf (x, -1); PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) > 0, "ERROR: mpfr_set_inf failed to set variable to -infinity.\n"); inexact = mpfr_set (y, x, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) > 0 || inexact != 0, "ERROR: mpfr_set failed to set variable to -infinity.\n"); mpfr_set_zero (x, 1); PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) < 0, "ERROR: mpfr_set_zero failed to set variable to +0.\n"); inexact = mpfr_set (y, x, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0, "ERROR: mpfr_set failed to set variable to +0.\n"); mpfr_set_zero (x, -1); PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) > 0, "ERROR: mpfr_set_zero failed to set variable to -0.\n"); inexact = mpfr_set (y, x, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) > 0 || inexact != 0, "ERROR: mpfr_set failed to set variable to -0.\n"); mpfr_set_nan (x); PRINT_ERROR_IF (!mpfr_nan_p (x), "ERROR: mpfr_set_nan failed to set variable to NaN.\n"); inexact = mpfr_set (y, x, MPFR_RNDN); PRINT_ERROR_IF (!mpfr_nan_p (y) || inexact != 0, "ERROR: mpfr_set failed to set variable to NaN.\n"); mpfr_clear (x); mpfr_clear (y); }
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)); }
int fmpr_get_mpfr(mpfr_t x, const fmpr_t y, mpfr_rnd_t rnd) { int r; if (fmpr_is_special(y)) { if (fmpr_is_zero(y)) mpfr_set_zero(x, 0); else if (fmpr_is_pos_inf(y)) mpfr_set_inf(x, 1); else if (fmpr_is_neg_inf(y)) mpfr_set_inf(x, -1); else mpfr_set_nan(x); r = 0; } else if (COEFF_IS_MPZ(*fmpr_expref(y))) { flint_printf("exception: exponent too large to convert to mpfr"); abort(); } else { if (!COEFF_IS_MPZ(*fmpr_manref(y))) #if defined(__MINGW64__) r = mpfr_set_sj_2exp(x, *fmpr_manref(y), *fmpr_expref(y), rnd); #else r = mpfr_set_si_2exp(x, *fmpr_manref(y), *fmpr_expref(y), rnd); #endif else r = mpfr_set_z_2exp(x, COEFF_TO_PTR(*fmpr_manref(y)), *fmpr_expref(y), rnd); if (!mpfr_regular_p(x)) { flint_printf("exception: exponent too large to convert to mpfr"); abort(); } }
static void test_nan_inf_zero (void) { mpfr_ptr val; int sign; int kind; reset_stack (); val = new_mpfr (MPFR_PREC_MIN); mpfr_set_nan (val); kind = (mpfr_custom_get_kind) (val); if (kind != MPFR_NAN_KIND) { printf ("mpfr_custom_get_kind error: "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, (int) MPFR_NAN_KIND); exit (1); } val = new_nan (MPFR_PREC_MIN); if (!mpfr_nan_p(val)) { printf ("Error: mpfr_custom_init_set doesn't set NAN mpfr.\n"); exit (1); } val = new_inf (MPFR_PREC_MIN); if (!mpfr_inf_p(val) || mpfr_sgn(val) >= 0) { printf ("Error: mpfr_custom_init_set doesn't set -INF mpfr.\n"); exit (1); } sign = 1; mpfr_set_inf (val, sign); kind = (mpfr_custom_get_kind) (val); if ((ABS (kind) != MPFR_INF_KIND) || (SIGN (kind) != SIGN (sign))) { printf ("mpfr_custom_get_kind error: "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, (int) MPFR_INF_KIND); printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign)); exit (1); } sign = -1; mpfr_set_zero (val, sign); kind = (mpfr_custom_get_kind) (val); if ((ABS (kind) != MPFR_ZERO_KIND) || (SIGN (kind) != SIGN (sign))) { printf ("mpfr_custom_get_kind error: "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, (int) MPFR_ZERO_KIND); printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign)); exit (1); } reset_stack (); }
mpfr_t* compute_rho_to_z_matrix(unsigned long Lambda_arg, long prec){ /* To avoid writing lambda + 1 so many times...*/ unsigned long Lambda=Lambda_arg+1; mpfr_t* temps=malloc(sizeof(mpfr_t)*(Lambda)); mpfr_init2(temps[0],prec); mpfr_set_ui(temps[0],8,MPFR_RNDN); mpfr_sqrt(temps[0],temps[0],MPFR_RNDN); mpfr_neg(temps[0],temps[0],MPFR_RNDN); for(unsigned long j=1;j<Lambda;j++){ mpfr_init2(temps[j],prec); mpfr_mul_si(temps[j],temps[j-1],2*j-3,MPFR_RNDN); mpfr_div_ui(temps[j],temps[j],j,MPFR_RNDN); } mpfr_sub_ui(temps[1],temps[1],2,MPFR_RNDN); mpfr_add_ui(temps[0],temps[0],3,MPFR_RNDN); mpfr_t temp; mpfr_init2(temp,prec); mpfr_t temp2; mpfr_init2(temp2,prec); mpfr_t* result=malloc(sizeof(mpfr_t)*(Lambda)*(Lambda)); mpfr_init2(result[0],prec); mpfr_set_ui(result[0],1,MPFR_RNDN); for(unsigned long j=1; j<(Lambda*Lambda); j++){ mpfr_init2(result[j],prec); mpfr_set_zero(result[j],1); } for(unsigned long j=1;j<Lambda;j++){ mpfr_set_ui(temp,1,MPFR_RNDN); for(unsigned long k=0;k<=j;k++){ mpfr_mul(temp2,temps[j-k],temp,MPFR_RNDN); mpfr_add(result[j+Lambda],result[j+Lambda],temp2,MPFR_RNDN); mpfr_mul_si(temp,temp,-2,MPFR_RNDN); } } for(unsigned long i=2;i<Lambda;i++){ for(unsigned long j=1;j<Lambda;j++){ for(unsigned long k=i-1;k<Lambda-j;k++){ mpfr_mul(temp,result[Lambda*(i-1)+k],result[j+Lambda],MPFR_RNDN); mpfr_add(result[Lambda*i+k+j],result[Lambda*i+k+j],temp,MPFR_RNDN); } } } /* transposition */ for(unsigned long i=0;i<Lambda;i++){ for(unsigned long j=0;j<i;j++){ mpfr_swap(result[i+Lambda*j],result[j+Lambda*i]); } } for(unsigned long j=0;j<Lambda;j++){ mpfr_clear(temps[j]); } free(temps); mpfr_clear(temp); mpfr_clear(temp2); return result; }
Floating* Floating_set_positive_zero (Floating* self) { mpfr_set_zero(*self->value, 1); invalidate_cache(self); return self; }
static void test_nan_inf_zero (void) { mpfr_ptr val; int sign; int kind; char *org = stack; val = new_mpfr (MPFR_PREC_MIN); mpfr_set_nan (val); kind = (mpfr_custom_get_kind) (val); if (kind != MPFR_NAN_KIND) { printf ("mpfr_custom_get_kind error : "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, MPFR_NAN_KIND); exit (1); } sign = 1; mpfr_set_inf (val, sign); kind = (mpfr_custom_get_kind) (val); if ((ABS (kind) != MPFR_INF_KIND) || (SIGN (kind) != SIGN (sign))) { printf ("mpfr_custom_get_kind error : "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, MPFR_INF_KIND); printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign)); exit (1); } sign = -1; mpfr_set_zero (val, sign); kind = (mpfr_custom_get_kind) (val); if ((ABS (kind) != MPFR_ZERO_KIND) || (SIGN (kind) != SIGN (sign))) { printf ("mpfr_custom_get_kind error : "); mpfr_dump (val); printf (" is kind %d instead of %d\n", kind, MPFR_ZERO_KIND); printf (" have sign %d instead of %d\n", SIGN (kind), SIGN (sign)); exit (1); } stack = org; }
int mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd) { int ok_re = 0, ok_im = 0; mpc_t res, c_conj; mpfr_t q; mpfr_prec_t prec; int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0; int underflow_norm, overflow_norm, underflow_prod, overflow_prod; int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0; mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd); int saved_underflow, saved_overflow; int tmpsgn; mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */ mpc_t b_scaled, c_scaled; mpfr_t b_re, b_im, c_re, c_im; /* According to the C standard G.3, there are three types of numbers: */ /* finite (both parts are usual real numbers; contains 0), infinite */ /* (at least one part is a real infinity) and all others; the latter */ /* are numbers containing a nan, but no infinity, and could reasonably */ /* be called nan. */ /* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */ /* all other divisions that are not finite/finite return nan+i*nan. */ /* Division by 0 could be handled by the following case of division by */ /* a real; we handle it separately instead. */ if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */ return mpc_div_zero (a, b, c, rnd); else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite and both Re(c) and Im(c) are ordinary */ return mpc_div_inf_fin (a, b, c); else if (mpc_fin_p (b) && mpc_inf_p (c)) return mpc_div_fin_inf (a, b, c); else if (!mpc_fin_p (b) || !mpc_fin_p (c)) { mpc_set_nan (a); return MPC_INEX (0, 0); } else if (mpfr_zero_p(mpc_imagref(c))) return mpc_div_real (a, b, c, rnd); else if (mpfr_zero_p(mpc_realref(c))) return mpc_div_imag (a, b, c, rnd); prec = MPC_MAX_PREC(a); mpc_init2 (res, 2); mpfr_init (q); /* compute scaling of exponents: none of Re(c) and Im(c) can be zero, but one of Re(b) or Im(b) could be zero */ e = mpfr_get_exp (mpc_realref (c)); emin = emax = e; e = mpfr_get_exp (mpc_imagref (c)); if (e > emax) emax = e; else if (e < emin) emin = e; if (!mpfr_zero_p (mpc_realref (b))) { e = mpfr_get_exp (mpc_realref (b)); if (e > emax) emax = e; else if (e < emin) emin = e; } if (!mpfr_zero_p (mpc_imagref (b))) { e = mpfr_get_exp (mpc_imagref (b)); if (e > emax) emax = e; else if (e < emin) emin = e; } /* all input exponents are in [emin, emax] */ emid = emin / 2 + emax / 2; /* scale the inputs */ b_re[0] = mpc_realref (b)[0]; if (!mpfr_zero_p (mpc_realref (b))) MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid; b_im[0] = mpc_imagref (b)[0]; if (!mpfr_zero_p (mpc_imagref (b))) MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid; c_re[0] = mpc_realref (c)[0]; MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid; c_im[0] = mpc_imagref (c)[0]; MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid; /* create the scaled inputs without allocating new memory */ mpc_realref (b_scaled)[0] = b_re[0]; mpc_imagref (b_scaled)[0] = b_im[0]; mpc_realref (c_scaled)[0] = c_re[0]; mpc_imagref (c_scaled)[0] = c_im[0]; /* create the conjugate of c in c_conj without allocating new memory */ mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0]; mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0]; MPFR_CHANGE_SIGN (mpc_imagref (c_conj)); /* save the underflow or overflow flags from MPFR */ saved_underflow = mpfr_underflow_p (); saved_overflow = mpfr_overflow_p (); do { loops ++; prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2; mpc_set_prec (res, prec); mpfr_set_prec (q, prec); /* first compute norm(c_scaled) */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU); underflow_norm = mpfr_underflow_p (); overflow_norm = mpfr_overflow_p (); if (underflow_norm) mpfr_set_ui (q, 0ul, MPFR_RNDN); /* to obtain divisions by 0 later on */ /* now compute b_scaled*conjugate(c_scaled) */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ); inexact_re = MPC_INEX_RE (inexact_prod); inexact_im = MPC_INEX_IM (inexact_prod); underflow_prod = mpfr_underflow_p (); overflow_prod = mpfr_overflow_p (); /* unfortunately, does not distinguish between under-/overflow in real or imaginary parts hopefully, the side-effects of mpc_mul do indeed raise the mpfr exceptions */ if (overflow_prod) { /* FIXME: in case overflow_norm is also true, the code below is wrong, since the after division by the norm, we might end up with finite real and/or imaginary parts. A workaround would be to scale the inputs (in case the exponents are within the same range). */ int isinf = 0; /* determine if the real part of res is the maximum or the minimum representable number */ tmpsgn = mpfr_sgn (mpc_realref(res)); if (tmpsgn > 0) { mpfr_nextabove (mpc_realref(res)); isinf = mpfr_inf_p (mpc_realref(res)); mpfr_nextbelow (mpc_realref(res)); } else if (tmpsgn < 0) { mpfr_nextbelow (mpc_realref(res)); isinf = mpfr_inf_p (mpc_realref(res)); mpfr_nextabove (mpc_realref(res)); } if (isinf) { mpfr_set_inf (mpc_realref(res), tmpsgn); overflow_re = 1; } /* same for the imaginary part */ tmpsgn = mpfr_sgn (mpc_imagref(res)); isinf = 0; if (tmpsgn > 0) { mpfr_nextabove (mpc_imagref(res)); isinf = mpfr_inf_p (mpc_imagref(res)); mpfr_nextbelow (mpc_imagref(res)); } else if (tmpsgn < 0) { mpfr_nextbelow (mpc_imagref(res)); isinf = mpfr_inf_p (mpc_imagref(res)); mpfr_nextabove (mpc_imagref(res)); } if (isinf) { mpfr_set_inf (mpc_imagref(res), tmpsgn); overflow_im = 1; } mpc_set (a, res, rnd); goto end; } /* divide the product by the norm */ if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) { /* The division has good chances to be exact in at least one part. */ /* Since this can cause problems when not rounding to the nearest, */ /* we use the division code of mpfr, which handles the situation. */ mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ); underflow_re = mpfr_underflow_p (); overflow_re = mpfr_overflow_p (); ok_re = !inexact_re || underflow_re || overflow_re || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN)); if (ok_re) /* compute imaginary part */ { mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ); underflow_im = mpfr_underflow_p (); overflow_im = mpfr_overflow_p (); ok_im = !inexact_im || underflow_im || overflow_im || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN)); } } else { /* The division is inexact, so for efficiency reasons we invert q */ /* only once and multiply by the inverse. */ if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) { /* if 1/q is inexact, the approximations of the real and imaginary part below will be inexact, unless RE(res) or IM(res) is zero */ inexact_re |= !mpfr_zero_p (mpc_realref (res)); inexact_im |= !mpfr_zero_p (mpc_imagref (res)); } mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ); underflow_re = mpfr_underflow_p (); overflow_re = mpfr_overflow_p (); ok_re = !inexact_re || underflow_re || overflow_re || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN)); if (ok_re) /* compute imaginary part */ { mpfr_clear_underflow (); mpfr_clear_overflow (); inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ); underflow_im = mpfr_underflow_p (); overflow_im = mpfr_overflow_p (); ok_im = !inexact_im || underflow_im || overflow_im || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN, MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN)); } } } while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm && !underflow_prod && !overflow_prod); inex = mpc_set (a, res, rnd); inexact_re = MPC_INEX_RE (inex); inexact_im = MPC_INEX_IM (inex); end: /* fix values and inexact flags in case of overflow/underflow */ /* FIXME: heuristic, certainly does not cover all cases */ if (overflow_re || (underflow_norm && !underflow_prod)) { mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res))); inexact_re = mpfr_sgn (mpc_realref (res)); } else if (underflow_re || (overflow_norm && !overflow_prod)) { inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1; mpfr_set_zero (mpc_realref (a), -inexact_re); } if (overflow_im || (underflow_norm && !underflow_prod)) { mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res))); inexact_im = mpfr_sgn (mpc_imagref (res)); } else if (underflow_im || (overflow_norm && !overflow_prod)) { inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1; mpfr_set_zero (mpc_imagref (a), -inexact_im); } mpc_clear (res); mpfr_clear (q); /* restore underflow and overflow flags from MPFR */ if (saved_underflow) mpfr_set_underflow (); if (saved_overflow) mpfr_set_overflow (); return MPC_INEX (inexact_re, inexact_im); }
static MPC_Object * GMPy_MPC_From_PyStr(PyObject *s, int base, mpfr_prec_t rprec, mpfr_prec_t iprec, CTXT_Object *context) { MPC_Object *result; PyObject *ascii_str = NULL; Py_ssize_t len; char *cp, *unwind, *tempchar, *lastchar; int firstp = 0, lastp = 0, real_rc = 0, imag_rc = 0; CHECK_CONTEXT(context); if (PyBytes_Check(s)) { len = PyBytes_Size(s); cp = (char*)PyBytes_AsString(s); } else if (PyUnicode_Check(s)) { ascii_str = PyUnicode_AsASCIIString(s); if (!ascii_str) { VALUE_ERROR("string contains non-ASCII characters"); return NULL; } len = PyBytes_Size(ascii_str); cp = (char*)PyBytes_AsString(ascii_str); } else { TYPE_ERROR("string required"); return NULL; } /* Don't allow NULL characters */ if (strlen(cp) != len) { VALUE_ERROR("string without NULL characters expected"); Py_XDECREF(ascii_str); return NULL; } if (!(result = GMPy_MPC_New(rprec, iprec, context))) { Py_XDECREF(ascii_str); return NULL; } /* Get a pointer to the last valid character (ignoring trailing * whitespace.) */ lastchar = cp + len - 1; while (isspace(*lastchar)) lastchar--; /* Skip trailing ). */ if (*lastchar == ')') { lastp = 1; lastchar--; } /* Skip trailing j. */ if (*lastchar == 'j') lastchar--; /* Skip leading whitespace. */ while (isspace(*cp)) cp++; /* Skip a leading (. */ if (*cp == '(') { firstp = 1; cp++; } if (firstp != lastp) goto invalid_string; /* Read the real component first. */ unwind = cp; real_rc = mpfr_strtofr(mpc_realref(result->c), cp, &tempchar, base, GET_REAL_ROUND(context)); /* Verify that at least one valid character was read. */ if (cp == tempchar) goto invalid_string; /* If the next character is a j, then the real component is 0 and * we just read the imaginary componenet. */ if (*tempchar == 'j') { mpfr_set_zero(mpc_realref(result->c), MPFR_RNDN); cp = unwind; } else { /* Read the imaginary component next. */ cp = tempchar; } imag_rc = mpfr_strtofr(mpc_imagref(result->c), cp, &tempchar, base, GET_IMAG_ROUND(context)); if (cp == tempchar && tempchar > lastchar) goto valid_string; if (*tempchar != 'j' && *cp != ' ') goto invalid_string; if (tempchar <= lastchar) goto invalid_string; valid_string: Py_XDECREF(ascii_str); result->rc = MPC_INEX(real_rc, imag_rc); if (rprec != 1 || iprec != 1) { GMPY_MPC_CHECK_RANGE(result, context); } GMPY_MPC_SUBNORMALIZE(result, context); GMPY_MPC_EXCEPTIONS(result, context); return result; invalid_string: VALUE_ERROR("invalid string in mpc()"); Py_DECREF((PyObject*)result); Py_XDECREF(ascii_str); return NULL; }
static PyObject * GMPy_Real_DivMod_2(PyObject *x, PyObject *y, CTXT_Object *context) { MPFR_Object *tempx = NULL, *tempy = NULL, *quo = NULL, *rem = NULL; PyObject *result = NULL; CHECK_CONTEXT(context); if (!(result = PyTuple_New(2)) || !(rem = GMPy_MPFR_New(0, context)) || !(quo = GMPy_MPFR_New(0, context))) { /* LCOV_EXCL_START */ goto error; /* LCOV_EXCL_STOP */ } if (IS_REAL(x) && IS_REAL(y)) { if (!(tempx = GMPy_MPFR_From_Real(x, 1, context)) || !(tempy = GMPy_MPFR_From_Real(y, 1, context))) { /* LCOV_EXCL_START */ goto error; /* LCOV_EXCL_STOP */ } if (mpfr_zero_p(tempy->f)) { context->ctx.divzero = 1; if (context->ctx.traps & TRAP_DIVZERO) { GMPY_DIVZERO("divmod() division by zero"); goto error; } } if (mpfr_nan_p(tempx->f) || mpfr_nan_p(tempy->f) || mpfr_inf_p(tempx->f)) { context->ctx.invalid = 1; if (context->ctx.traps & TRAP_INVALID) { GMPY_INVALID("divmod() invalid operation"); goto error; } else { mpfr_set_nan(quo->f); mpfr_set_nan(rem->f); } } else if (mpfr_inf_p(tempy->f)) { context->ctx.invalid = 1; if (context->ctx.traps & TRAP_INVALID) { GMPY_INVALID("divmod() invalid operation"); goto error; } if (mpfr_zero_p(tempx->f)) { mpfr_set_zero(quo->f, mpfr_sgn(tempy->f)); mpfr_set_zero(rem->f, mpfr_sgn(tempy->f)); } else if ((mpfr_signbit(tempx->f)) != (mpfr_signbit(tempy->f))) { mpfr_set_si(quo->f, -1, MPFR_RNDN); mpfr_set_inf(rem->f, mpfr_sgn(tempy->f)); } else { mpfr_set_si(quo->f, 0, MPFR_RNDN); rem->rc = mpfr_set(rem->f, tempx->f, MPFR_RNDN); } } else { MPQ_Object *mpqx = NULL, *mpqy = NULL, *temp_rem = NULL; MPZ_Object *temp_quo = NULL; if (!(mpqx = GMPy_MPQ_From_MPFR(tempx, context)) || !(mpqy = GMPy_MPQ_From_MPFR(tempy, context))) { /* LCOV_EXCL_START */ Py_XDECREF((PyObject*)mpqx); Py_XDECREF((PyObject*)mpqy); goto error; /* LCOV_EXCL_STOP */ } if (!(temp_rem = GMPy_MPQ_New(context)) || !(temp_quo = GMPy_MPZ_New(context))) { /* LCOV_EXCL_START */ Py_XDECREF((PyObject*)temp_rem); Py_XDECREF((PyObject*)temp_quo); Py_XDECREF((PyObject*)mpqx); Py_XDECREF((PyObject*)mpqy); goto error; /* LCOV_EXCL_STOP */ } Py_DECREF((PyObject*)tempx); Py_DECREF((PyObject*)tempy); mpq_div(temp_rem->q, mpqx->q, mpqy->q); mpz_fdiv_q(temp_quo->z, mpq_numref(temp_rem->q), mpq_denref(temp_rem->q)); /* Need to calculate x - quo * y. */ mpq_set_z(temp_rem->q, temp_quo->z); mpq_mul(temp_rem->q, temp_rem->q, mpqy->q); mpq_sub(temp_rem->q, mpqx->q, temp_rem->q); Py_DECREF((PyObject*)mpqx); Py_DECREF((PyObject*)mpqy); quo->rc = mpfr_set_z(quo->f, temp_quo->z, MPFR_RNDD); rem->rc = mpfr_set_q(rem->f, temp_rem->q, MPFR_RNDN); Py_DECREF((PyObject*)temp_rem); Py_DECREF((PyObject*)temp_quo); GMPY_MPFR_CHECK_RANGE(quo, context); GMPY_MPFR_CHECK_RANGE(rem, context); GMPY_MPFR_SUBNORMALIZE(quo, context); GMPY_MPFR_SUBNORMALIZE(rem, context); PyTuple_SET_ITEM(result, 0, (PyObject*)quo); PyTuple_SET_ITEM(result, 1, (PyObject*)rem); return result; } } /* LCOV_EXCL_START */ SYSTEM_ERROR("Internal error in GMPy_Real_DivMod_2()."); error: Py_XDECREF((PyObject*)tempx); Py_XDECREF((PyObject*)tempy); Py_XDECREF((PyObject*)rem); Py_XDECREF((PyObject*)quo); Py_XDECREF(result); return NULL; /* LCOV_EXCL_STOP */ }
static PyObject * GMPy_Real_DivMod_1(PyObject *x, PyObject *y, CTXT_Object *context) { MPFR_Object *tempx = NULL, *tempy = NULL, *quo = NULL, *rem = NULL; PyObject *result = NULL; CHECK_CONTEXT(context); if (!(result = PyTuple_New(2)) || !(rem = GMPy_MPFR_New(0, context)) || !(quo = GMPy_MPFR_New(0, context))) { /* LCOV_EXCL_START */ goto error; /* LCOV_EXCL_STOP */ } if (IS_REAL(x) && IS_REAL(y)) { if (!(tempx = GMPy_MPFR_From_Real(x, 1, context)) || !(tempy = GMPy_MPFR_From_Real(y, 1, context))) { /* LCOV_EXCL_START */ goto error; /* LCOV_EXCL_STOP */ } if (mpfr_zero_p(tempy->f)) { context->ctx.divzero = 1; if (context->ctx.traps & TRAP_DIVZERO) { GMPY_DIVZERO("divmod() division by zero"); goto error; } } if (mpfr_nan_p(tempx->f) || mpfr_nan_p(tempy->f) || mpfr_inf_p(tempx->f)) { context->ctx.invalid = 1; if (context->ctx.traps & TRAP_INVALID) { GMPY_INVALID("divmod() invalid operation"); goto error; } else { mpfr_set_nan(quo->f); mpfr_set_nan(rem->f); } } else if (mpfr_inf_p(tempy->f)) { context->ctx.invalid = 1; if (context->ctx.traps & TRAP_INVALID) { GMPY_INVALID("divmod() invalid operation"); goto error; } if (mpfr_zero_p(tempx->f)) { mpfr_set_zero(quo->f, mpfr_sgn(tempy->f)); mpfr_set_zero(rem->f, mpfr_sgn(tempy->f)); } else if ((mpfr_signbit(tempx->f)) != (mpfr_signbit(tempy->f))) { mpfr_set_si(quo->f, -1, MPFR_RNDN); mpfr_set_inf(rem->f, mpfr_sgn(tempy->f)); } else { mpfr_set_si(quo->f, 0, MPFR_RNDN); rem->rc = mpfr_set(rem->f, tempx->f, MPFR_RNDN); } } else { MPFR_Object *temp; if (!(temp = GMPy_MPFR_New(0, context))) { /* LCOV_EXCL_START */ goto error; /* LCOV_EXCL_STOP */ } mpfr_fmod(rem->f, tempx->f, tempy->f, MPFR_RNDN); mpfr_sub(temp->f, tempx->f, rem->f, MPFR_RNDN); mpfr_div(quo->f, temp->f, tempy->f, MPFR_RNDN); if (!mpfr_zero_p(rem->f)) { if ((mpfr_sgn(tempy->f) < 0) != (mpfr_sgn(rem->f) < 0)) { mpfr_add(rem->f, rem->f, tempy->f, MPFR_RNDN); mpfr_sub_ui(quo->f, quo->f, 1, MPFR_RNDN); } } else { mpfr_copysign(rem->f, rem->f, tempy->f, MPFR_RNDN); } if (!mpfr_zero_p(quo->f)) { mpfr_round(quo->f, quo->f); } else { mpfr_setsign(quo->f, quo->f, mpfr_sgn(tempx->f) * mpfr_sgn(tempy->f) - 1, MPFR_RNDN); } Py_DECREF((PyObject*)temp); } GMPY_MPFR_CHECK_RANGE(quo, context); GMPY_MPFR_CHECK_RANGE(rem, context); GMPY_MPFR_SUBNORMALIZE(quo, context); GMPY_MPFR_SUBNORMALIZE(rem, context); Py_DECREF((PyObject*)tempx); Py_DECREF((PyObject*)tempy); PyTuple_SET_ITEM(result, 0, (PyObject*)quo); PyTuple_SET_ITEM(result, 1, (PyObject*)rem); return (PyObject*)result; } /* LCOV_EXCL_START */ SYSTEM_ERROR("Internal error in GMPy_Real_DivMod_1()."); error: Py_XDECREF((PyObject*)tempx); Py_XDECREF((PyObject*)tempy); Py_XDECREF((PyObject*)rem); Py_XDECREF((PyObject*)quo); Py_XDECREF(result); return NULL; /* LCOV_EXCL_STOP */ }
static void check_underflow (void) { mpfr_t sum1, sum2, t[NUNFL]; mpfr_ptr p[NUNFL]; mpfr_prec_t precmax = 444; mpfr_exp_t emin, emax; unsigned int ex_flags, flags; int c, i; emin = mpfr_get_emin (); emax = mpfr_get_emax (); set_emin (MPFR_EMIN_MIN); set_emax (MPFR_EMAX_MAX); ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT; mpfr_init2 (sum1, MPFR_PREC_MIN); mpfr_init2 (sum2, precmax); for (i = 0; i < NUNFL; i++) { mpfr_init2 (t[i], precmax); p[i] = t[i]; } for (c = 0; c < 8; c++) { mpfr_prec_t fprec; int n, neg, r; fprec = MPFR_PREC_MIN + (randlimb () % (precmax - MPFR_PREC_MIN + 1)); n = 3 + (randlimb () % (NUNFL - 2)); MPFR_ASSERTN (n <= NUNFL); mpfr_set_prec (sum2, (randlimb () & 1) ? MPFR_PREC_MIN : precmax); mpfr_set_prec (t[0], fprec + 64); mpfr_set_zero (t[0], 1); for (i = 1; i < n; i++) { int inex; mpfr_set_prec (t[i], MPFR_PREC_MIN + (randlimb () % (fprec - MPFR_PREC_MIN + 1))); do mpfr_urandomb (t[i], RANDS); while (MPFR_IS_ZERO (t[i])); mpfr_set_exp (t[i], MPFR_EMIN_MIN); inex = mpfr_sub (t[0], t[0], t[i], MPFR_RNDN); MPFR_ASSERTN (inex == 0); } neg = randlimb () & 1; if (neg) mpfr_nextbelow (t[0]); else mpfr_nextabove (t[0]); RND_LOOP(r) { int inex1, inex2; mpfr_set_zero (sum1, 1); if (neg) mpfr_nextbelow (sum1); else mpfr_nextabove (sum1); inex1 = mpfr_div_2ui (sum1, sum1, 2, (mpfr_rnd_t) r); mpfr_clear_flags (); inex2 = mpfr_sum (sum2, p, n, (mpfr_rnd_t) r); flags = __gmpfr_flags; MPFR_ASSERTN (mpfr_check (sum1)); MPFR_ASSERTN (mpfr_check (sum2)); if (flags != ex_flags) { printf ("Bad flags in check_underflow on %s, c = %d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), c); printf ("Expected flags:"); flags_out (ex_flags); printf ("Got flags: "); flags_out (flags); printf ("sum = "); mpfr_dump (sum2); exit (1); } if (!(mpfr_equal_p (sum1, sum2) && SAME_SIGN (inex1, inex2))) { printf ("Error in check_underflow on %s, c = %d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), c); printf ("Expected "); mpfr_dump (sum1); printf ("with inex = %d\n", inex1); printf ("Got "); mpfr_dump (sum2); printf ("with inex = %d\n", inex2); exit (1); } } } for (i = 0; i < NUNFL; i++) mpfr_clear (t[i]); mpfr_clears (sum1, sum2, (mpfr_ptr) 0); set_emin (emin); set_emax (emax); }
/*------------------------------------------------------------------------*/ int my_mpfr_beta (mpfr_t R, mpfr_t a, mpfr_t b, mpfr_rnd_t RND) { mpfr_prec_t p_a = mpfr_get_prec(a), p_b = mpfr_get_prec(b); if(p_a < p_b) p_a = p_b;// p_a := max(p_a, p_b) if(mpfr_get_prec(R) < p_a) mpfr_prec_round(R, p_a, RND);// so prec(R) = max( prec(a), prec(b) ) int ans; mpfr_t s; mpfr_init2(s, p_a); #ifdef DEBUG_Rmpfr R_CheckUserInterrupt(); int cc = 0; #endif /* "FIXME": check each 'ans' below, and return when not ok ... */ ans = mpfr_add(s, a, b, RND); if(mpfr_integer_p(s) && mpfr_sgn(s) <= 0) { // (a + b) is integer <= 0 if(!mpfr_integer_p(a) && !mpfr_integer_p(b)) { // but a,b not integer ==> R = finite / +-Inf = 0 : mpfr_set_zero (R, +1); mpfr_clear (s); return ans; }// else: sum is integer; at least one {a,b} integer ==> both integer int sX = mpfr_sgn(a), sY = mpfr_sgn(b); if(sX * sY < 0) { // one negative, one positive integer // ==> special treatment here : if(sY < 0) // ==> sX > 0; swap the two mpfr_swap(a, b); // now have --- a < 0 < b <= |a| integer ------------------ /* ================ and in this case: B(a,b) = (-1)^b B(1-a-b, b) = (-1)^b B(1-s, b) = (1*2*..*b) / (-s-1)*(-s-2)*...*(-s-b) */ /* where in the 2nd form, both numerator and denominator have exactly * b integer factors. This is attractive {numerically & speed wise} * for 'small' b */ #define b_large 100 #ifdef DEBUG_Rmpfr Rprintf(" my_mpfr_beta(<neg int>): s = a+b= "); R_PRT(s); Rprintf("\n a = "); R_PRT(a); Rprintf("\n b = "); R_PRT(b); Rprintf("\n"); if(cc++ > 999) { mpfr_set_zero (R, +1); mpfr_clear (s); return ans; } #endif unsigned long b_ = 0;// -Wall Rboolean b_fits_ulong = mpfr_fits_ulong_p(b, RND), small_b = b_fits_ulong && (b_ = mpfr_get_ui(b, RND)) < b_large; if(small_b) { #ifdef DEBUG_Rmpfr Rprintf(" b <= b_large = %d...\n", b_large); #endif //----------------- small b ------------------ // use GMP big integer arithmetic: mpz_t S; mpz_init(S); mpfr_get_z(S, s, RND); // S := s mpz_sub_ui (S, S, (unsigned long) 1); // S = s - 1 = (a+b-1) /* binomial coefficient choose(N, k) requires k a 'long int'; * here, b must fit into a long: */ mpz_bin_ui (S, S, b_); // S = choose(S, b) = choose(a+b-1, b) mpz_mul_ui (S, S, b_); // S = S*b = b * choose(a+b-1, b) // back to mpfr: R = 1 / S = 1 / (b * choose(a+b-1, b)) mpfr_set_ui(s, (unsigned long) 1, RND); mpfr_div_z(R, s, S, RND); mpz_clear(S); } else { // b is "large", use direct B(.,.) formula #ifdef DEBUG_Rmpfr Rprintf(" b > b_large = %d...\n", b_large); #endif // a := (-1)^b : // there is no mpfr_si_pow(a, -1, b, RND); int neg; // := 1 ("TRUE") if (-1)^b = -1, i.e. iff b is odd if(b_fits_ulong) { // (i.e. not very large) neg = (b_ % 2); // 1 iff b_ is odd, 0 otherwise } else { // really large b; as we know it is integer, can still.. // b2 := b / 2 mpfr_t b2; mpfr_init2(b2, p_a); mpfr_div_2ui(b2, b, 1, RND); neg = !mpfr_integer_p(b2); // b is odd, if b/2 is *not* integer #ifdef DEBUG_Rmpfr Rprintf(" really large b; neg = ('b is odd') = %d\n", neg); #endif } // s' := 1-s = 1-a-b mpfr_ui_sub(s, 1, s, RND); #ifdef DEBUG_Rmpfr Rprintf(" neg = %d\n", neg); Rprintf(" s' = 1-a-b = "); R_PRT(s); Rprintf("\n -> calling B(s',b)\n"); #endif // R := B(1-a-b, b) = B(s', b) if(small_b) { my_mpfr_beta (R, s, b, RND); } else { my_mpfr_lbeta (R, s, b, RND); mpfr_exp(R, R, RND); // correct *if* beta() >= 0 } #ifdef DEBUG_Rmpfr Rprintf(" R' = beta(s',b) = "); R_PRT(R); Rprintf("\n"); #endif // Result = (-1)^b B(1-a-b, b) = +/- s' if(neg) mpfr_neg(R, R, RND); } mpfr_clear(s); return ans; } } ans = mpfr_gamma(s, s, RND); /* s = gamma(a + b) */ #ifdef DEBUG_Rmpfr Rprintf("my_mpfr_beta(): s = gamma(a+b)= "); R_PRT(s); Rprintf("\n a = "); R_PRT(a); Rprintf("\n b = "); R_PRT(b); #endif ans = mpfr_gamma(a, a, RND); ans = mpfr_gamma(b, b, RND); ans = mpfr_mul(b, b, a, RND); /* b' = gamma(a) * gamma(b) */ #ifdef DEBUG_Rmpfr Rprintf("\n G(a) * G(b) = "); R_PRT(b); Rprintf("\n"); #endif ans = mpfr_div(R, b, s, RND); mpfr_clear (s); /* mpfr_free_cache() must be called in the caller !*/ return ans; }
/* TODO * exponents that use more than 16 bytes are not managed */ static int mpfr_fpif_read_exponent_from_file (mpfr_t x, FILE * fh) { mpfr_exp_t exponent; mpfr_uexp_t uexp; size_t exponent_size; int sign; unsigned char buffer[sizeof(mpfr_exp_t)]; if (fh == NULL) return 1; if (fread (buffer, 1, 1, fh) != 1) return 1; sign = (buffer[0] & 0x80) ? -1 : 1; exponent = buffer[0] & 0x7F; exponent_size = 1; if (exponent > MPFR_EXTERNAL_EXPONENT && exponent < MPFR_KIND_ZERO) { mpfr_uexp_t exponent_sign; exponent_size = exponent - MPFR_EXTERNAL_EXPONENT; if (exponent_size > sizeof(mpfr_exp_t)) return 1; if (fread (buffer, exponent_size, 1, fh) != 1) return 1; uexp = 0; getLittleEndianData ((unsigned char *) &uexp, buffer, sizeof(mpfr_exp_t), exponent_size); exponent_sign = uexp & ((mpfr_uexp_t) 1 << (8 * exponent_size - 1)); uexp &= ~exponent_sign; uexp += MPFR_MAX_EMBEDDED_EXPONENT; exponent = exponent_sign ? - (mpfr_exp_t) uexp : (mpfr_exp_t) uexp; if (! MPFR_EXP_IN_RANGE (exponent)) return 1; MPFR_EXP (x) = exponent; MPFR_SET_SIGN (x, sign); exponent_size++; } else if (exponent == MPFR_KIND_ZERO) mpfr_set_zero (x, sign); else if (exponent == MPFR_KIND_INF) mpfr_set_inf (x, sign); else if (exponent == MPFR_KIND_NAN) mpfr_set_nan (x); else if (exponent < 95) { /* FIXME: no sign set. Is this normal? Check with a testcase. */ exponent -= MPFR_MAX_EMBEDDED_EXPONENT; if (! MPFR_EXP_IN_RANGE (exponent)) return 1; MPFR_EXP (x) = exponent; } else return 1; return 0; }
int main (int argc, char *argv[]) { char *filenameCompressed = FILE_NAME_RW; char *data = FILE_NAME_R; int status; FILE *fh; mpfr_t x[9]; mpfr_t y; unsigned char badData[6][2] = { { 7, 0 }, { 16, 0 }, { 23, 118 }, { 23, 95 }, { 23, 127 }, { 23, 47 } }; int badDataSize[6] = { 1, 1, 2, 2, 2, 2 }; int i; if (argc != 1) { printf ("Usage: %s\n", argv[0]); exit (1); } tests_start_mpfr (); mpfr_init2 (x[0], 130); mpfr_init2 (x[8], 130); mpfr_inits2 (2048, x[1], x[2], x[3], x[4], x[5], x[6], x[7], (mpfr_ptr) 0); mpfr_set_str1 (x[0], "45.2564215000000018562786863185465335845947265625"); mpfr_set_str1 (x[1], "45.2564215000000018562786863185465335845947265625"); mpfr_set_str1 (x[2], "45.2564215000000018562786863185465335845947265625"); mpfr_set_exp (x[2], -48000); mpfr_set_inf (x[3], -1); mpfr_set_zero (x[4], 0); mpfr_set_nan (x[5]); mpfr_set_ui (x[6], 104348, MPFR_RNDN); mpfr_set_ui (x[7], 33215, MPFR_RNDN); mpfr_div (x[8], x[6], x[7], MPFR_RNDN); mpfr_div (x[6], x[6], x[7], MPFR_RNDN); /* we first write to file FILE_NAME_RW the numbers x[i] */ fh = fopen (filenameCompressed, "w"); if (fh == NULL) { printf ("Failed to open for writing %s, exiting...\n", filenameCompressed); exit (1); } for (i = 0; i < 9; i++) { status = mpfr_fpif_export (fh, x[i]); if (status != 0) { fclose (fh); printf ("Failed to export number %d, exiting...\n", i); exit (1); } } fclose (fh); /* we then read back FILE_NAME_RW and check we get the same numbers x[i] */ fh = fopen (filenameCompressed, "r"); if (fh == NULL) { printf ("Failed to open for reading %s, exiting...\n", filenameCompressed); exit (1); } for (i = 0; i < 9; i++) { mpfr_init2 (y, 2); mpfr_fpif_import (y, fh); if (mpfr_cmp(x[i], y) != 0) { printf ("mpfr_cmp failed on written number %d, exiting...\n", i); printf ("expected "); mpfr_dump (x[i]); printf ("got "); mpfr_dump (y); exit (1); } mpfr_clear (y); } fclose (fh); /* we do the same for the fixed file FILE_NAME_R, this ensures we get same results with different word size or endianness */ fh = src_fopen (data, "r"); if (fh == NULL) { printf ("Failed to open for reading %s in srcdir, exiting...\n", data); exit (1); } for (i = 0; i < 9; i++) { mpfr_init2 (y, 2); mpfr_fpif_import (y, fh); if (mpfr_cmp (x[i], y) != 0) { printf ("mpfr_cmp failed on data number %d, exiting...\n", i); printf ("expected "); mpfr_dump (x[i]); printf ("got "); mpfr_dump (y); exit (1); } mpfr_clear (y); } fclose (fh); for (i = 0; i < 9; i++) mpfr_clear (x[i]); remove (filenameCompressed); mpfr_init2 (y, 2); status = mpfr_fpif_export (NULL, y); if (status == 0) { printf ("mpfr_fpif_export did not fail with a NULL file\n"); exit(1); } status = mpfr_fpif_import (y, NULL); if (status == 0) { printf ("mpfr_fpif_import did not fail with a NULL file\n"); exit(1); } fh = fopen (filenameCompressed, "w+"); if (fh == NULL) { printf ("Failed to open for reading/writing %s, exiting...\n", filenameCompressed); fclose (fh); remove (filenameCompressed); exit (1); } status = mpfr_fpif_import (y, fh); if (status == 0) { printf ("mpfr_fpif_import did not fail on a empty file\n"); fclose (fh); remove (filenameCompressed); exit(1); } for (i = 0; i < 6; i++) { rewind (fh); status = fwrite (&badData[i][0], badDataSize[i], 1, fh); if (status != 1) { printf ("Write error on the test file\n"); fclose (fh); remove (filenameCompressed); exit(1); } rewind (fh); status = mpfr_fpif_import (y, fh); if (status == 0) { printf ("mpfr_fpif_import did not fail on a bad imported data\n"); switch (i) { case 0: printf (" not enough precision data\n"); break; case 1: printf (" no exponent data\n"); break; case 2: printf (" too big exponent\n"); break; case 3: printf (" not enough exponent data\n"); break; case 4: printf (" exponent data wrong\n"); break; case 5: printf (" no limb data\n"); break; default: printf ("Test fatal error, unknown case\n"); break; } fclose (fh); remove (filenameCompressed); exit(1); } } fclose (fh); mpfr_clear (y); fh = fopen (filenameCompressed, "r"); if (fh == NULL) { printf ("Failed to open for reading %s, exiting...\n", filenameCompressed); exit (1); } mpfr_init2 (y, 2); status = mpfr_fpif_export (fh, y); if (status == 0) { printf ("mpfr_fpif_export did not fail on a read only stream\n"); exit(1); } fclose (fh); remove (filenameCompressed); mpfr_clear (y); tests_end_mpfr (); return 0; }
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 main (int argc, char *argv[]) { unsigned int prec, yprec; int rnd; mpfr_t x, y, z, t; unsigned long n; int inex; mpfr_exp_t emin, emax; mpfr_flags_t flags, ex_flags; int i; tests_start_mpfr (); emin = mpfr_get_emin (); emax = mpfr_get_emax (); mpfr_init (x); mpfr_init (y); mpfr_init (z); mpfr_init (t); if (argc >= 3) /* tzeta_ui n prec [rnd] */ { mpfr_set_prec (x, atoi (argv[2])); mpfr_zeta_ui (x, atoi (argv[1]), argc > 3 ? (mpfr_rnd_t) atoi (argv[3]) : MPFR_RNDN); mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); printf ("\n"); goto clear_and_exit; } mpfr_set_prec (x, 33); mpfr_set_prec (y, 33); mpfr_zeta_ui (x, 3, MPFR_RNDZ); mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1"); if (mpfr_cmp (x, y)) { printf ("Error for zeta(3), prec=33, MPFR_RNDZ\n"); printf ("expected "); mpfr_dump (y); printf ("got "); mpfr_dump (x); exit (1); } mpfr_clear_flags (); inex = mpfr_zeta_ui (x, 0, MPFR_RNDN); flags = __gmpfr_flags; MPFR_ASSERTN (inex == 0 && mpfr_cmp_si_2exp (x, -1, -1) == 0 && flags == 0); for (i = -2; i <= 2; i += 2) RND_LOOP (rnd) { int ex_inex; set_emin (i); set_emax (i); mpfr_clear_flags (); inex = mpfr_zeta_ui (x, 0, (mpfr_rnd_t) rnd); flags = __gmpfr_flags; if (i < 0) { mpfr_set_inf (y, -1); if (rnd == MPFR_RNDU || rnd == MPFR_RNDZ) { mpfr_nextabove (y); ex_inex = 1; } else { ex_inex = -1; } ex_flags = MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT; } else if (i > 0) { mpfr_set_zero (y, -1); if (rnd == MPFR_RNDD || rnd == MPFR_RNDA) { mpfr_nextbelow (y); ex_inex = -1; } else { ex_inex = 1; } ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT; } else { mpfr_set_str_binary (y, "-1e-1"); ex_inex = 0; ex_flags = 0; } set_emin (emin); set_emax (emax); if (! (mpfr_equal_p (x, y) && MPFR_IS_NEG (x) && SAME_SIGN (inex, ex_inex) && flags == ex_flags)) { printf ("Failure for zeta(0) in %s, exponent range [%d,%d]\n", mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i, i); printf ("Expected "); mpfr_dump (y); printf (" with inex ~ %d, flags =", ex_inex); flags_out (ex_flags); printf ("Got "); mpfr_dump (x); printf (" with inex = %d, flags =", inex); flags_out (flags); exit (1); } } mpfr_clear_divby0 (); inex = mpfr_zeta_ui (x, 1, MPFR_RNDN); MPFR_ASSERTN (inex == 0 && MPFR_IS_INF (x) && MPFR_IS_POS (x) && mpfr_divby0_p ()); for (prec = MPFR_PREC_MIN; prec <= 100; prec++) { mpfr_set_prec (x, prec); mpfr_set_prec (z, prec); mpfr_set_prec (t, prec); yprec = prec + 10; mpfr_set_prec (y, yprec); for (n = 0; n < 50; n++) RND_LOOP (rnd) { mpfr_zeta_ui (y, n, MPFR_RNDN); if (mpfr_can_round (y, yprec, MPFR_RNDN, MPFR_RNDZ, prec + (rnd == MPFR_RNDN))) { mpfr_set (t, y, (mpfr_rnd_t) rnd); for (i = 0; i <= 1; i++) { if (i) { mpfr_exp_t e; if (MPFR_IS_SINGULAR (t)) break; e = mpfr_get_exp (t); set_emin (e); set_emax (e); } mpfr_zeta_ui (z, n, (mpfr_rnd_t) rnd); if (i) { set_emin (emin); set_emax (emax); } if (mpfr_cmp (t, z)) { printf ("results differ for n = %lu, prec = %u," " %s%s\n", n, prec, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i ? ", reduced exponent range" : ""); printf (" got "); mpfr_dump (z); printf (" expected "); mpfr_dump (t); printf (" approx "); mpfr_dump (y); exit (1); } } } } } clear_and_exit: mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); tests_end_mpfr (); return 0; }