static void test1 (void) { mpfr_t x, y, z, a; int res1, res2; mpfr_init2 (x, 32); mpfr_init2 (y, 65); mpfr_init2 (z, 17); mpfr_init2 (a, 17); mpfr_set_str_binary (x, "-0.101110001001011011011e-9"); mpfr_ui_pow (y, 7, x, MPFR_RNDN); mpfr_set_prec (x, 40); mpfr_set_str_binary (x, "-0.1100101100101111011001010010110011110110E-1"); mpfr_set_prec (y, 74); mpfr_ui_pow (y, 8, x, MPFR_RNDN); mpfr_set_prec (x, 74); mpfr_set_str_binary (x, "0.11100000010100111101000011111011011010011000011000101011010011010101000011E-1"); if (mpfr_cmp (x, y)) { printf ("Error for input of 40 bits, output of 74 bits\n"); exit (1); } /* Check for ui_pow_ui */ mpfr_ui_pow_ui (x, 0, 1, MPFR_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS (x)); mpfr_ui_pow_ui (x, 0, 4, MPFR_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS (x)); res1 = mpfr_ui_pow_ui (z, 17, 42, MPFR_RNDD); mpfr_set_ui (x, 17, MPFR_RNDN); mpfr_set_ui (y, 42, MPFR_RNDN); res2 = mpfr_pow (a, x, y, MPFR_RNDD); if (mpfr_cmp (z, a) || res1 != res2) { printf ("Error for ui_pow_ui for 17^42\n" "Inexact1 = %d Inexact2 = %d\n", res1, res2); mpfr_dump (z); mpfr_dump (a); exit (1); } mpfr_set_prec (x, 2); mpfr_ui_pow_ui (x, 65537, 65535, MPFR_RNDN); if (mpfr_cmp_str (x, "0.11E1048562", 2, MPFR_RNDN) != 0) { printf ("Error for ui_pow_ui for 65537 ^65535 with 2 bits of precision\n"); mpfr_dump (x); exit (1); } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (a); }
int mpfr_log10 (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode) { int inexact; MPFR_SAVE_EXPO_DECL (expo); /* If a is NaN, the result is NaN */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a))) { if (MPFR_IS_NAN (a)) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* check for infinity before zero */ else if (MPFR_IS_INF (a)) { if (MPFR_IS_NEG (a)) /* log10(-Inf) = NaN */ { MPFR_SET_NAN (r); MPFR_RET_NAN; } else /* log10(+Inf) = +Inf */ { MPFR_SET_INF (r); MPFR_SET_POS (r); MPFR_RET (0); /* exact */ } } else /* a = 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (a)); MPFR_SET_INF (r); MPFR_SET_NEG (r); MPFR_RET (0); /* log10(0) is an exact -infinity */ } } /* If a is negative, the result is NaN */ if (MPFR_UNLIKELY (MPFR_IS_NEG (a))) { MPFR_SET_NAN (r); MPFR_RET_NAN; } /* If a is 1, the result is 0 */ if (mpfr_cmp_ui (a, 1) == 0) { MPFR_SET_ZERO (r); MPFR_SET_POS (r); MPFR_RET (0); /* result is exact */ } MPFR_SAVE_EXPO_MARK (expo); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, tt; MPFR_ZIV_DECL (loop); /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(r); /* Precision of output variable */ mpfr_prec_t Nt; /* Precision of the intermediary variable */ mpfr_exp_t err; /* Precision of error */ /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 4 + MPFR_INT_CEIL_LOG2 (Ny); /* initialise of intermediary variables */ mpfr_init2 (t, Nt); mpfr_init2 (tt, Nt); /* First computation of log10 */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute log10 */ mpfr_set_ui (t, 10, MPFR_RNDN); /* 10 */ mpfr_log (t, t, MPFR_RNDD); /* log(10) */ mpfr_log (tt, a, MPFR_RNDN); /* log(a) */ mpfr_div (t, tt, t, MPFR_RNDN); /* log(a)/log(10) */ /* estimation of the error */ err = Nt - 4; if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* log10(10^n) is exact: FIXME: Can we have 10^n exactly representable as a mpfr_t but n can't fit an unsigned long? */ if (MPFR_IS_POS (t) && mpfr_integer_p (t) && mpfr_fits_ulong_p (t, MPFR_RNDN) && !mpfr_ui_pow_ui (tt, 10, mpfr_get_ui (t, MPFR_RNDN), MPFR_RNDN) && mpfr_cmp (a, tt) == 0) break; /* actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); mpfr_set_prec (tt, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (r, t, rnd_mode); mpfr_clear (t); mpfr_clear (tt); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (r, inexact, rnd_mode); }
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; }
/* 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); }
int mpfr_set_str (mpfr_ptr x, __gmp_const char *str, int base, mp_rnd_t rnd_mode) { mpz_t mantissa; int negative, inex; long k = 0; unsigned char c; long e; mp_prec_t q; mpfr_t y, z; if (base < 2 || base > 36) return 1; if (strcasecmp(str, "NaN") == 0) { MPFR_SET_NAN(x); /* MPFR_RET_NAN not used as the return value isn't a ternary value */ __mpfr_flags |= MPFR_FLAGS_NAN; return 0; } negative = *str == '-'; if (negative || *str == '+') str++; if (strcasecmp(str, "Inf") == 0) { MPFR_CLEAR_NAN(x); MPFR_SET_INF(x); if (negative) MPFR_SET_NEG(x); else MPFR_SET_POS(x); return 0; } mpz_init(mantissa); mpz_set_ui(mantissa, 0); while (*str == '0') str++; /* skip initial zeros */ /* allowed characters are '0' to '0'+base-1 if base <= 10, and '0' to '9' plus 'a' to 'a'+base-11 if 10 < base <= 36 */ while (c = *str, (isdigit(c) && c < '0' + base) || (islower(c) && c < 'a'-10 + base)) { str++; mpz_mul_ui(mantissa, mantissa, base); mpz_add_ui(mantissa, mantissa, isdigit(c) ? c - '0' : c - ('a'-10)); } /* k is the number of non-zero digits before the decimal point */ if (*str == '.') { str++; while (c = *str, (isdigit(c) && c < '0' + base) || (islower(c) && c < 'a'-10 + base)) { if (k == LONG_MAX) { mpz_clear(mantissa); return -1; } k++; str++; mpz_mul_ui(mantissa, mantissa, base); mpz_add_ui(mantissa, mantissa, isdigit(c) ? c - '0' : c - ('a'-10)); } } if (*str == '\0') /* no exponent */ { e = -k; } else if ((base <= 10 && (*str == 'e' || *str == 'E')) || *str == '@') { char *endptr; if (*++str == '\0') /* exponent character but no exponent */ { mpz_clear(mantissa); return 1; } errno = 0; e = strtol(str, &endptr, 10); /* signed exponent after 'e', 'E' or '@' */ if (*endptr != '\0') { mpz_clear(mantissa); return 1; } if (errno) { mpz_clear(mantissa); return -1; } if (e < 0 && (unsigned long) e - k < (unsigned long) LONG_MIN) { mpz_clear(mantissa); return -1; } e -= k; } else /* unexpected character */ { mpz_clear(mantissa); return 1; } /* the number is mantissa*base^expn */ q = MPFR_PREC(x) & ~(mp_prec_t) (BITS_PER_MP_LIMB - 1); mpfr_init(y); mpfr_init(z); do { q += BITS_PER_MP_LIMB; mpfr_set_prec(y, q); mpfr_set_z(y, mantissa, GMP_RNDN); /* error <= 1/2*ulp(y) */ mpfr_set_prec(z, q); if (e > 0) { inex = mpfr_ui_pow_ui(z, base, e, GMP_RNDN); mpfr_mul(y, y, z, GMP_RNDN); } else if (e < 0) { inex = mpfr_ui_pow_ui(z, base, -e, GMP_RNDN); mpfr_div(y, y, z, GMP_RNDN); } else inex = 1; if (negative) mpfr_neg(y, y, GMP_RNDN); } while (mpfr_can_round(y, q-inex, GMP_RNDN, rnd_mode, MPFR_PREC(x))==0 && q<=2*MPFR_PREC(x)); mpfr_set(x, y, rnd_mode); mpz_clear(mantissa); mpfr_clear(y); mpfr_clear(z); return 0; }
SeedValue seed_mpfr_pow (SeedContext ctx, SeedObject function, SeedObject this_object, gsize argument_count, const SeedValue args[], SeedException * exception) { mpfr_rnd_t rnd; mpfr_ptr rop, op1, op2; gint ret; glong iop; gulong uiop1, uiop2; seed_mpfr_t argt1, argt2; /* only want 1 double argument. alternatively, could accept 2, add those, and set from the result*/ CHECK_ARG_COUNT("mpfr.pow", 3); rop = seed_object_get_private(this_object); rnd = seed_value_to_mpfr_rnd_t(ctx, args[2], exception); argt1 = seed_mpfr_arg_type(ctx, args[0], exception); argt2 = seed_mpfr_arg_type(ctx, args[1], exception); if ( (argt1 & argt2) == SEED_MPFR_MPFR ) { /* both mpfr_t */ op1 = seed_object_get_private(args[0]); op2 = seed_object_get_private(args[1]); ret = mpfr_pow(rop, op1, op2, rnd); } else if ( (argt1 | argt2) == (SEED_MPFR_MPFR | SEED_MPFR_DOUBLE) ) { /* a double and an mpfr_t. Figure out the order */ /* FIXME: is this switching ui and si bad? si_pow doesn't exist, and it's all from double anyway */ if ( argt1 == SEED_MPFR_MPFR ) { op1 = seed_object_get_private(args[0]); iop = seed_value_to_long(ctx, args[1], exception); ret = mpfr_pow_si(rop, op1, iop, rnd); } else { uiop1 = seed_value_to_ulong(ctx, args[0], exception); op2 = seed_object_get_private(args[1]); ret = mpfr_ui_pow(rop, uiop1, op2, rnd); } } else if ( (argt1 & argt2) == SEED_MPFR_DOUBLE ) { /* pretend both ui */ uiop1 = seed_value_to_ulong(ctx, args[0], exception); uiop2 = seed_value_to_ulong(ctx, args[1], exception); ret = mpfr_ui_pow_ui(rop, uiop1, uiop2, rnd); } else { TYPE_EXCEPTION("mpfr.pow", "int or unsigned int and mpfr_t"); } return seed_value_from_int(ctx, ret, exception); }