static void check_cache (void) { mpfr_t x; int i; mpfr_init2 (x, 195); mpfr_free_cache (); i = mpfr_const_log2 (x, MPFR_RNDN); if (i == 0) { printf("Error for log2. Invalid ternary value (1).\n"); exit (1); } mpfr_set_prec (x, 194); i = mpfr_const_log2 (x, MPFR_RNDN); if (i == 0) { printf("Error for log2. Invalid ternary value (2).\n"); exit (1); } mpfr_free_cache (); mpfr_set_prec (x, 9); mpfr_const_log2 (x, MPFR_RNDN); mpfr_set_prec (x, 8); mpfr_const_log2 (x, MPFR_RNDN); if (mpfr_cmp_str (x, "0.10110001E0", 2, MPFR_RNDN)) { printf("Error for log2. Wrong rounding.\n"); exit (1); } mpfr_clear (x); }
static void bug20091030 (void) { mpfr_t x, x_ref; int inex, inex_ref; mpfr_prec_t p; int r; mpfr_free_cache (); mpfr_init2 (x, MPFR_PREC_MIN); for (p = MPFR_PREC_MIN; p <= 100; p++) { mpfr_set_prec (x, p); inex = mpfr_const_pi (x, MPFR_RNDU); if (inex < 0) { printf ("Error, inex < 0 for RNDU (prec=%lu)\n", (unsigned long) p); exit (1); } inex = mpfr_const_pi (x, MPFR_RNDD); if (inex > 0) { printf ("Error, inex > 0 for RNDD (prec=%lu)\n", (unsigned long) p); exit (1); } } mpfr_free_cache (); mpfr_init2 (x_ref, MPFR_PREC_MIN); for (p = MPFR_PREC_MIN; p <= 100; p++) { mpfr_set_prec (x, p + 10); mpfr_const_pi (x, MPFR_RNDN); mpfr_set_prec (x, p); mpfr_set_prec (x_ref, p); for (r = 0; r < MPFR_RND_MAX; r++) { inex = mpfr_const_pi (x, (mpfr_rnd_t) r); inex_ref = mpfr_const_pi_internal (x_ref, (mpfr_rnd_t) r); if (inex != inex_ref || mpfr_cmp (x, x_ref) != 0) { printf ("mpfr_const_pi and mpfr_const_pi_internal disagree\n"); printf ("mpfr_const_pi gives "); mpfr_dump (x); printf ("mpfr_const_pi_internal gives "); mpfr_dump (x_ref); printf ("inex=%d inex_ref=%d\n", inex, inex_ref); exit (1); } } } mpfr_clear (x); mpfr_clear (x_ref); }
int main(int argc, char *argv[]) { const double sigma2 = sqrt(1.0/(2.0*log(2.0))); unsigned long long t; cmdline_params_gauss_z_t params; params.sigma = 2 * sigma2; params.tau = 6; params.c = 0; params.ntrials = 10000000; params.algorithm = DGS_DISC_GAUSS_UNIFORM_TABLE; params.precision = MP; parse_gauss_z_cmdline(¶ms, argc, argv); if (params.algorithm == DGS_DISC_GAUSS_SIGMA2_LOGTABLE) { int k = round(params.sigma/sigma2); params.sigma = k*sigma2; } printf("%s :: σ: %.2f, c: %.2f. τ: %ld, precision: %d, algorithm: %d -- ", argv[0], params.sigma, params.c, params.tau, params.precision, params.algorithm); run(params.sigma, params.c, params.tau, params.precision, params.algorithm, params.ntrials, &t); double walltime = t/100000.0/params.ntrials*(1000.0*1000.0); // μs printf("wall time: %8.3f μs per call (rate: %8.3f per second)\n", walltime, 1000.0*1000.0/walltime); mpfr_free_cache(); return 0; }
int main(int argc, char *argv[]) { cmdline_params_t params; parse_cmdline(params, argc, argv, "GGHLite Instance Generator", NULL); print_header("GGHLite Instance Generator", params); aes_randstate_t randstate; aes_randinit_seed(randstate, params->shaseed, NULL); gghlite_sk_t self; gghlite_params_init(self->params, params->lambda, params->kappa, params->rerand, params->flags); gghlite_params_print(self->params); printf("\n---\n"); gghlite_sk_init(self, randstate); printf("\n---\n"); gghlite_sk_print_norms(self); printf("\n---\n"); gghlite_sk_print_times(self); gghlite_sk_clear(self, 1); aes_randclear(randstate); flint_cleanup(); mpfr_free_cache(); }
void ThreadCleanup(void *arg) { (void)arg; #ifdef LIBHVL_USE_MPFR mpfr_free_cache(); #endif // LIBHVL_USE_MPFR }
SEXP print_mpfr(SEXP x, SEXP digits) { SEXP D = GET_SLOT(x, Rmpfr_Data_Sym);/* an R list() of length n */ int n = length(D), i; mpfr_t r; Rboolean use_x_digits = INTEGER(digits)[0] == NA_INTEGER; /* #if MPFR_VERSION >= MPFR_VERSION_NUM(2,4,0) */ /* char buf[R_BUFSIZE], *p = buf; */ /* #endif */ mpfr_init(r); /* with default precision */ for(i=0; i < n; i++) { R_asMPFR(VECTOR_ELT(D, i), r); /* #if MPFR_VERSION >= MPFR_VERSION_NUM(2,4,0) */ /* Rprintf */ /* #else /\* requires R_Outputfile from R's Interfaces.h ___Unix-alike only__ *\/ */ mpfr_out_str (R_Outputfile, 10, use_x_digits ? 0 : asInteger(digits), r, MPFR_RNDD); /* #endif */ Rprintf("\n"); } mpfr_clear (r); mpfr_free_cache(); /* <- Manual 4.8 "Memory Handling" strongly advises ...*/ return x; }
SEXP R_mpfr_fac (SEXP n_, SEXP prec, SEXP rnd_mode) { int n = length(n_), i, *nn; SEXP n_t, val = PROTECT(allocVector(VECSXP, n)); int nprot = 1; mpfr_rnd_t rnd = R_rnd2MP(rnd_mode); mpfr_t r_i; if(TYPEOF(n_) != INTSXP) { PROTECT(n_t = coerceVector(n_, INTSXP)); nprot++;/* or bail out*/ nn = INTEGER(n_t); } else { nn = INTEGER(n_); } int i_p = asInteger(prec); R_mpfr_check_prec(i_p); mpfr_init2(r_i, i_p); for(i=0; i < n; i++) { // never happens when called from R: if(nn[i] < 0) error("R_mpfr_fac(%d): negative n.", nn[i]); mpfr_fac_ui(r_i, nn[i], rnd); SET_VECTOR_ELT(val, i, MPFR_as_R(r_i)); } mpfr_clear(r_i); mpfr_free_cache(); UNPROTECT(nprot); return val; }
int coords_calculate_precision(coords* c) { int l, p; mpfr_t tmp; mpfr_t bail; mpfr_t px_size; mpfr_t precision; mpfr_init2(tmp, c->precision); mpfr_init2(bail, c->precision); mpfr_init2(px_size, c->precision); mpfr_init2(precision, c->precision); mpfr_set_d( bail, 4.0, GMP_RNDN); mpfr_div_si(px_size, c->width, c->img_width, GMP_RNDN); mpfr_div( tmp, bail, px_size, GMP_RNDN); l = mpfr_log2( precision, tmp, GMP_RNDN); p = (int)mpfr_get_si( precision, GMP_RNDN); if (l < 0) /* precision was rounded down */ ++p; c->recommend = p; mpfr_clear(tmp); mpfr_clear(bail); mpfr_clear(px_size); mpfr_clear(precision); mpfr_free_cache(); /* <-- keep valgrind happy over mpfr_log2 */ return c->recommend; }
void *WorkerFunc(void *arg) #endif // LIBHVL_THREADING_ { const ThreadParams *tp = static_cast<const ThreadParams *>(arg); double x = tp->from; HVL_Pair *buf = tp->buffer; CheckPrecision(tp->ctx); #ifdef LIBHVL_THREADING_PTHREAD pthread_cleanup_push(ThreadCleanup, nullptr); #endif // LIBHVL_THREADING_PTHREAD for (size_t iter = 0; iter < tp->iters; iter++) { double r = tp->calcfun(tp->ctx, x, tp->a0, tp->a1, tp->a2, tp->a3); buf->x = x; buf->y = r; buf++; x += tp->step; #ifdef LIBHVL_THREADING_PTHREAD pthread_testcancel(); #endif // LIBHVL_THREADING_PTHREAD } #ifdef LIBHVL_USE_MPFR mpfr_free_cache(); #endif // LIBHVL_USE_MPFR #ifdef LIBHVL_THREADING_PTHREAD pthread_cleanup_pop(0); #endif // LIBHVL_THREADING_PTHREAD return 0; }
int main(void) { flint_rand_t state; fmpz_t p; fmpz * v; long i; printf("number_of_partitions...."); fflush(stdout); flint_randinit(state); fmpz_init(p); v = _fmpz_vec_init(3000); number_of_partitions_vec(v, 3000); for (i = 0; i < 3000; i++) { number_of_partitions(p, i); if (!fmpz_equal(p, v + i)) { printf("FAIL:\n"); printf("p(%ld) does not agree with power series\n", i); printf("Computed p(%ld): ", i); fmpz_print(p); printf("\n"); printf("Expected: "); fmpz_print(v + i); printf("\n"); abort(); } } _fmpz_vec_clear(v, 3000); for (i = 0; testdata[i][0] != 0; i++) { number_of_partitions(p, testdata[i][0]); if (fmpz_fdiv_ui(p, 1000000000) != testdata[i][1]) { printf("FAIL:\n"); printf("p(%ld) does not agree with known value mod 10^9\n", testdata[i][0]); printf("Computed: %lu\n", fmpz_fdiv_ui(p, 1000000000)); printf("Expected: %lu\n", testdata[i][1]); abort(); } } fmpz_clear(p); flint_randclear(state); mpfr_free_cache(); _fmpz_cleanup(); printf("PASS\n"); return 0; }
int main(void) { int i, result; flint_rand_t state; printf("dlog...."); fflush(stdout); flint_randinit(state); for (i = 0; i < 10000; i++) { fmpz_t x; mpz_t z; mpfr_t r; double y, w; fmpz_init(x); mpz_init(z); mpfr_init2(r, 53); fmpz_randtest_not_zero(x, state, 10000); fmpz_abs(x, x); y = fmpz_dlog(x); fmpz_get_mpz(z, x); mpfr_set_z(r, z, MPFR_RNDN); mpfr_log(r, r, MPFR_RNDN); w = mpfr_get_d(r, MPFR_RNDN); result = (FLINT_ABS(y - w) <= w * 1e-13); if (!result) { printf("FAIL:\n"); printf("x = "), fmpz_print(x), printf("\n"); printf("y = %.20g\n", y); printf("w = %.20g\n", w); abort(); } fmpz_clear(x); mpz_clear(z); mpfr_clear(r); } mpfr_free_cache(); flint_randclear(state); _fmpz_cleanup(); printf("PASS\n"); return EXIT_SUCCESS; }
static int compute_min_prec(double &rho, int d, double delta, double eta, double epsilon, MinPrecAlgo algo) { int old_prec = Float::set_prec(53); Float f_minprec, f_rho, f_d, f_eta, f_delta, f_epsilon, tmp1, tmp2; // These four conversions are exact f_d = static_cast<double>(d); f_eta = eta; f_delta = delta; f_epsilon = epsilon; if (algo == MINPREC_L2) { // eta - 0.5 is an exact fp operation if (f_epsilon > eta - 0.5) f_epsilon = eta - 0.5; tmp1 = 1.0; tmp1.sub(tmp1, f_delta, GMP_RNDD); if (f_epsilon > tmp1) f_epsilon = tmp1; // now fEpsilon <= min(epsilon, eta - 0.5, 1 - delta); } // Computes tmp1 >= (1 + eta) ^ 2 + epsilon tmp1 = 1.0; // exact tmp1.add(f_eta, tmp1, GMP_RNDU); // >= 1 + eta tmp1.mul(tmp1, tmp1, GMP_RNDU); // >= (1 + eta) ^ 2 tmp1.add(tmp1, f_epsilon, GMP_RNDU); // Computes tmp2 <= delta - eta ^ 2 tmp2.mul(f_eta, f_eta, GMP_RNDU); tmp2.sub(f_delta, tmp2, GMP_RNDD); FPLLL_CHECK(tmp2 > 0, "invalid LLL parameters, eta must be < sqrt(delta)"); // Computes rho >= ((1 + eta) ^ 2 + epsilon) / (delta - eta ^ 2) f_rho.div(tmp1, tmp2, GMP_RNDU); rho = f_rho.get_d(GMP_RNDU); /* Computes minprec >= constant + 2 * log2(d) - log2(epsilon) + d * log2(rho) (constant = 5 for GSO, 10 for LLL) */ tmp1.log(f_d, GMP_RNDU); // >= log(d) tmp1.mul_2si(tmp1, 1); // >= 2 * log(d) tmp2.log(f_epsilon, GMP_RNDD); // <= log(epsilon) (<= 0) tmp1.sub(tmp1, tmp2, GMP_RNDU); // >= 2 * log(d) - log(epsilon) tmp2.log(f_rho, GMP_RNDU); // >= log(rho) tmp2.mul(f_d, tmp2, GMP_RNDU); // >= d * log(rho) tmp1.add(tmp1, tmp2, GMP_RNDU); // >= 2*log(d)-log(epsilon)+d*log(rho) tmp2 = 2.0; // exact tmp2.log(tmp2, GMP_RNDD); // <= log(2) tmp1.div(tmp1, tmp2, GMP_RNDU); // >= 2*log2(d)-log2(epsilon)+d*log2(rho) tmp2 = (algo == MINPREC_L2) ? 10.0 : 5.0; f_minprec.add(tmp1, tmp2, GMP_RNDU); int minprec = static_cast<int>(ceil(f_minprec.get_d(GMP_RNDU))); mpfr_free_cache(); Float::set_prec(old_prec); return minprec; }
int main() { fmpz * num1; fmpz * den1; fmpz_t num2; fmpz_t den2; long n, N; printf("bernoulli_number...."); fflush(stdout); N = 4000; num1 = _fmpz_vec_init(N); den1 = _fmpz_vec_init(N); fmpz_init(num2); fmpz_init(den2); _bernoulli_number_vec_multi_mod(num1, den1, N); for (n = 0; n < N; n++) { bernoulli_number(num2, den2, n); if (!fmpz_equal(num1 + n, num2)) { printf("FAIL: n = %ld, numerator\n", n); printf("vec: "); fmpz_print(num1 + n); printf("\n"); printf("single: "); fmpz_print(num2); printf("\n"); abort(); } if (!fmpz_equal(den1 + n, den2)) { printf("FAIL: n = %ld, denominator\n", n); printf("vec: "); fmpz_print(den1 + n); printf("\n"); printf("single: "); fmpz_print(den2); printf("\n"); abort(); } } _fmpz_vec_clear(num1, N); _fmpz_vec_clear(den1, N); fmpz_clear(num2); fmpz_clear(den2); mpfr_free_cache(); _fmpz_cleanup(); printf("PASS\n"); return 0; }
int main(int argc, char* const argv[]) { int result = Catch::Session().run( argc, argv ); #if defined(HAVE_SYMENGINE_MPFR) mpfr_free_cache(); #endif // HAVE_SYMENGINE_MPFR #if defined(HAVE_SYMENGINE_ARB) flint_cleanup(); #endif // HAVE_SYMENGINE_ARB return result; }
int main(int argc, char *argv[]) { cmdline_params_t params; const char *name = "GGHLite Parameters"; parse_cmdline(params, argc, argv, name, NULL); print_header(name, params); gghlite_sk_t self; gghlite_params_init(self->params, params->lambda, params->kappa, params->rerand, params->flags); gghlite_params_print(self->params); gghlite_sk_clear(self, 1); flint_cleanup(); mpfr_free_cache(); }
int main() { unsigned long long base_counts[] = { 5, 5, 5, 5 }; unsigned long long window = 20; double val = 0.0; val = cwf(base_counts, window); printf("%f\n", val); val = ce(base_counts, window); printf("%f\n", val); mpfr_free_cache(); return 0; }
APLVFP PrimFnMonQuoteDotVisV (APLVFP aplVfpRht, LPPRIMSPEC lpPrimSpec) { APLMPI mpzRes = {0}; APLVFP mpfRes = {0}; // Check for indeterminates: !N for integer N < 0 if (mpfr_integer_p (&aplVfpRht) && mpfr_cmp_ui (&aplVfpRht, 0) < 0) return *mpfr_QuadICValue (&aplVfpRht, // No left arg ICNDX_QDOTn, &aplVfpRht, &mpfRes, FALSE); // Check for PosInfinity if (IsMpfPosInfinity (&aplVfpRht)) return mpfPosInfinity; // If the arg is an integer, // and it fits in a ULONG, ... if (mpfr_integer_p (&aplVfpRht) && mpfr_fits_uint_p (&aplVfpRht, MPFR_RNDN)) { mpz_init (&mpzRes); mpfr_init0 (&mpfRes); mpz_fac_ui (&mpzRes, mpfr_get_ui (&aplVfpRht, MPFR_RNDN)); mpfr_set_z (&mpfRes, &mpzRes, MPFR_RNDN); Myz_clear (&mpzRes); } else { // Initialize the result mpfr_init_set (&mpfRes, &aplVfpRht, MPFR_RNDN); mpfr_add_ui (&mpfRes, &mpfRes, 1, MPFR_RNDN); // Let MPFR handle it mpfr_gamma (&mpfRes, &mpfRes, MPFR_RNDN); #ifdef DEBUG mpfr_free_cache (); #endif } // End IF/ELSE return mpfRes; } // End PrimFnMonQuoteDotVisV
int main(void) { long k; flint_rand_t state; printf("zeta_ui_bsplit...."); fflush(stdout); flint_randinit(state); for (k = 0; k < 100; k++) { long prec, n; mpfr_t x, y; n = 2 + n_randint(state, 20); prec = 2 + n_randint(state, 10000); mpfr_init2(x, prec); mpfr_init2(y, prec); mpfr_zeta_ui(x, n, MPFR_RNDN); mpfr_zeta_ui_bsplit(y, n, MPFR_RNDN); if (!mpfr_equal_p(x, y)) { printf("FAIL:\n"); printf("Wrong value at n = %ld, prec = %ld\n", n, prec); printf("x:\n"); mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); printf("\n"); printf("x:\n"); mpfr_out_str(stdout, 10, 0, y, MPFR_RNDN); printf("\n"); abort(); } mpfr_clear(x); mpfr_clear(y); } flint_randclear(state); mpfr_free_cache(); _fmpz_cleanup(); printf("PASS\n"); return 0; }
/* Convert R "mpfr" object (list of "mpfr1") to R "double" vector : */ SEXP mpfr2d(SEXP x, SEXP rnd_mode) { int n = length(x), i; SEXP val = PROTECT(allocVector(REALSXP, n)); double *r = REAL(val); mpfr_t R_i; mpfr_init(R_i); /* with default precision */ for(i=0; i < n; i++) { R_asMPFR(VECTOR_ELT(x, i), R_i); r[i] = mpfr_get_d(R_i, R_rnd2MP(rnd_mode)); } mpfr_clear (R_i); mpfr_free_cache(); UNPROTECT(1); return val; }
int main(void) { struct number n; char *input, buffer[256]; rl_bind_key('\t', rl_complete); while (1) { snprintf(buffer, sizeof(buffer), "> "); input = readline(buffer); if (!input || !strcmp(input, "exit")) break; add_history(input); calculate(input, &n); // snprintf(buffer, sizeof(buffer), "%%.%ldRf\n", mpfr_get_prec(n.num)); mpfr_printf("%RNf\n", n.num); mpfr_clear(n.num); mpfr_free_cache(); free(input); } return 0; }
SEXP print_mpfr1(SEXP x, SEXP digits) { mpfr_t r; Rboolean use_x_digits = INTEGER(digits)[0] == NA_INTEGER; mpfr_init2(r, R_mpfr_prec(x)); R_asMPFR(x, r); /* Rprintf(" * [dbg] after R_asMPFR() ..\n"); */ mpfr_out_str (R_Outputfile, 10, use_x_digits ? 0 : asInteger(digits), r, MPFR_RNDD); /* prints the value of s in base 10, rounded towards -Inf, where the third argument 0 means that the number of printed digits is automatically chosen from the precision of s; */ Rprintf("\n"); mpfr_clear (r); mpfr_free_cache(); /* <- Manual 4.8 "Memory Handling" strongly advises ...*/ return x; }
void tests_end_mpfr (void) { int err = 0; if (mpfr_get_emin () != default_emin) { printf ("Default emin value has not been restored!\n"); err = 1; } if (mpfr_get_emax () != default_emax) { printf ("Default emax value has not been restored!\n"); err = 1; } mpfr_free_cache (); mpfr_free_cache2 (MPFR_FREE_GLOBAL_CACHE); tests_rand_end (); #ifndef MPFR_USE_MINI_GMP tests_memory_end (); #endif #ifdef MPFR_TESTS_DIVBYZERO /* Define to test the use of MPFR_ERRDIVZERO */ if (fetestexcept (FE_DIVBYZERO|FE_INVALID)) { printf ("A floating-point division by 0 or an invalid operation" " occurred!\n"); #ifdef MPFR_ERRDIVZERO /* This should never occur because the purpose of defining MPFR_ERRDIVZERO is to avoid all the FP divisions by 0. */ err = 1; #endif } #endif if (err) exit (err); }
/** * Debug statements will be used if the -d option is used. */ int main(int argc, char** argv) { if (argc > 1 && strcmp(argv[1], "-d") == 0) { aks_debug = 1; } mpz_t n; mpz_init(n); while (!feof(stdin)) { gmp_scanf("%Zd", &n); if(feof(stdin)) { break; } int prime = aks_is_prime(n); gmp_printf("%d\n", prime); } mpz_clear(n); mpfr_free_cache(); return 0; }
SEXP d2mpfr1_(double x, int i_prec, mpfr_rnd_t rnd) { mpfr_t r; int nr_limbs = N_LIMBS(i_prec), i; R_mpfr_check_prec(i_prec); R_mpfr_MPFR_2R_init(val); mpfr_init2 (r, (mpfr_prec_t)i_prec); mpfr_set_d (r, x, rnd); R_mpfr_MPFR_2R_fill; /* free space used by the MPFR variables */ mpfr_clear (r); mpfr_free_cache(); /* <- Manual 4.8 "Memory Handling" strongly advises ...*/ UNPROTECT(1); return val; }/* d2mpfr1_ */
int main (void) { FILE *output; struct speed_params2D param; double (*speed_funcs[3]) (struct speed_params *s); /* char filename[256] = "virtual_timing_ai.dat"; */ /* speed_funcs[0] = virtual_timing_ai1; */ /* speed_funcs[1] = virtual_timing_ai2; */ char filename[256] = "airy.dat"; speed_funcs[0] = timing_ai1; speed_funcs[1] = timing_ai2; speed_funcs[2] = NULL; output = fopen (filename, "w"); if (output == NULL) { fprintf (stderr, "Can't open file '%s' for writing.\n", filename); abort (); } param.min_x = -80; param.max_x = 60; param.min_prec = 50; param.max_prec = 1500; param.nb_points_x = 200; param.nb_points_prec = 200; param.logarithmic_scale_x = 0; param.logarithmic_scale_prec = 0; param.speed_funcs = speed_funcs; generate_2D_sample (output, param); fclose (output); mpfr_free_cache (); return 0; }
/* Convert R "mpfr" object (list of "mpfr1") to R "integer" vector : */ SEXP mpfr2i(SEXP x, SEXP rnd_mode) { int n = length(x), i; SEXP val = PROTECT(allocVector(INTSXP, n)); int *r = INTEGER(val); mpfr_t R_i; mpfr_init(R_i); /* with default precision */ for(i=0; i < n; i++) { R_asMPFR(VECTOR_ELT(x, i), R_i); if(!mpfr_fits_sint_p(R_i, R_rnd2MP(rnd_mode))) { warning("NAs introduced by coercion from \"mpfr\" [%d]", i+1); r[i] = NA_INTEGER; } else { long lr = mpfr_get_si(R_i, R_rnd2MP(rnd_mode)); r[i] = (int) lr; } } mpfr_clear (R_i); mpfr_free_cache(); UNPROTECT(1); return val; }
/* From the MPFR (2.3.2, 2008) doc : -- Function: int mpfr_set_str (mpfr_t ROP, const char *S, int BASE, mpfr_rnd_t RND) Set ROP to the value of the whole string S in base BASE, rounded in the direction RND. See the documentation of `mpfr_strtofr' for a detailed description of the valid string formats. This function returns 0 if the entire string up to the final null character is a valid number in base BASE; otherwise it returns -1, and ROP may have changed. */ SEXP str2mpfr1_list(SEXP x, SEXP prec, SEXP base, SEXP rnd_mode) { /* NB: Both x and prec are "recycled" to the longer one if needed */ int ibase = asInteger(base), *iprec, nx = LENGTH(x), np = LENGTH(prec), n = (nx == 0 || np == 0) ? 0 : imax2(nx, np), nprot = 1; SEXP val = PROTECT(allocVector(VECSXP, n)); mpfr_rnd_t rnd = R_rnd2MP(rnd_mode); mpfr_t r_i; mpfr_init(r_i); if(!isString(x)) { PROTECT(x = coerceVector(x, STRSXP)); nprot++; } if(!isInteger(prec)) { PROTECT(prec = coerceVector(prec, INTSXP)); nprot++; } iprec = INTEGER(prec); for(int i = 0; i < n; i++) { int prec_i = iprec[i % np]; R_mpfr_check_prec(prec_i); mpfr_set_prec(r_i, (mpfr_prec_t) prec_i); int ierr = mpfr_set_str(r_i, CHAR(STRING_ELT(x, i % nx)), ibase, rnd); if(ierr) { if (!strcmp("NA", CHAR(STRING_ELT(x, i % nx)))) mpfr_set_nan(r_i); // "NA" <=> "NaN" (which *are* treated well, by mpfr_set_str) else error("str2mpfr1_list(x, *): x[%d] cannot be made into MPFR", i+1); } /* FIXME: become more efficient by doing R_..._2R_init() only once*/ SET_VECTOR_ELT(val, i, MPFR_as_R(r_i)); } mpfr_clear (r_i); mpfr_free_cache(); UNPROTECT(nprot); return val; }
void sample(void * arg, ulong count) { fmpz * num; fmpz * den; bernoulli_vec_t * params = (bernoulli_vec_t *) arg; ulong n = params->n; long i; int algorithm = params->algorithm; num = _fmpz_vec_init(n); den = _fmpz_vec_init(n); prof_start(); for (i = 0; i < count; i++) { if (algorithm == 0) { _bernoulli_number_vec_recursive(num, den, n); } else if (algorithm == 1) { _bernoulli_number_vec_multi_mod(num, den, n); } else if (algorithm == 2) { _bernoulli_number_vec_zeta(num, den, n); mpfr_free_cache(); } } prof_stop(); _fmpz_vec_clear(num, n); _fmpz_vec_clear(den, n); }
int main(int argc, char *argv[]) { aes_randstate_t randstate; aes_randinit(randstate); int status = 0; status += test_jigsaw(20, 2, 1, randstate); status += test_jigsaw(20, 3, 1, randstate); status += test_jigsaw(20, 4, 1, randstate); status += test_jigsaw(20, 2, 0, randstate); status += test_jigsaw(20, 3, 0, randstate); status += test_jigsaw(20, 4, 0, randstate); status += test_jigsaw_indices(20, 4, 90, randstate); status += test_jigsaw_indices(20, 20, 60, randstate); aes_randclear(randstate); flint_cleanup(); mpfr_free_cache(); return status; }
/* Convert R "mpfr" object (list of "mpfr1") to R "character" vector, * using precision 'prec' which can be NA/NULL in which case * "full precision" (as long as necessary) is used : */ SEXP mpfr2str(SEXP x, SEXP digits, SEXP base) { int n = length(x), i; int n_dig = isNull(digits) ? 0 : asInteger(digits); int dig_n_max = -1; SEXP val = PROTECT(allocVector(VECSXP, 4)), nms, str, exp, fini, zero; int *i_exp, *is_fin, *is_0; int B = asInteger(base); // = base for output double p_fact = (B == 2) ? 1. : log(B) / M_LN2; char *ch = NULL; mpfr_t R_i; if(n_dig < 0) error("'digits' must be NULL or integer >= 0"); /* be "overprotective" for now ... */ SET_VECTOR_ELT(val, 0, str = PROTECT(allocVector(STRSXP, n))); SET_VECTOR_ELT(val, 1, exp = PROTECT(allocVector(INTSXP, n))); SET_VECTOR_ELT(val, 2, fini= PROTECT(allocVector(LGLSXP, n))); SET_VECTOR_ELT(val, 3, zero= PROTECT(allocVector(LGLSXP, n))); nms = PROTECT(allocVector(STRSXP, 4)); SET_STRING_ELT(nms, 0, mkChar("str")); SET_STRING_ELT(nms, 1, mkChar("exp")); SET_STRING_ELT(nms, 2, mkChar("finite")); SET_STRING_ELT(nms, 3, mkChar("is.0")); setAttrib(val, R_NamesSymbol, nms); i_exp = INTEGER(exp); is_fin= LOGICAL(fini); is_0 = LOGICAL(zero); mpfr_init(R_i); /* with default precision */ for(i=0; i < n; i++) { mpfr_exp_t exp = (mpfr_exp_t) 0; mpfr_exp_t *exp_ptr = &exp; int dig_needed; R_asMPFR(VECTOR_ELT(x, i), R_i); #ifdef __Rmpfr_FIRST_TRY_FAILS__ /* Observing memory problems, e.g., see ../tests/00-bug.R.~3~ * Originally hoped it was solvable via R_alloc() etc, but it seems the problem is * deeper and I currently suspect a problem/bug in MPFR library's mpfr_get_str(..) */ ch = mpfr_get_str(NULL, exp_ptr, B, (size_t) n_dig, R_i, MPFR_RNDN); #else if(n_dig) {/* use it as desired precision */ dig_needed = n_dig; } else { /* n_dig = 0 --> string will use "enough" digits */ dig_needed = p_fact * (int)R_i->_mpfr_prec; } if (i == 0) { /* first time */ dig_n_max = dig_needed; ch = (char *) R_alloc(dig_needed + 2, sizeof(char)); } else if(!n_dig && dig_needed > dig_n_max) { ch = (char *) S_realloc(ch, dig_needed + 2, dig_n_max + 2, sizeof(char)); dig_n_max = dig_needed; } /* char * mpfr_get_str (char *STR, mpfr_exp_t *EXPPTR, int B, * size_t N, mpfr_t OP, mpfr_rnd_t RND) */ mpfr_get_str(ch, exp_ptr, B, (size_t) n_dig, R_i, MPFR_RNDN); #endif SET_STRING_ELT(str, i, mkChar(ch)); i_exp[i] = (int) exp_ptr[0]; is_fin[i]= mpfr_number_p(R_i); is_0 [i] = mpfr_zero_p(R_i); #ifdef __Rmpfr_FIRST_TRY_FAILS__ mpfr_free_str(ch); #endif } mpfr_clear (R_i); mpfr_free_cache(); UNPROTECT(6); return val; }