Exemple #1
0
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;
}
Exemple #2
0
SEXP const_asMpfr(SEXP I, SEXP prec, SEXP rnd_mode)
{
    SEXP val;
    mpfr_t r;
    int i_p = asInteger(prec);
    R_mpfr_check_prec(i_p);
    mpfr_init2(r, i_p);

    switch(asInteger(I)) {
    case 1: mpfr_const_pi     (r, R_rnd2MP(rnd_mode)); break;
    case 2: mpfr_const_euler  (r, R_rnd2MP(rnd_mode)); break;
    case 3: mpfr_const_catalan(r, R_rnd2MP(rnd_mode)); break;
    case 4: mpfr_const_log2   (r, R_rnd2MP(rnd_mode)); break;
    default:
	error("invalid integer code {const_asMpfr()}"); /* -Wall */
    }

    FINISH_1_RETURN(r, val);
}
Exemple #3
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_ */
Exemple #4
0
/* 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;
}