/* Function to calculate the probability of joint occurance of input class sx and output class sy */ void scjoint(mpfr_t *distptr, int mu, int gamma, int psiz, int conns, int phi, mpfr_t *bcs,mpfr_t *binpdf,mpfr_t *pp,mpfr_prec_t prec) { int dini=conns; int dmax=conns; mpfr_t poff; mpfr_init2(poff,prec); mpfr_t bcf; mpfr_init2(bcf,prec); mpfr_t f1; mpfr_init2(f1,prec); mpfr_t f2; mpfr_init2(f2,prec); mpfr_t f3; mpfr_init2(f3,prec); unsigned int i; unsigned int d; // unsigned int phi; unsigned int sy; unsigned int sx; unsigned int pdex; int done=gamma+1; int dist_dex=0; int ppdex=0; int bdex; for(pdex=0;pdex<=psiz-1;pdex++) { for(d=dini;d<=dmax;d++) { // for(phi=1;phi<=d;phi++) // { for(sx=0;sx<=mu;sx++) { mpfr_ui_sub(poff,(unsigned long int)1,*(pp+ppdex),MPFR_RNDN); bdex=pdex*(mu+1)+sx; for(sy=0;sy<=gamma;sy++) { mpfr_mul(f1,*(binpdf+bdex),*(bcs+sy),MPFR_RNDN); mpfr_pow_ui(f2,*(pp+ppdex),(unsigned long int)sy,MPFR_RNDN); mpfr_pow_ui(f3,poff,(unsigned long int)(gamma-sy),MPFR_RNDN); mpfr_mul(f1,f1,f2,MPFR_RNDN); mpfr_mul(*(distptr+dist_dex),f1,f3,MPFR_RNDN); dist_dex++; } ppdex++; } // } } ppdex=0; } mpfr_clear(poff); mpfr_clear(bcf); mpfr_clear(f1); mpfr_clear(f2); mpfr_clear(f3); }
void mpfr_bisect_nRoot(mpfr_t R, mpfr_t N, mpfr_t T, unsigned int n) { if(mpfr_cmp_ui(N, 0) < 0) { fprintf(stderr, "The value to square root must be non-negative\n"); exit(-1); } if(mpfr_cmp_ui(T, 0) < 0) { fprintf(stderr, "The tolerance must be non-negative\n"); exit(-1); } assert(n >= 2); mpfr_t a, b, x, f, d, fab; //Set a == 0 mpfr_init_set_ui(a, 0, MPFR_RNDN); //Set b = max{1, N} mpfr_init(b); mpfr_max(b, MPFR_ONE, N, MPFR_RNDN); //Set x = (a + b)/2 mpfr_init(x); mpfr_add(x, a, b, MPFR_RNDN); mpfr_mul(x, x, MPFR_HALF, MPFR_RNDN); //Set f = x^2 - N mpfr_init(f); mpfr_init(fab); mpfr_pow_ui(f, x, n, MPFR_RNDN); mpfr_sub(f, f, N, MPFR_RNDN); mpfr_abs(fab, f, MPFR_RNDN); //Set d = b - a mpfr_init(d); mpfr_sub(d, b, a, MPFR_RNDN); while(mpfr_cmp(fab, T) > 0 && mpfr_cmp(d, T) > 0) { //Update the bounds, a and b if(mpfr_cmp_ui(f, 0) < 0) mpfr_set(a, x, MPFR_RNDN); else mpfr_set(b, x, MPFR_RNDN); //Update x mpfr_add(x, a, b, MPFR_RNDN); mpfr_mul(x, x, MPFR_HALF, MPFR_RNDN); //Update f mpfr_pow_ui(f, x, n, MPFR_RNDN); mpfr_sub(f, f, N, MPFR_RNDN); mpfr_abs(fab, f, MPFR_RNDN); } mpfr_set(R, x, MPFR_RNDN); }
void check_inexact (mp_prec_t p) { mpfr_t x, y, z, t; unsigned long u; mp_prec_t q; int inexact, cmp; mp_rnd_t rnd; mpfr_init2 (x, p); mpfr_init (y); mpfr_init (z); mpfr_init (t); mpfr_random (x); u = LONG_RAND() % 2; for (q=2; q<=p; q++) for (rnd=0; rnd<4; rnd++) { mpfr_set_prec (y, q); mpfr_set_prec (z, q + 10); mpfr_set_prec (t, q); inexact = mpfr_pow_ui (y, x, u, rnd); cmp = mpfr_pow_ui (z, x, u, rnd); if (mpfr_can_round (z, q + 10, rnd, rnd, q)) { cmp = mpfr_set (t, z, rnd) || cmp; if (mpfr_cmp (y, t)) { fprintf (stderr, "results differ for u=%lu rnd=%s\n", u, mpfr_print_rnd_mode(rnd)); printf ("x="); mpfr_print_binary (x); putchar ('\n'); printf ("y="); mpfr_print_binary (y); putchar ('\n'); printf ("t="); mpfr_print_binary (t); putchar ('\n'); printf ("z="); mpfr_print_binary (z); putchar ('\n'); exit (1); } if (((inexact == 0) && (cmp != 0)) || ((inexact != 0) && (cmp == 0))) { fprintf (stderr, "Wrong inexact flag for p=%u, q=%u, rnd=%s\n", (unsigned) p, (unsigned) q, mpfr_print_rnd_mode (rnd)); printf ("expected %d, got %d\n", cmp, inexact); printf ("u=%lu x=", u); mpfr_print_binary (x); putchar ('\n'); printf ("y="); mpfr_print_binary (y); putchar ('\n'); exit (1); } } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); }
static void regular (void) { mpfr_t x, y, r; mpfr_inits (x, y, r, (mpfr_ptr) 0); /* remainder = 0 */ mpfr_set_str (y, "FEDCBA987654321p-64", 16, MPFR_RNDN); mpfr_pow_ui (x, y, 42, MPFR_RNDN); check (r, x, y, MPFR_RNDN); /* x < y */ mpfr_set_ui_2exp (x, 64723, -19, MPFR_RNDN); mpfr_mul (x, x, y, MPFR_RNDN); check (r, x, y, MPFR_RNDN); /* sign(x) = sign (r) */ mpfr_set_ui (x, 123798, MPFR_RNDN); mpfr_set_ui (y, 10, MPFR_RNDN); check (r, x, y, MPFR_RNDN); /* huge difference between precisions */ mpfr_set_prec (x, 314); mpfr_set_prec (y, 8); mpfr_set_prec (r, 123); mpfr_const_pi (x, MPFR_RNDD); /* x = pi */ mpfr_set_ui_2exp (y, 1, 3, MPFR_RNDD); /* y = 1/8 */ check (r, x, y, MPFR_RNDD); mpfr_clears (x, y, r, (mpfr_ptr) 0); }
static void _taylor_mpfr (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd) { NcmBinSplit **bs_ptr = _ncm_mpsf_sbessel_get_bs (); NcmBinSplit *bs = *bs_ptr; _binsplit_spherical_bessel *data = (_binsplit_spherical_bessel *) bs->userdata; gulong n; data->l = l; mpq_mul (data->mq2_2, q, q); mpq_neg (data->mq2_2, data->mq2_2); mpq_div_2exp (data->mq2_2, data->mq2_2, 1); //mpfr_printf ("# Taylor %ld %Qd | %Qd\n", l, q, data->mq2_2); ncm_binsplit_eval_prec (bs, binsplit_spherical_bessel_taylor, 10, mpfr_get_prec (res)); //mpfr_printf ("# Taylor %ld %Qd | %Zd %Zd\n", l, q, bs->T, bs->Q); mpfr_set_q (res, q, rnd); mpfr_pow_ui (res, res, l, rnd); mpfr_mul_z (res, res, bs->T, rnd); mpfr_div_z (res, res, bs->Q, rnd); for (n = 1; n <= l; n++) mpfr_div_ui (res, res, 2L * n + 1, rnd); ncm_memory_pool_return (bs_ptr); return; }
int mpfr_mat_R_reduced(__mpfr_struct ** R, long d, double delta, double eta, mp_prec_t prec) { if (d == 1) return 1; mpfr_t tmp1; mpfr_t tmp2; mpfr_init2(tmp1, prec); mpfr_init2(tmp2, prec); int reduced = 1; long i; for (i = 0; (i < d - 1) && (reduced == 1); i++) { mpfr_pow_ui(tmp1, R[i+1] + i, 2L, GMP_RNDN); mpfr_pow_ui(tmp2, R[i+1] + i + 1, 2L, GMP_RNDN); mpfr_add(tmp1, tmp1, tmp2, GMP_RNDN); mpfr_pow_ui(tmp2, R[i] + i, 2L, GMP_RNDN); mpfr_mul_d(tmp2, tmp2, (double) delta, GMP_RNDN); mpfr_sub(tmp1, tmp1, tmp2, GMP_RNDN); // mpfr_add_d(tmp1, tmp1, .001, GMP_RNDN); if (mpfr_sgn(tmp1) < 0) { reduced = 0; printf(" happened at index i = %ld\n", i); break; } long j; for (j = 0; (j < i) && (reduced == 1); j++) { mpfr_mul_d(tmp2, R[i + 1] + i + 1, (double) eta, GMP_RNDN); if (mpfr_cmpabs(R[j] + i, tmp2) > 0) { reduced = 0; printf(" size red problem at index i = %ld, j = %ld\n", i, j); break; } } } mpfr_clear(tmp1); mpfr_clear(tmp2); return reduced; }
/* Function to generate the binomial pdf */ void inpdf(mpfr_t *out,mpz_t n,int psize,double pini,double pinc,unsigned long mu,mpfr_t bcs[],mpfr_prec_t prec) { mpfr_t s; mpfr_init2(s,prec); mpfr_t f; mpfr_init2(f,prec); mpfr_t unity; mpfr_init2(unity,prec); mpfr_set_ui(unity,(unsigned long int) 1,MPFR_RNDN); mpfr_t Z; mpfr_init2(Z,prec); mpfr_set_d(Z,0,MPFR_RNDN); mpfr_t pfr; mpfr_init2(pfr,prec); int pdex; int odex; int odn; int i; for(pdex=0;pdex<=psize-1;pdex=pdex++) { mpfr_set_d(pfr,pini+pdex*pinc,MPFR_RNDN); for(i=0;i<=mu;i++) { odex=pdex*(mu+1)+i; mpfr_pow_ui(s, pfr,(unsigned long int)i,MPFR_RNDN); mpfr_sub(f, unity, pfr,MPFR_RNDN); mpfr_pow_ui(f,f,(unsigned long int)mu-i,MPFR_RNDN); mpfr_mul(*(out+odex),s,f,MPFR_RNDN); mpfr_mul(*(out+odex),bcs[i],*(out+odex),MPFR_RNDN); mpfr_add(Z,Z,*(out+odex),MPFR_RNDN); } for(i=0;i<=mu;i++) odn=pdex*(mu+1)+i; mpfr_div(*(out+odn), *(out+odn),Z,MPFR_RNDN); } mpfr_clear(pfr); mpfr_clear(s); mpfr_clear(f); mpfr_clear(unity); mpfr_clear(Z); }
/** * Wrapper function to find the square of the log of a number of type mpz_t. */ void compute_logn2(mpz_t rop, mpz_t n) { mpfr_t tmp; mpfr_init(tmp); mpfr_set_z(tmp, n, MPFR_RNDN); mpfr_log(tmp, tmp, MPFR_RNDA); mpfr_pow_ui(tmp, tmp, 2, MPFR_RNDA); mpfr_ceil(tmp, tmp); mpfr_get_z(rop, tmp, MPFR_RNDA); mpfr_clear(tmp); }
void _arith_euler_number_zeta(fmpz_t res, ulong n) { mpz_t r; mpfr_t t, z, pi; mp_bitcnt_t prec, pi_prec; if (n % 2) { fmpz_zero(res); return; } if (n < SMALL_EULER_LIMIT) { fmpz_set_ui(res, euler_number_small[n / 2]); if (n % 4 == 2) fmpz_neg(res, res); return; } prec = arith_euler_number_size(n) + 10; pi_prec = prec + FLINT_BIT_COUNT(n); mpz_init(r); mpfr_init2(t, prec); mpfr_init2(z, prec); mpfr_init2(pi, pi_prec); flint_mpz_fac_ui(r, n); mpfr_set_z(t, r, GMP_RNDN); mpfr_mul_2exp(t, t, n + 2, GMP_RNDN); /* pi^(n + 1) * L(n+1) */ mpfr_zeta_inv_euler_product(z, n + 1, 1); mpfr_const_pi(pi, GMP_RNDN); mpfr_pow_ui(pi, pi, n + 1, GMP_RNDN); mpfr_mul(z, z, pi, GMP_RNDN); mpfr_div(t, t, z, GMP_RNDN); /* round */ mpfr_round(t, t); mpfr_get_z(r, t, GMP_RNDN); fmpz_set_mpz(res, r); if (n % 4 == 2) fmpz_neg(res, res); mpz_clear(r); mpfr_clear(t); mpfr_clear(z); mpfr_clear(pi); }
void check_pow_ui (void) { mpfr_t a, b; mpfr_init2 (a, 53); mpfr_init2 (b, 53); /* check in-place operations */ mpfr_set_d (b, 0.6926773, GMP_RNDN); mpfr_pow_ui (a, b, 10, GMP_RNDN); mpfr_pow_ui (b, b, 10, GMP_RNDN); if (mpfr_cmp (a, b)) { fprintf (stderr, "Error for mpfr_pow_ui (b, b, ...)\n"); exit (1); } /* check large exponents */ mpfr_set_d (b, 1, GMP_RNDN); mpfr_pow_ui (a, b, 4294967295UL, GMP_RNDN); mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, 4049053855UL, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) >= 0)) { fprintf (stderr, "Error for (-Inf)^4049053855\n"); exit (1); } mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, (unsigned long) 30002752, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) <= 0)) { fprintf (stderr, "Error for (-Inf)^30002752\n"); exit (1); } mpfr_clear (a); mpfr_clear (b); }
/* returns a lower bound of the number of significant bits of n! (not counting the low zero bits). We know n! >= (n/e)^n*sqrt(2*Pi*n) for n >= 1, and the number of zero bits is floor(n/2) + floor(n/4) + floor(n/8) + ... This approximation is exact for n <= 500000, except for n = 219536, 235928, 298981, 355854, 464848, 493725, 498992 where it returns a value 1 too small. */ static unsigned long bits_fac (unsigned long n) { mpfr_t x, y; unsigned long r, k; mpfr_init2 (x, 38); mpfr_init2 (y, 38); mpfr_set_ui (x, n, MPFR_RNDZ); mpfr_set_str_binary (y, "10.101101111110000101010001011000101001"); /* upper bound of e */ mpfr_div (x, x, y, MPFR_RNDZ); mpfr_pow_ui (x, x, n, MPFR_RNDZ); mpfr_const_pi (y, MPFR_RNDZ); mpfr_mul_ui (y, y, 2 * n, MPFR_RNDZ); mpfr_sqrt (y, y, MPFR_RNDZ); mpfr_mul (x, x, y, MPFR_RNDZ); mpfr_log2 (x, x, MPFR_RNDZ); r = mpfr_get_ui (x, MPFR_RNDU); for (k = 2; k <= n; k *= 2) r -= n / k; mpfr_clear (x); mpfr_clear (y); return r; }
int mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd) { MPFR_LOG_FUNC (("x[%Pu]=%.*Rg n=%ld rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, n, rnd), ("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y)); if (n >= 0) return mpfr_pow_ui (y, x, n, rnd); else { if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else { int positive = MPFR_IS_POS (x) || ((unsigned long) n & 1) == 0; if (MPFR_IS_INF (x)) MPFR_SET_ZERO (y); else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_INF (y); mpfr_set_divby0 (); } if (positive) MPFR_SET_POS (y); else MPFR_SET_NEG (y); MPFR_RET (0); } } /* detect exact powers: x^(-n) is exact iff x is a power of 2 */ if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0) { mpfr_exp_t expx = MPFR_EXP (x) - 1, expy; MPFR_ASSERTD (n < 0); /* Warning: n * expx may overflow! * * Some systems (apparently alpha-freebsd) abort with * LONG_MIN / 1, and LONG_MIN / -1 is undefined. * http://www.freebsd.org/cgi/query-pr.cgi?pr=72024 * * Proof of the overflow checking. The expressions below are * assumed to be on the rational numbers, but the word "overflow" * still has its own meaning in the C context. / still denotes * the integer (truncated) division, and // denotes the exact * division. * - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n * cannot overflow due to the constraints on the exponents of * MPFR numbers. * - If n = -1, then n * expx = - expx, which is representable * because of the constraints on the exponents of MPFR numbers. * - If expx = 0, then n * expx = 0, which is representable. * - If n < -1 and expx > 0: * + If expx > (__gmpfr_emin - 1) / n, then * expx >= (__gmpfr_emin - 1) / n + 1 * > (__gmpfr_emin - 1) // n, * and * n * expx < __gmpfr_emin - 1, * i.e. * n * expx <= __gmpfr_emin - 2. * This corresponds to an underflow, with a null result in * the rounding-to-nearest mode. * + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot * overflow since 0 < expx <= (__gmpfr_emin - 1) / n and * 0 > n * expx >= n * ((__gmpfr_emin - 1) / n) * >= __gmpfr_emin - 1. * - If n < -1 and expx < 0: * + If expx < (__gmpfr_emax - 1) / n, then * expx <= (__gmpfr_emax - 1) / n - 1 * < (__gmpfr_emax - 1) // n, * and * n * expx > __gmpfr_emax - 1, * i.e. * n * expx >= __gmpfr_emax. * This corresponds to an overflow (2^(n * expx) has an * exponent > __gmpfr_emax). * + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot * overflow since 0 > expx >= (__gmpfr_emax - 1) / n and * 0 < n * expx <= n * ((__gmpfr_emax - 1) / n) * <= __gmpfr_emax - 1. * Note: one could use expx bounds based on MPFR_EXP_MIN and * MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The * current bounds do not lead to noticeably slower code and * allow us to avoid a bug in Sun's compiler for Solaris/x86 * (when optimizations are enabled); known affected versions: * cc: Sun C 5.8 2005/10/13 * cc: Sun C 5.8 Patch 121016-02 2006/03/31 * cc: Sun C 5.8 Patch 121016-04 2006/10/18 */ expy = n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ? MPFR_EMIN_MIN - 2 /* Underflow */ : n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ? MPFR_EMAX_MAX /* Overflow */ : n * expx; return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1, expy, rnd); } /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mpfr_prec_t Ny; /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_rnd_t rnd1; int size_n; int inexact; unsigned long abs_n; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); abs_n = - (unsigned long) n; count_leading_zeros (size_n, (mp_limb_t) abs_n); size_n = GMP_NUMB_BITS - size_n; /* initial working precision */ Ny = MPFR_PREC (y); Nt = Ny + size_n + 3 + MPFR_INT_CEIL_LOG2 (Ny); MPFR_SAVE_EXPO_MARK (expo); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); /* We will compute rnd(rnd1(1/x) ^ |n|), where rnd1 is the rounding toward sign(x), to avoid spurious overflow or underflow, as in mpfr_pow_z. */ rnd1 = MPFR_EXP (x) < 1 ? MPFR_RNDZ : (MPFR_SIGN (x) > 0 ? MPFR_RNDU : MPFR_RNDD); MPFR_ZIV_INIT (loop, Nt); for (;;) { MPFR_BLOCK_DECL (flags); /* compute (1/x)^|n| */ MPFR_BLOCK (flags, mpfr_ui_div (t, 1, x, rnd1)); MPFR_ASSERTD (! MPFR_UNDERFLOW (flags)); /* t = (1/x)*(1+theta) where |theta| <= 2^(-Nt) */ if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) goto overflow; MPFR_BLOCK (flags, mpfr_pow_ui (t, t, abs_n, rnd)); /* t = (1/x)^|n|*(1+theta')^(|n|+1) where |theta'| <= 2^(-Nt). If (|n|+1)*2^(-Nt) <= 1/2, which is satisfied as soon as Nt >= bits(n)+2, then we can use Lemma \ref{lemma_graillat} from algorithms.tex, which yields x^n*(1+theta) with |theta| <= 2(|n|+1)*2^(-Nt), thus the error is bounded by 2(|n|+1) ulps <= 2^(bits(n)+2) ulps. */ if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) { overflow: MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); MPFR_LOG_MSG (("overflow\n", 0)); return mpfr_overflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags))) { MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_LOG_MSG (("underflow\n", 0)); if (rnd == MPFR_RNDN) { mpfr_t y2, nn; /* We cannot decide now whether the result should be rounded toward zero or away from zero. So, like in mpfr_pow_pos_z, let's use the general case of mpfr_pow in precision 2. */ MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_SIGN (x), MPFR_EXP (x) - 1) != 0); mpfr_init2 (y2, 2); mpfr_init2 (nn, sizeof (long) * CHAR_BIT); inexact = mpfr_set_si (nn, n, MPFR_RNDN); MPFR_ASSERTN (inexact == 0); inexact = mpfr_pow_general (y2, x, nn, rnd, 1, (mpfr_save_expo_t *) NULL); mpfr_clear (nn); mpfr_set (y, y2, MPFR_RNDN); mpfr_clear (y2); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW); goto end; } else { MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } } /* error estimate -- see pow function in algorithms.ps */ if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - size_n - 2, Ny, rnd))) break; /* actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, t, rnd); mpfr_clear (t); end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd); } } }
/* Compare the result (z1,inex1) of mpfr_pow with all flags cleared with those of mpfr_pow with all flags set and of the other power functions. Arguments x and y are the input values; sx and sy are their string representations (sx may be null); rnd contains the rounding mode; s is a string containing the function that called test_others. */ static void test_others (const void *sx, const char *sy, mpfr_rnd_t rnd, mpfr_srcptr x, mpfr_srcptr y, mpfr_srcptr z1, int inex1, unsigned int flags, const char *s) { mpfr_t z2; int inex2; int spx = sx != NULL; if (!spx) sx = x; mpfr_init2 (z2, mpfr_get_prec (z1)); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_pow (z2, x, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_pow, flags set"); /* If y is an integer that fits in an unsigned long and is not -0, we can test mpfr_pow_ui. */ if (MPFR_IS_POS (y) && mpfr_integer_p (y) && mpfr_fits_ulong_p (y, MPFR_RNDN)) { unsigned long yy = mpfr_get_ui (y, MPFR_RNDN); mpfr_clear_flags (); inex2 = mpfr_pow_ui (z2, x, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_pow_ui, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_pow_ui (z2, x, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_pow_ui, flags set"); /* If x is an integer that fits in an unsigned long and is not -0, we can also test mpfr_ui_pow_ui. */ if (MPFR_IS_POS (x) && mpfr_integer_p (x) && mpfr_fits_ulong_p (x, MPFR_RNDN)) { unsigned long xx = mpfr_get_ui (x, MPFR_RNDN); mpfr_clear_flags (); inex2 = mpfr_ui_pow_ui (z2, xx, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_ui_pow_ui, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_ui_pow_ui (z2, xx, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_ui_pow_ui, flags set"); } } /* If y is an integer but not -0 and not huge, we can test mpfr_pow_z, and possibly mpfr_pow_si (and possibly mpfr_ui_div). */ if (MPFR_IS_ZERO (y) ? MPFR_IS_POS (y) : (mpfr_integer_p (y) && MPFR_GET_EXP (y) < 256)) { mpz_t yyy; /* If y fits in a long, we can test mpfr_pow_si. */ if (mpfr_fits_slong_p (y, MPFR_RNDN)) { long yy = mpfr_get_si (y, MPFR_RNDN); mpfr_clear_flags (); inex2 = mpfr_pow_si (z2, x, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_pow_si, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_pow_si (z2, x, yy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_pow_si, flags set"); /* If y = -1, we can test mpfr_ui_div. */ if (yy == -1) { mpfr_clear_flags (); inex2 = mpfr_ui_div (z2, 1, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_ui_div, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_ui_div (z2, 1, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_ui_div, flags set"); } /* If y = 2, we can test mpfr_sqr. */ if (yy == 2) { mpfr_clear_flags (); inex2 = mpfr_sqr (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_sqr, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_sqr (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_sqr, flags set"); } } /* Test mpfr_pow_z. */ mpz_init (yyy); mpfr_get_z (yyy, y, MPFR_RNDN); mpfr_clear_flags (); inex2 = mpfr_pow_z (z2, x, yyy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_pow_z, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_pow_z (z2, x, yyy, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_pow_z, flags set"); mpz_clear (yyy); } /* If y = 0.5, we can test mpfr_sqrt, except if x is -0 or -Inf (because the rule for mpfr_pow on these special values is different). */ if (MPFR_IS_PURE_FP (y) && mpfr_cmp_str1 (y, "0.5") == 0 && ! ((MPFR_IS_ZERO (x) || MPFR_IS_INF (x)) && MPFR_IS_NEG (x))) { mpfr_clear_flags (); inex2 = mpfr_sqrt (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_sqrt, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_sqrt (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_sqrt, flags set"); } #if MPFR_VERSION >= MPFR_VERSION_NUM(2,4,0) /* If y = -0.5, we can test mpfr_rec_sqrt, except if x = -Inf (because the rule for mpfr_pow on -Inf is different). */ if (MPFR_IS_PURE_FP (y) && mpfr_cmp_str1 (y, "-0.5") == 0 && ! (MPFR_IS_INF (x) && MPFR_IS_NEG (x))) { mpfr_clear_flags (); inex2 = mpfr_rec_sqrt (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_rec_sqrt, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_rec_sqrt (z2, x, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_rec_sqrt, flags set"); } #endif /* If x is an integer that fits in an unsigned long and is not -0, we can test mpfr_ui_pow. */ if (MPFR_IS_POS (x) && mpfr_integer_p (x) && mpfr_fits_ulong_p (x, MPFR_RNDN)) { unsigned long xx = mpfr_get_ui (x, MPFR_RNDN); mpfr_clear_flags (); inex2 = mpfr_ui_pow (z2, xx, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_ui_pow, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_ui_pow (z2, xx, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_ui_pow, flags set"); /* If x = 2, we can test mpfr_exp2. */ if (xx == 2) { mpfr_clear_flags (); inex2 = mpfr_exp2 (z2, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_exp2, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_exp2 (z2, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_exp2, flags set"); } /* If x = 10, we can test mpfr_exp10. */ if (xx == 10) { mpfr_clear_flags (); inex2 = mpfr_exp10 (z2, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags, s, "mpfr_exp10, flags cleared"); __gmpfr_flags = MPFR_FLAGS_ALL; inex2 = mpfr_exp10 (z2, y, rnd); cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL, s, "mpfr_exp10, flags set"); } } mpfr_clear (z2); }
void inline mpfr_digits_to_tolerance(unsigned int D, mpfr_t T) { mpfr_init_set_ui(T, 10, MPFR_RNDN); mpfr_pow_ui(T, T, D, MPFR_RNDN); mpfr_ui_div(T, 1, T, MPFR_RNDN); }
int mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd_mode) { if (n > 0) return mpfr_pow_ui(y, x, n, rnd_mode); else { int inexact = 0; if (MPFR_IS_NAN(x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } MPFR_CLEAR_NAN(y); if (n == 0) return mpfr_set_ui(y, 1, GMP_RNDN); if (MPFR_IS_INF(x)) { MPFR_SET_ZERO(y); if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0) MPFR_SET_POS(y); else MPFR_SET_NEG(y); MPFR_RET(0); } if (MPFR_IS_ZERO(x)) { MPFR_SET_INF(y); if (MPFR_SIGN(x) > 0 || ((unsigned) n & 1) == 0) MPFR_SET_POS(y); else MPFR_SET_NEG(y); MPFR_RET(0); } MPFR_CLEAR_INF(y); n = -n; /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, ti; /* Declaration of the size variable */ mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */ mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */ mp_prec_t Nt; /* Precision of the intermediary variable */ long int err; /* Precision of error */ /* compute the precision of intermediary variable */ Nt=MAX(Nx,Ny); /* the optimal number of bits : see algorithms.ps */ Nt=Nt+3+_mpfr_ceil_log2(Nt); /* initialise of intermediary variable */ mpfr_init(t); mpfr_init(ti); do { /* reactualisation of the precision */ mpfr_set_prec(t,Nt); mpfr_set_prec(ti,Nt); /* compute 1/(x^n) n>0*/ mpfr_pow_ui(ti,x,(unsigned long int)(n),GMP_RNDN); mpfr_ui_div(t,1,ti,GMP_RNDN); /* estimation of the error -- see pow function in algorithms.ps*/ err = Nt - 3; /* actualisation of the precision */ Nt += 10; } while (err<0 || !mpfr_can_round(t,err,GMP_RNDN,rnd_mode,Ny)); inexact = mpfr_set(y,t,rnd_mode); mpfr_clear(t); mpfr_clear(ti); } return inexact; } }
int mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd) { if (n >= 0) return mpfr_pow_ui (y, x, n, rnd); else { if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) { MPFR_SET_ZERO (y); if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0) MPFR_SET_POS (y); else MPFR_SET_NEG (y); MPFR_RET (0); } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_INF(y); if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0) MPFR_SET_POS (y); else MPFR_SET_NEG (y); MPFR_RET(0); } } MPFR_CLEAR_FLAGS (y); /* detect exact powers: x^(-n) is exact iff x is a power of 2 */ if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0) { mp_exp_t expx = MPFR_EXP (x) - 1, expy; MPFR_ASSERTD (n < 0); /* Warning: n * expx may overflow! * Some systems (apparently alpha-freebsd) abort with * LONG_MIN / 1, and LONG_MIN / -1 is undefined. * Proof of the overflow checking. The expressions below are * assumed to be on the rational numbers, but the word "overflow" * still has its own meaning in the C context. / still denotes * the integer (truncated) division, and // denotes the exact * division. * - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n * cannot overflow due to the constraints on the exponents of * MPFR numbers. * - If n = -1, then n * expx = - expx, which is representable * because of the constraints on the exponents of MPFR numbers. * - If expx = 0, then n * expx = 0, which is representable. * - If n < -1 and expx > 0: * + If expx > (__gmpfr_emin - 1) / n, then * expx >= (__gmpfr_emin - 1) / n + 1 * > (__gmpfr_emin - 1) // n, * and * n * expx < __gmpfr_emin - 1, * i.e. * n * expx <= __gmpfr_emin - 2. * This corresponds to an underflow, with a null result in * the rounding-to-nearest mode. * + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot * overflow since 0 < expx <= (__gmpfr_emin - 1) / n and * 0 > n * expx >= n * ((__gmpfr_emin - 1) / n) * >= __gmpfr_emin - 1. * - If n < -1 and expx < 0: * + If expx < (__gmpfr_emax - 1) / n, then * expx <= (__gmpfr_emax - 1) / n - 1 * < (__gmpfr_emax - 1) // n, * and * n * expx > __gmpfr_emax - 1, * i.e. * n * expx >= __gmpfr_emax. * This corresponds to an overflow (2^(n * expx) has an * exponent > __gmpfr_emax). * + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot * overflow since 0 > expx >= (__gmpfr_emax - 1) / n and * 0 < n * expx <= n * ((__gmpfr_emax - 1) / n) * <= __gmpfr_emax - 1. * Note: one could use expx bounds based on MPFR_EXP_MIN and * MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The * current bounds do not lead to noticeably slower code and * allow us to avoid a bug in Sun's compiler for Solaris/x86 * (when optimizations are enabled). */ expy = n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ? MPFR_EMIN_MIN - 2 /* Underflow */ : n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ? MPFR_EMAX_MAX /* Overflow */ : n * expx; return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1, expy, rnd); } /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mp_prec_t Ny = MPFR_PREC (y); /* target precision */ mp_prec_t Nt; /* working precision */ mp_exp_t err; /* error */ int inexact; unsigned long abs_n; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); abs_n = - (unsigned long) n; /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 3 + MPFR_INT_CEIL_LOG2 (Ny); MPFR_SAVE_EXPO_MARK (expo); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute 1/(x^n), with n > 0 */ mpfr_pow_ui (t, x, abs_n, GMP_RNDN); mpfr_ui_div (t, 1, t, GMP_RNDN); /* FIXME: old code improved, but I think this is still incorrect. */ if (MPFR_UNLIKELY (MPFR_IS_ZERO (t))) { MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (y, rnd == GMP_RNDN ? GMP_RNDZ : rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } if (MPFR_UNLIKELY (MPFR_IS_INF (t))) { MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } /* error estimate -- see pow function in algorithms.ps */ err = Nt - 3; if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd))) break; /* actualisation of the precision */ Nt += BITS_PER_MP_LIMB; mpfr_set_prec (t, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, t, rnd); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd); } } }
int mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r) { int inex; unsigned long absn; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex)); absn = SAFE_ABS (unsigned long, n); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z))) { if (MPFR_IS_NAN (z)) { MPFR_SET_NAN (res); /* y(n,NaN) = NaN */ MPFR_RET_NAN; } /* y(n,z) tends to zero when z goes to +Inf, oscillating around 0. We choose to return +0 in that case. */ else if (MPFR_IS_INF (z)) { if (MPFR_SIGN(z) > 0) return mpfr_set_ui (res, 0, r); else /* y(n,-Inf) = NaN */ { MPFR_SET_NAN (res); MPFR_RET_NAN; } } else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise, when z goes to zero */ { MPFR_SET_INF(res); if (n >= 0 || ((unsigned long) n & 1) == 0) MPFR_SET_NEG(res); else MPFR_SET_POS(res); mpfr_set_divby0 (); MPFR_RET(0); } } /* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we assume does not happen for a rational z. */ if (MPFR_SIGN(z) < 0) { MPFR_SET_NAN (res); MPFR_RET_NAN; } /* now z is not singular, and z > 0 */ MPFR_SAVE_EXPO_MARK (expo); /* Deal with tiny arguments. We have: y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z), g(z) - 0.41*z^2 < y0(z)/log(z) < g(z) thus since log(z) is negative: g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z) and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2. Note: we use both the main term in log(z) and the constant term, because otherwise the relative error would be only in 1/log(|log(z)|). */ if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2)) { mpfr_t l, h, t, logz; mpfr_prec_t prec; int ok, inex2; prec = MPFR_PREC(res) + 10; mpfr_init2 (l, prec); mpfr_init2 (h, prec); mpfr_init2 (t, prec); mpfr_init2 (logz, prec); /* first enclose log(z) + euler - log(2) = log(z/2) + euler */ mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */ mpfr_set (h, logz, MPFR_RNDU); /* exact */ mpfr_nextabove (h); /* upper bound of log(z) */ mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */ mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */ mpfr_nextabove (t); /* upper bound of euler */ mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */ mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */ mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */ mpfr_nextbelow (t); /* lower bound of log(2) */ mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */ mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */ mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */ mpfr_nextbelow (t); /* lower bound of Pi */ mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */ mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */ mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */ /* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z) to h */ mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */ /* since logz is negative, a lower bound corresponds to an upper bound for its absolute value */ mpfr_neg (t, t, MPFR_RNDD); mpfr_div_2ui (t, t, 1, MPFR_RNDD); mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */ mpfr_add (h, h, t, MPFR_RNDU); inex = mpfr_prec_round (l, MPFR_PREC(res), r); inex2 = mpfr_prec_round (h, MPFR_PREC(res), r); /* we need h=l and inex=inex2 */ ok = (inex == inex2) && mpfr_equal_p (l, h); if (ok) mpfr_set (res, h, r); /* exact */ mpfr_clear (l); mpfr_clear (h); mpfr_clear (t); mpfr_clear (logz); if (ok) goto end; } /* small argument check for y1(z) = -2/Pi/z + O(log(z)): for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */ if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res)) { mpfr_t y; mpfr_prec_t prec; mpfr_exp_t err1; int ok; MPFR_BLOCK_DECL (flags); /* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1), then |y1(z)| > 2^emax */ prec = MPFR_PREC(res) + 10; mpfr_init2 (y, prec); mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u represents a quantity <= 1/2^prec */ mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */ MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ)); /* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */ if (MPFR_OVERFLOW (flags)) { mpfr_clear (y); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (res, r, -1); } mpfr_neg (y, y, MPFR_RNDN); /* (1+u)^6 can be written 1+7u [for another value of u], thus the error on 2/Pi/z is less than 7ulp(y). The truncation error is less than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y), otherwise it is less than 1/4+7/8 <= 2. */ if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */ err1 = 3; else /* ulp(y) <= 1/8 */ err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1; ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r); if (ok) inex = mpfr_set (res, y, r); mpfr_clear (y); if (ok) goto end; } /* we can use the asymptotic expansion as soon as z > p log(2)/2, but to get some margin we use it for z > p/2 */ if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0) { inex = mpfr_yn_asympt (res, n, z, r); if (inex != 0) goto end; } /* General case */ { mpfr_prec_t prec; mpfr_exp_t err1, err2, err3; mpfr_t y, s1, s2, s3; MPFR_ZIV_DECL (loop); mpfr_init (y); mpfr_init (s1); mpfr_init (s2); mpfr_init (s3); prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13; MPFR_ZIV_INIT (loop, prec); for (;;) { mpfr_set_prec (y, prec); mpfr_set_prec (s1, prec); mpfr_set_prec (s2, prec); mpfr_set_prec (s3, prec); mpfr_mul (y, z, z, MPFR_RNDN); mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */ /* store (z/2)^n temporarily in s2 */ mpfr_pow_ui (s2, z, absn, MPFR_RNDN); mpfr_div_2si (s2, s2, absn, MPFR_RNDN); /* compute S1 * (z/2)^(-n) */ if (n == 0) { mpfr_set_ui (s1, 0, MPFR_RNDN); err1 = 0; } else err1 = mpfr_yn_s1 (s1, y, absn - 1); mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */ /* See algorithms.tex: the relative error on s1 is bounded by (3n+3)*2^(e+1-prec). */ err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1; /* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */ /* compute (z/2)^n * S3 */ mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */ err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */ /* the error on s3 is bounded by 2^err3 ulps */ /* add s1+s3 */ err1 += MPFR_EXP(s1); mpfr_add (s1, s1, s3, MPFR_RNDN); /* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1)) + 2^err3*2^(EXP(s3) - EXP(s1)) */ err3 += MPFR_EXP(s3); err1 = (err3 > err1) ? err3 + 1 : err1 + 1; err1 -= MPFR_EXP(s1); err1 = (err1 >= 0) ? err1 + 1 : 1; /* now the error on s1 is bounded by 2^err1*ulp(s1) */ /* compute S2 */ mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */ mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */ mpfr_const_euler (s3, MPFR_RNDN); err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3); mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */ err2 -= MPFR_EXP(s2); mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */ mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */ mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */ err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see algorithms.tex */ /* add all three sums */ err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */ err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */ mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */ err2 = (err1 > err2) ? err1 + 1 : err2 + 1; err2 -= MPFR_EXP(s2); err2 = (err2 >= 0) ? err2 + 1 : 1; /* now the error on s2 is bounded by 2^err2*ulp(s2) */ mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */ mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by 2^(err2+1)*ulp(s2) */ err2 ++; if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r))) break; MPFR_ZIV_NEXT (loop, prec); } MPFR_ZIV_FREE (loop); /* Assume two's complement for the test n & 1 */ inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ? MPFR_SIGN (s2) : - MPFR_SIGN (s2)); mpfr_clear (y); mpfr_clear (s1); mpfr_clear (s2); mpfr_clear (s3); } end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (res, inex, r); }
/* Function to calculate the entropy */ void eff_point(mpfr_t *ent, mpfr_t *ipdf, mpfr_t *jdist, mpfr_t *pp, mpfr_t *gamma_bcs, mpfr_t *p0, int conns, int phi, int mu, int gamma, double pin, double xi, double yi, double delta, mpfr_prec_t prec) { unsigned int z,sx,sy,i; int ppdex=0,p0dex=0,thr; double po,cost; double *bpdf; bpdf=(double *) malloc((conns+1)*sizeof(double)); binomialpdf(bpdf,conns,pin); //CONSIDER USING GSL version here? mpfr_t rp; mpfr_init2(rp,prec); mpfr_set_d(rp,0,MPFR_RNDN); mpfr_t nunity; mpfr_init2(nunity,prec); mpfr_set_d(nunity,-1,MPFR_RNDN); mpfr_t tbin; mpfr_init2(tbin,prec); mpfr_t t1; mpfr_init2(t1,prec); mpfr_t gate; mpfr_init2(gate,prec); mpfr_t qa; mpfr_init2(qa,prec); mpfr_t s0; mpfr_init2(s0,prec); mpfr_t jdist_tot; mpfr_init2(jdist_tot,prec); for(thr=phi;thr<=conns;thr++) po=po+*(bpdf+thr); cost=mu*(pin*xi+(1-pin))+delta*gamma*(po*yi+(1-po)); for(sx=0;sx<=mu;sx++) { ppdex=sx; p0dex=sx; for(sy=1;sy<=gamma;sy++) { mpfr_set_d(qa,0,MPFR_RNDN); for(z=0;z<=gamma-sy;z++) { mpfr_pow_ui(rp,nunity,(unsigned long int)z,MPFR_RNDN); mpfr_mul(rp,rp,*(gamma_bcs+(gamma-sy)*(gamma+1)+z),MPFR_RNDN); if(mpfr_cmp_d(*(pp+ppdex),0)>0) { if(mpfr_cmp(*(p0+p0dex),*(pp+ppdex))>0) mpfr_set_d(gate,1,MPFR_RNDN); else { mpfr_sub(gate,*(pp+ppdex),*(p0+p0dex),MPFR_RNDN); mpfr_div(gate,gate,*(pp+ppdex),MPFR_RNDN); } mpfr_pow_ui(t1,*(pp+ppdex),(unsigned long int)z+sy,MPFR_RNDN); mpfr_mul(rp,rp,gate,MPFR_RNDN); } else mpfr_set_d(t1,0,MPFR_RNDN); mpfr_mul(rp,rp,t1,MPFR_RNDN); mpfr_add(qa,qa,rp,MPFR_RNDN); } mpfr_add(qa,qa,*(p0+p0dex),MPFR_RNDN); mpfr_set_d(jdist_tot,0,MPFR_RNDN); for(i=0;i<=mu;i++) { if(i!=sx) mpfr_add(jdist_tot, jdist_tot,*(jdist+i*(gamma+1)+sy),MPFR_RNDN); } mpfr_div(jdist_tot,jdist_tot,*(gamma_bcs+gamma*(gamma+1)+sy),MPFR_RNDN); mpfr_mul(qa,qa,*(ipdf+sx),MPFR_RNDN); mpfr_add(qa,qa,jdist_tot,MPFR_RNDN); if(mpfr_cmp_d(qa,0)>0) { mpfr_log2(qa,qa,MPFR_RNDN); mpfr_mul(qa,qa,*(jdist+sx*(gamma+1)+sy),MPFR_RNDN); } else mpfr_set_d(qa,0,MPFR_RNDN); mpfr_sub(*ent,*ent,qa,MPFR_RNDN); } } mpfr_set_d(jdist_tot,0,MPFR_RNDN); for(i=0;i<=mu;i++) mpfr_add(jdist_tot, jdist_tot,*(jdist+i*(gamma+1)),MPFR_RNDN); if(mpfr_cmp_d(jdist_tot,0)>0) { mpfr_log2(s0,jdist_tot,MPFR_RNDN); mpfr_mul(s0,jdist_tot,s0,MPFR_RNDN); mpfr_sub(*ent,*ent,s0,MPFR_RNDN); mpfr_div_d(*ent,*ent,cost,MPFR_RNDN); } mpfr_clear(s0); mpfr_clear(rp); mpfr_clear(nunity); mpfr_clear(tbin); mpfr_clear(t1); free(bpdf); }
int main(int argc, char **argv) { mpfr_t tmp1; mpfr_t tmp2; mpfr_t tmp3; mpfr_t s1; mpfr_t s2; mpfr_t r; mpfr_t a1; mpfr_t a2; time_t start_time; time_t end_time; // Parse command line opts int hide_pi = 0; if(argc == 2) { if(strcmp(argv[1], "--hide-pi") == 0) { hide_pi = 1; } else if((precision = atoi(argv[1])) == 0) { fprintf(stderr, "Invalid precision specified. Aborting.\n"); return 1; } } else if(argc == 3) { if(strcmp(argv[1], "--hide-pi") == 0) { hide_pi = 1; } if((precision = atoi(argv[2])) == 0) { fprintf(stderr, "Invalid precision specified. Aborting.\n"); return 1; } } // If the precision was not specified, default it if(precision == 0) { precision = DEFAULT_PRECISION; } // Actual number of correct digits is roughly 3.35 times the requested precision precision *= 3.35; mpfr_set_default_prec(precision); mpfr_inits(tmp1, tmp2, tmp3, s1, s2, r, a1, a2, NULL); start_time = time(NULL); // a0 = 1/3 mpfr_set_ui(a1, 1, MPFR_RNDN); mpfr_div_ui(a1, a1, 3, MPFR_RNDN); // s0 = (3^.5 - 1) / 2 mpfr_sqrt_ui(s1, 3, MPFR_RNDN); mpfr_sub_ui(s1, s1, 1, MPFR_RNDN); mpfr_div_ui(s1, s1, 2, MPFR_RNDN); unsigned long i = 0; while(i < MAX_ITERS) { // r = 3 / (1 + 2(1-s^3)^(1/3)) mpfr_pow_ui(tmp1, s1, 3, MPFR_RNDN); mpfr_ui_sub(r, 1, tmp1, MPFR_RNDN); mpfr_root(r, r, 3, MPFR_RNDN); mpfr_mul_ui(r, r, 2, MPFR_RNDN); mpfr_add_ui(r, r, 1, MPFR_RNDN); mpfr_ui_div(r, 3, r, MPFR_RNDN); // s = (r - 1) / 2 mpfr_sub_ui(s2, r, 1, MPFR_RNDN); mpfr_div_ui(s2, s2, 2, MPFR_RNDN); // a = r^2 * a - 3^i(r^2-1) mpfr_pow_ui(tmp1, r, 2, MPFR_RNDN); mpfr_mul(a2, tmp1, a1, MPFR_RNDN); mpfr_sub_ui(tmp1, tmp1, 1, MPFR_RNDN); mpfr_ui_pow_ui(tmp2, 3UL, i, MPFR_RNDN); mpfr_mul(tmp1, tmp1, tmp2, MPFR_RNDN); mpfr_sub(a2, a2, tmp1, MPFR_RNDN); // s1 = s2 mpfr_set(s1, s2, MPFR_RNDN); // a1 = a2 mpfr_set(a1, a2, MPFR_RNDN); i++; } // pi = 1/a mpfr_ui_div(a2, 1, a2, MPFR_RNDN); end_time = time(NULL); mpfr_clears(tmp1, tmp2, tmp3, s1, s2, r, a1, NULL); // Write the digits to a string for accuracy comparison char *pi = malloc(precision + 100); if(pi == NULL) { fprintf(stderr, "Failed to allocated memory for output string.\n"); return 1; } mpfr_sprintf(pi, "%.*R*f", precision, MPFR_RNDN, a2); // Check out accurate we are unsigned long accuracy = check_digits(pi); // Print the results (only print the digits that are accurate) if(!hide_pi) { // Plus two for the "3." at the beginning for(unsigned long i=0; i<(unsigned long)(precision/3.35)+2; i++) { printf("%c", pi[i]); } printf("\n"); } // Send the time and accuracy to stderr so pi can be redirected to a file if necessary fprintf(stderr, "Time: %d seconds\nAccuracy: %lu digits\n", (int)(end_time - start_time), accuracy); mpfr_clear(a2); free(pi); pi = NULL; return 0; }
static void check_pow_ui (void) { mpfr_t a, b; int res; mpfr_init2 (a, 53); mpfr_init2 (b, 53); /* check in-place operations */ mpfr_set_str (b, "0.6926773", 10, GMP_RNDN); mpfr_pow_ui (a, b, 10, GMP_RNDN); mpfr_pow_ui (b, b, 10, GMP_RNDN); if (mpfr_cmp (a, b)) { printf ("Error for mpfr_pow_ui (b, b, ...)\n"); exit (1); } /* check large exponents */ mpfr_set_ui (b, 1, GMP_RNDN); mpfr_pow_ui (a, b, 4294967295UL, GMP_RNDN); mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, 4049053855UL, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) >= 0)) { printf ("Error for (-Inf)^4049053855\n"); exit (1); } mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, (unsigned long) 30002752, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) <= 0)) { printf ("Error for (-Inf)^30002752\n"); exit (1); } /* Check underflow */ mpfr_set_str_binary (a, "1E-1"); res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDN); if (MPFR_GET_EXP (a) != mpfr_get_emin () + 1) { printf ("Error for (1e-1)^MPFR_EMAX_MAX\n"); mpfr_dump (a); exit (1); } mpfr_set_str_binary (a, "1E-10"); res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDZ); if (!MPFR_IS_ZERO (a)) { printf ("Error for (1e-10)^MPFR_EMAX_MAX\n"); mpfr_dump (a); exit (1); } /* Check overflow */ mpfr_set_str_binary (a, "1E10"); res = mpfr_pow_ui (a, a, ULONG_MAX, GMP_RNDN); if (!MPFR_IS_INF (a) || MPFR_SIGN (a) < 0) { printf ("Error for (1e10)^ULONG_MAX\n"); exit (1); } /* Check 0 */ MPFR_SET_ZERO (a); MPFR_SET_POS (a); mpfr_set_si (b, -1, GMP_RNDN); res = mpfr_pow_ui (b, a, 1, GMP_RNDN); if (res != 0 || MPFR_IS_NEG (b)) { printf ("Error for (0+)^1\n"); exit (1); } MPFR_SET_ZERO (a); MPFR_SET_NEG (a); mpfr_set_ui (b, 1, GMP_RNDN); res = mpfr_pow_ui (b, a, 5, GMP_RNDN); if (res != 0 || MPFR_IS_POS (b)) { printf ("Error for (0-)^5\n"); exit (1); } MPFR_SET_ZERO (a); MPFR_SET_NEG (a); mpfr_set_si (b, -1, GMP_RNDN); res = mpfr_pow_ui (b, a, 6, GMP_RNDN); if (res != 0 || MPFR_IS_NEG (b)) { printf ("Error for (0-)^6\n"); exit (1); } mpfr_set_prec (a, 122); mpfr_set_prec (b, 122); mpfr_set_str_binary (a, "0.10000010010000111101001110100101101010011110011100001111000001001101000110011001001001001011001011010110110110101000111011E1"); mpfr_set_str_binary (b, "0.11111111100101001001000001000001100011100000001110111111100011111000111011100111111111110100011000111011000100100011001011E51290375"); mpfr_pow_ui (a, a, 2026876995UL, GMP_RNDU); if (mpfr_cmp (a, b) != 0) { printf ("Error for x^2026876995\n"); exit (1); } mpfr_set_prec (a, 29); mpfr_set_prec (b, 29); mpfr_set_str_binary (a, "1.0000000000000000000000001111"); mpfr_set_str_binary (b, "1.1001101111001100111001010111e165"); mpfr_pow_ui (a, a, 2055225053, GMP_RNDZ); if (mpfr_cmp (a, b) != 0) { printf ("Error for x^2055225053\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } /* worst case found by Vincent Lefevre, 25 Nov 2006 */ mpfr_set_prec (a, 53); mpfr_set_prec (b, 53); mpfr_set_str_binary (a, "1.0000010110000100001000101101101001011101101011010111"); mpfr_set_str_binary (b, "1.0000110111101111011010110100001100010000001010110100E1"); mpfr_pow_ui (a, a, 35, GMP_RNDN); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (1)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } /* worst cases found on 2006-11-26 */ mpfr_set_str_binary (a, "1.0110100111010001101001010111001110010100111111000011"); mpfr_set_str_binary (b, "1.1111010011101110001111010110000101110000110110101100E17"); mpfr_pow_ui (a, a, 36, GMP_RNDD); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (2)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } mpfr_set_str_binary (a, "1.1001010100001110000110111111100011011101110011000100"); mpfr_set_str_binary (b, "1.1100011101101101100010110001000001110001111110010001E23"); mpfr_pow_ui (a, a, 36, GMP_RNDU); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (3)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } mpfr_clear (a); mpfr_clear (b); }
static void check_inexact (mp_prec_t p) { mpfr_t x, y, z, t; unsigned long u; mp_prec_t q; int inexact, cmp; int rnd; mpfr_init2 (x, p); mpfr_init (y); mpfr_init (z); mpfr_init (t); mpfr_random (x); u = randlimb () % 2; for (q = 2; q <= p; q++) for (rnd = 0; rnd < GMP_RND_MAX; rnd++) { mpfr_set_prec (y, q); mpfr_set_prec (z, q + 10); mpfr_set_prec (t, q); inexact = mpfr_pow_ui (y, x, u, (mp_rnd_t) rnd); cmp = mpfr_pow_ui (z, x, u, (mp_rnd_t) rnd); if (mpfr_can_round (z, q + 10, (mp_rnd_t) rnd, (mp_rnd_t) rnd, q)) { cmp = mpfr_set (t, z, (mp_rnd_t) rnd) || cmp; if (mpfr_cmp (y, t)) { printf ("results differ for u=%lu rnd=%s\n", u, mpfr_print_rnd_mode ((mp_rnd_t) rnd)); printf ("x="); mpfr_print_binary (x); puts (""); printf ("y="); mpfr_print_binary (y); puts (""); printf ("t="); mpfr_print_binary (t); puts (""); printf ("z="); mpfr_print_binary (z); puts (""); exit (1); } if (((inexact == 0) && (cmp != 0)) || ((inexact != 0) && (cmp == 0))) { printf ("Wrong inexact flag for p=%u, q=%u, rnd=%s\n", (unsigned int) p, (unsigned int) q, mpfr_print_rnd_mode ((mp_rnd_t) rnd)); printf ("expected %d, got %d\n", cmp, inexact); printf ("u=%lu x=", u); mpfr_print_binary (x); puts (""); printf ("y="); mpfr_print_binary (y); puts (""); exit (1); } } } /* check exact power */ mpfr_set_prec (x, p); mpfr_set_prec (y, p); mpfr_set_prec (z, p); mpfr_set_ui (x, 4, GMP_RNDN); mpfr_set_str (y, "0.5", 10, GMP_RNDN); test_pow (z, x, y, GMP_RNDZ); mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (t); }