static void
check_large (void)
{
mpfr_t x, y, z;
mpfr_init2 (x, 20000);
mpfr_init2 (y, 21000);
mpfr_init2 (z, 11791);
/* The algo failed to round for p=11791. */
(mpfr_const_pi) (z, GMP_RNDU);
mpfr_const_pi (x, GMP_RNDN); /* First one ! */
mpfr_const_pi (y, GMP_RNDN); /* Then the other - cache - */
mpfr_prec_round (y, 20000, GMP_RNDN);
if (mpfr_cmp (x, y)) {
printf ("const_pi: error for large prec (%d)\n", 1);
exit (1);
}
mpfr_prec_round (y, 11791, GMP_RNDU);
if (mpfr_cmp (z, y)) {
printf ("const_pi: error for large prec (%d)\n", 2);
exit (1);
}
/* a worst-case to exercise recomputation */
if (MPFR_PREC_MAX > 33440) {
mpfr_set_prec (x, 33440);
mpfr_const_pi (x, GMP_RNDZ);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
mpfr_prec_t p;
mpfr_rnd_t rnd;
tests_start_mpfr ();
p = 53;
if (argc > 1)
{
long a = atol (argv[1]);
if (MPFR_PREC_COND (a))
p = a;
}
rnd = (argc > 2) ? (mpfr_rnd_t) atoi(argv[2]) : MPFR_RNDZ;
mpfr_init2 (x, p);
mpfr_const_pi (x, rnd);
if (argc >= 2)
{
if (argc < 4 || atoi (argv[3]) != 0)
{
printf ("Pi=");
mpfr_out_str (stdout, 10, 0, x, rnd);
puts ("");
}
}
else if (mpfr_cmp_str1 (x, "3.141592653589793116") )
{
printf ("mpfr_const_pi failed for prec=53\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_const_pi (x, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "3.141592653468251") )
{
printf ("mpfr_const_pi failed for prec=32\n");
exit (1);
}
mpfr_clear (x);
bug20091030 ();
check_large ();
test_generic (MPFR_PREC_MIN, 200, 1);
RUN_PTHREAD_TEST();
tests_end_mpfr ();
return 0;
}
int
mpfi_const_pi (mpfi_ptr a)
{
mpfr_const_pi (&(a->left), MPFI_RNDD);
mpfr_const_pi (&(a->right), MPFI_RNDU);
return MPFI_FLAGS_BOTH_ENDPOINTS_INEXACT;
}
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);
}
static void
set_special (mpfr_ptr x, unsigned int select)
{
MPFR_ASSERTN (select < SPECIAL_MAX);
switch (select)
{
case 0:
MPFR_SET_NAN (x);
break;
case 1:
MPFR_SET_INF (x);
MPFR_SET_POS (x);
break;
case 2:
MPFR_SET_INF (x);
MPFR_SET_NEG (x);
break;
case 3:
MPFR_SET_ZERO (x);
MPFR_SET_POS (x);
break;
case 4:
MPFR_SET_ZERO (x);
MPFR_SET_NEG (x);
break;
case 5:
mpfr_set_str_binary (x, "1");
break;
case 6:
mpfr_set_str_binary (x, "-1");
break;
case 7:
mpfr_set_str_binary (x, "1e-1");
break;
case 8:
mpfr_set_str_binary (x, "1e+1");
break;
case 9:
mpfr_const_pi (x, MPFR_RNDN);
break;
case 10:
mpfr_const_pi (x, MPFR_RNDN);
MPFR_SET_EXP (x, MPFR_GET_EXP (x)-1);
break;
default:
mpfr_urandomb (x, RANDS);
if (randlimb () & 1)
mpfr_neg (x, x, MPFR_RNDN);
break;
}
}
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 *
start_routine (void *arg)
{
mpfr_prec_t p;
mpfr_t x;
mpfr_prec_t inc = *(int *) arg;
mp_limb_t *m;
for (p = 100; p < 20000; p += 64 + 100 * (inc % 10))
{
mpfr_init2 (x, p);
m = MPFR_MANT (x);
mpfr_const_pi (x, MPFR_RNDD);
mpfr_prec_round (x, 53, MPFR_RNDD);
if (mpfr_cmp_str1 (x, "3.141592653589793116"))
{
printf ("mpfr_const_pi failed with threading\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
/* Check that no reallocation has been performed */
MPFR_ASSERTN (m == MPFR_MANT (x));
mpfr_clear (x);
}
pthread_exit (NULL);
}
/* try asymptotic expansion when x is large and negative:
Li2(x) = -log(-x)^2/2 - Pi^2/6 - 1/x + O(1/x^2).
More precisely for x <= -2 we have for g(x) = -log(-x)^2/2 - Pi^2/6:
|Li2(x) - g(x)| <= 1/|x|.
Assumes x <= -7, which ensures |log(-x)^2/2| >= Pi^2/6, and g(x) <= -3.5.
Return 0 if asymptotic expansion failed (unable to round), otherwise
returns correct ternary value.
*/
static int
mpfr_li2_asympt_neg (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t g, h;
mp_prec_t w = MPFR_PREC (y) + 20;
int inex = 0;
MPFR_ASSERTN (mpfr_cmp_si (x, -7) <= 0);
mpfr_init2 (g, w);
mpfr_init2 (h, w);
mpfr_neg (g, x, GMP_RNDN);
mpfr_log (g, g, GMP_RNDN); /* rel. error <= |(1 + theta) - 1| */
mpfr_sqr (g, g, GMP_RNDN); /* rel. error <= |(1 + theta)^3 - 1| <= 2^(2-w) */
mpfr_div_2ui (g, g, 1, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_const_pi (h, GMP_RNDN); /* error <= 2^(1-w) */
mpfr_sqr (h, h, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_div_ui (h, h, 6, GMP_RNDN); /* rel. error <= |(1 + theta)^4 - 1|
<= 5 * 2^(-w) */
MPFR_ASSERTN (MPFR_EXP (g) >= MPFR_EXP (h));
mpfr_add (g, g, h, GMP_RNDN); /* err <= ulp(g)/2 + g*2^(2-w) + g*5*2^(-w)
<= ulp(g) * (1/2 + 4 + 5) < 10 ulp(g).
If in addition |1/x| <= 4 ulp(g), then the
total error is bounded by 16 ulp(g). */
if ((MPFR_EXP (x) >= (mp_exp_t) (w - 2) - MPFR_EXP (g)) &&
MPFR_CAN_ROUND (g, w - 4, MPFR_PREC (y), rnd_mode))
inex = mpfr_neg (y, g, rnd_mode);
mpfr_clear (g);
mpfr_clear (h);
return inex;
}
static PyObject *
GMPy_Context_Radians(PyObject *self, PyObject *other)
{
MPFR_Object *result, *tempx, *temp;
CTXT_Object *context = NULL;
if (self && CTXT_Check(self)) {
context = (CTXT_Object*)self;
}
else {
CHECK_CONTEXT(context);
}
result = GMPy_MPFR_New(0, context);
temp = GMPy_MPFR_New(context->ctx.mpfr_prec + 100, context);
tempx = GMPy_MPFR_From_Real(other, 1, context);
if (!result || !temp || !tempx) {
Py_XDECREF((PyObject*)temp);
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)result);
return NULL;
}
mpfr_const_pi(temp->f, MPFR_RNDN);
mpfr_div_ui(temp->f, temp->f, 180, MPFR_RNDN);
mpfr_mul(result->f, MPFR(self), temp->f, MPFR_RNDN);
Py_DECREF((PyObject*)temp);
Py_DECREF((PyObject*)tempx);
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
void func_rad(fp_t *r, fp_t deg) {
mpfr_t twopi;
mpfr_inits2(precision_bits, twopi, *r, (mpfr_ptr)0);
mpfr_const_pi(twopi, MPFR_RNDN);
mpfr_mul(*r, deg, twopi, MPFR_RNDN);
mpfr_div_ui(*r, *r, 360, MPFR_RNDN);
mpfr_clear(twopi);
}
void mexFunction( int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[] )
{
double *prec,*eout;
int mrows,ncols;
char *input_buf;
char *w1,*w2;
int buflen,status;
mpfr_t x,y,z;
mp_exp_t expptr;
/* Check for proper number of arguments. */
if(nrhs!=1) {
mexErrMsgTxt("1 inputs required.");
} else if(nlhs>2) {
mexErrMsgTxt("Too many output arguments");
}
/* The input must be a noncomplex scalar double.*/
mrows = mxGetM(prhs[0]);
ncols = mxGetN(prhs[0]);
if( !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!(mrows==1 && ncols==1) ) {
mexErrMsgTxt("Input must be a noncomplex scalar double.");
}
/* Set precision and initialize mpfr variables */
prec = mxGetPr(prhs[0]);
mpfr_set_default_prec(*prec);
mpfr_init(x); mpfr_init(y); mpfr_init(z);
/* Mathematical operation */
mpfr_const_pi(z,GMP_RNDN);
/* Retrieve results */
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, z, GMP_RNDN);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[0] = mxCreateString(w1);
/* plhs[1] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eout=mxGetPr(plhs[1]); */
/* *eout=expptr; */
mpfr_clear(x);
mpfr_clear(y);
mpfr_clear(z);
mpfr_free_str(input_buf);
free(w1);
free(w2);
}
void func_deg(fp_t *r, fp_t rad) {
mpfr_t twopi;
mpfr_inits2(precision_bits, twopi, *r, (mpfr_ptr)0);
mpfr_mul_ui(*r, rad, 360, MPFR_RNDN);
mpfr_const_pi(twopi, MPFR_RNDN);
mpfr_mul_ui(twopi, twopi, 2, MPFR_RNDN);
mpfr_div(*r, *r, twopi, MPFR_RNDN);
mpfr_clear(twopi);
}
MpfrFloat const_pi()
{
if(!mConst_pi)
{
mConst_pi = allocateMpfrFloatData(false);
mpfr_const_pi(mConst_pi->mFloat, GMP_RNDN);
}
return MpfrFloat(mConst_pi);
}
num_t
num_new_const_pi(int flags)
{
num_t r;
r = num_new_fp(flags, NULL);
mpfr_const_pi(F(r), round_mode);
return r;
}
decimal r_pi(bool round)
{
#ifdef USE_CGAL
CGAL::Gmpfr m;
mpfr_const_pi(m.fr(),MPFR_RNDN);
return r_round_preference(decimal(m),round);
#else
return r_round_preference(M_PI,round);
#endif
}
static int
pi_div_2ui (mpfr_ptr dest, int i, int neg, mpfr_rnd_t rnd_mode)
{
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_SAVE_EXPO_MARK (expo);
if (neg) /* -PI/2^i */
{
inexact = - mpfr_const_pi (dest, MPFR_INVERT_RND (rnd_mode));
MPFR_CHANGE_SIGN (dest);
}
else /* PI/2^i */
{
inexact = mpfr_const_pi (dest, rnd_mode);
}
mpfr_div_2ui (dest, dest, i, rnd_mode); /* exact */
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (dest, inexact, rnd_mode);
}
void bvisit(const Constant &x) {
if (x.__eq__(*pi)) {
mpfr_const_pi(result_, rnd_);
} else if (x.__eq__(*E)) {
mpfr_const_euler(result_, rnd_);
} else if (x.__eq__(*EulerGamma)) {
mpfr_const_euler(result_, rnd_);
} else {
throw std::runtime_error("Constant " + x.get_name() + " is not implemented.");
}
}
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);
}
int
main (int argc, char *argv[])
{
unsigned long N = atoi (argv[1]), M;
mp_prec_t p;
mpfr_t i, j;
char *lo;
mp_exp_t exp_lo;
int st, st0;
fprintf (stderr, "Using GMP %s and MPFR %s\n", gmp_version, mpfr_version);
st = cputime ();
mpfr_init (i);
mpfr_init (j);
M = N;
do
{
M += 10;
mpfr_set_prec (i, 32);
mpfr_set_d (i, LOG2_10, GMP_RNDU);
mpfr_mul_ui (i, i, M, GMP_RNDU);
mpfr_add_ui (i, i, 3, GMP_RNDU);
p = mpfr_get_ui (i, GMP_RNDU);
fprintf (stderr, "Setting precision to %lu\n", p);
mpfr_set_prec (j, 2);
mpfr_set_prec (i, p);
mpfr_set_ui (j, 1, GMP_RNDN);
mpfr_exp (i, j, GMP_RNDN); /* i = exp(1) */
mpfr_set_prec (j, p);
mpfr_const_pi (j, GMP_RNDN);
mpfr_div (i, i, j, GMP_RNDN);
mpfr_sqrt (i, i, GMP_RNDN);
st0 = cputime ();
lo = mpfr_get_str (NULL, &exp_lo, 10, M, i, GMP_RNDN);
st0 = cputime () - st0;
}
while (can_round (lo, N, M) == 0);
lo[N] = '\0';
printf ("%s\n", lo);
mpfr_clear (i);
mpfr_clear (j);
fprintf (stderr, "Cputime: %dms (output %dms)\n", cputime () - st, st0);
return 0;
}
void setDefaultPrecision(unsigned long bits)
{
if(bits != mDefaultPrecision)
{
mDefaultPrecision = bits;
for(size_t i = 0; i < mData.size(); ++i)
mpfr_set_prec(mData[i].mFloat, bits);
if(mConst_pi) mpfr_const_pi(mConst_pi->mFloat, GMP_RNDN);
if(mConst_e) mpfr_const_euler(mConst_e->mFloat, GMP_RNDN);
if(mConst_log2) mpfr_const_log2(mConst_log2->mFloat, GMP_RNDN);
if(mConst_epsilon) recalculateEpsilon();
}
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("const_pi....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 250; iter++)
{
arb_t r;
mpfr_t s;
slong accuracy, prec;
prec = 2 + n_randint(state, 1 << n_randint(state, 18));
arb_init(r);
mpfr_init2(s, prec + 1000);
arb_const_pi(r, prec);
mpfr_const_pi(s, MPFR_RNDN);
if (!arb_contains_mpfr(r, s))
{
flint_printf("FAIL: containment\n\n");
flint_printf("prec = %wd\n", prec);
flint_printf("r = "); arb_printd(r, prec / 3.33); flint_printf("\n\n");
abort();
}
accuracy = arb_rel_accuracy_bits(r);
if (accuracy < prec - 4)
{
flint_printf("FAIL: poor accuracy\n\n");
flint_printf("prec = %wd\n", prec);
flint_printf("r = "); arb_printd(r, prec / 3.33); flint_printf("\n\n");
abort();
}
arb_clear(r);
mpfr_clear(s);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int
main (int argc, char *argv[])
{
mpfr_t x;
#ifdef HAVE_INFS
check53 (DBL_NAN, DBL_NAN, GMP_RNDN);
check53 (DBL_POS_INF, DBL_NAN, GMP_RNDN);
check53 (DBL_NEG_INF, DBL_NAN, GMP_RNDN);
#endif
/* worst case from PhD thesis of Vincent Lefe`vre: x=8980155785351021/2^54 */
check53 (4.984987858808754279e-1, 4.781075595393330379e-1, GMP_RNDN);
check53 (4.984987858808754279e-1, 4.781075595393329824e-1, GMP_RNDD);
check53 (4.984987858808754279e-1, 4.781075595393329824e-1, GMP_RNDZ);
check53 (4.984987858808754279e-1, 4.781075595393330379e-1, GMP_RNDU);
check53 (1.00031274099908640274, 8.416399183372403892e-1, GMP_RNDN);
check53 (1.00229256850978698523, 8.427074524447979442e-1, GMP_RNDZ);
check53 (1.00288304857059840103, 8.430252033025980029e-1, GMP_RNDZ);
check53 (1.00591265847407274059, 8.446508805292128885e-1, GMP_RNDN);
check53 (1.00591265847407274059, 8.446508805292128885e-1, GMP_RNDN);
mpfr_init2 (x, 2);
mpfr_set_d (x, 0.5, GMP_RNDN);
mpfr_sin (x, x, GMP_RNDD);
if (mpfr_get_d1 (x) != 0.375)
{
fprintf (stderr, "mpfr_sin(0.5, GMP_RNDD) failed with precision=2\n");
exit (1);
}
/* bug found by Kevin Ryde */
mpfr_const_pi (x, GMP_RNDN);
mpfr_mul_ui (x, x, 3L, GMP_RNDN);
mpfr_div_ui (x, x, 2L, GMP_RNDN);
mpfr_sin (x, x, GMP_RNDN);
if (mpfr_cmp_ui (x, 0) >= 0)
{
fprintf (stderr, "Error: wrong sign for sin(3*Pi/2)\n");
exit (1);
}
mpfr_clear (x);
test_generic (2, 100, 80);
return 0;
}
/* set rop to
-pi/2 if s < 0
+pi/2 else
rounded in the direction rnd
*/
int
set_pi_over_2 (mpfr_ptr rop, int s, mpfr_rnd_t rnd)
{
int inex;
inex = mpfr_const_pi (rop, s < 0 ? INV_RND (rnd) : rnd);
mpfr_div_2ui (rop, rop, 1, GMP_RNDN);
if (s < 0)
{
inex = -inex;
mpfr_neg (rop, rop, GMP_RNDN);
}
return inex;
}
void fmpq_poly_sample_D1(fmpq_poly_t f, int n, mpfr_prec_t prec, gmp_randstate_t state) {
mpfr_t u1; mpfr_init2(u1, prec);
mpfr_t u2; mpfr_init2(u2, prec);
mpfr_t z1; mpfr_init2(z1, prec);
mpfr_t z2; mpfr_init2(z2, prec);
mpfr_t pi2; mpfr_init2(pi2, prec);
mpfr_const_pi(pi2, MPFR_RNDN);
mpfr_mul_si(pi2, pi2, 2, MPFR_RNDN);
mpf_t tmp_f;
mpq_t tmp_q;
mpf_init(tmp_f);
mpq_init(tmp_q);
assert(n%2==0);
for(long i=0; i<n; i+=2) {
mpfr_urandomb(u1, state);
mpfr_urandomb(u2, state);
mpfr_log(u1, u1, MPFR_RNDN);
mpfr_mul_si(u1, u1, -2, MPFR_RNDN);
mpfr_sqrt(u1, u1, MPFR_RNDN);
mpfr_mul(u2, pi2, u2, MPFR_RNDN);
mpfr_cos(z1, u2, MPFR_RNDN);
mpfr_mul(z1, z1, u1, MPFR_RNDN); //z1 = sqrt(-2*log(u1)) * cos(2*pi*u2)
mpfr_sin(z2, u2, MPFR_RNDN);
mpfr_mul(z2, z2, u1, MPFR_RNDN); //z1 = sqrt(-2*log(u1)) * sin(2*pi*U2)
mpfr_get_f(tmp_f, z1, MPFR_RNDN);
mpq_set_f(tmp_q, tmp_f);
fmpq_poly_set_coeff_mpq(f, i, tmp_q);
mpfr_get_f(tmp_f, z2, MPFR_RNDN);
mpq_set_f(tmp_q, tmp_f);
fmpq_poly_set_coeff_mpq(f, i+1, tmp_q);
}
mpf_clear(tmp_f);
mpq_clear(tmp_q);
mpfr_clear(pi2);
mpfr_clear(u1);
mpfr_clear(u2);
mpfr_clear(z1);
mpfr_clear(z2);
}
void real::begin(int precision, int mmax_reals)
{
max_reals = mmax_reals;
n_reals = 0;
mpfr_set_default_prec(precision);
mpfr_clear(NAN.r);
mpfr_init(NAN.r);
mpfr_set_nan(NAN.r);
mpfr_clear(INF.r);
mpfr_init(INF.r);
mpfr_set_inf(INF.r, 0);
mpfr_clear(ZERO.r);
mpfr_init(ZERO.r);
ZERO = real("0.0");
mpfr_clear(ONE.r);
mpfr_init(ONE.r);
ONE = real("1.0");
mpfr_clear(TWO.r);
mpfr_init(TWO.r);
TWO = real("2.0");
mpfr_clear(THREE.r);
mpfr_init(THREE.r);
THREE = real("3.0");
mpfr_clear(FOUR.r);
mpfr_init(FOUR.r);
FOUR = real("4.0");
mpfr_clear(FIVE.r);
mpfr_init(FIVE.r);
FIVE = real("5.0");
mpfr_clear(PI.r);
mpfr_init(PI.r);
mpfr_const_pi(PI.r, MPFR_RNDN);
mpfr_clear(EPS.r);
mpfr_init(EPS.r);
EPS = ONE;
while (ONE + EPS != ONE)
{
EPS = EPS / TWO;
}
mpfr_clear(SMALL_ENOUGH.r);
mpfr_init(SMALL_ENOUGH.r);
SMALL_ENOUGH = EPS;
}
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);
}
static void
special (void)
{
mpfr_t x, y;
int inex1, inex2;
mpfr_init2 (x, 32);
mpfr_init2 (y, 32);
mpfr_set_str_binary (x, "0.10001000001001011000100001E-6");
mpfr_acos (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "1.10001111111111110001110110001");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_acos (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "-0.01101011110111100111010011001011");
mpfr_acos (y, x, MPFR_RNDZ);
mpfr_set_str_binary (x, "10.0000000101111000011101000101");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_acos (2)\n");
mpfr_print_binary (y); printf ("\n");
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 0, MPFR_RNDN);
inex1 = mpfr_acos (x, x, MPFR_RNDN); /* Pi/2 */
inex2 = mpfr_const_pi (x, MPFR_RNDN);
if (inex1 != inex2)
{
printf ("Error in mpfr_acos (3) for prec=2\n");
exit (1);
}
mpfr_clear (y);
mpfr_clear (x);
}
void fft_init(size_t N, mpfr_prec_t prec)
{
if (prec) precision = prec;
if (N) LEN = N;
twid_fact = (Sequence) calloc(LEN, sizeof(mpc_t));
mpfr_init_set_d(ZERO, 0.0, MPFR_RNDA);
mpfr_init2(tmp, precision);
mpfr_const_pi(tmp, MPFR_RNDA);
mpfr_mul_si(tmp, tmp, -2, MPFR_RNDA);
mpfr_div_ui(tmp, tmp, N, MPFR_RNDA);
mpc_init2(min2pii, precision);
mpc_set_fr_fr(min2pii, ZERO, tmp, RND);
mpc_init2(temp, precision);
new_seq = (Sequence) calloc(N, sizeof(mpc_t));
size_t n = N / 2;
while (n--)
{
mpc_init2(twid_fact + n, precision);
mpc_mul_ui(twid_fact + n, min2pii, n, RND);
mpc_exp(twid_fact + n, twid_fact + n, RND);
}
}
/* 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;
}
/* try asymptotic expansion when x is large and positive:
Li2(x) = -log(x)^2/2 + Pi^2/3 - 1/x + O(1/x^2).
More precisely for x >= 2 we have for g(x) = -log(x)^2/2 + Pi^2/3:
-2 <= x * (Li2(x) - g(x)) <= -1
thus |Li2(x) - g(x)| <= 2/x.
Assumes x >= 38, which ensures log(x)^2/2 >= 2*Pi^2/3, and g(x) <= -3.3.
Return 0 if asymptotic expansion failed (unable to round), otherwise
returns correct ternary value.
*/
static int
mpfr_li2_asympt_pos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t g, h;
mp_prec_t w = MPFR_PREC (y) + 20;
int inex = 0;
MPFR_ASSERTN (mpfr_cmp_ui (x, 38) >= 0);
mpfr_init2 (g, w);
mpfr_init2 (h, w);
mpfr_log (g, x, GMP_RNDN); /* rel. error <= |(1 + theta) - 1| */
mpfr_sqr (g, g, GMP_RNDN); /* rel. error <= |(1 + theta)^3 - 1| <= 2^(2-w) */
mpfr_div_2ui (g, g, 1, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_const_pi (h, GMP_RNDN); /* error <= 2^(1-w) */
mpfr_sqr (h, h, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_div_ui (h, h, 3, GMP_RNDN); /* rel. error <= |(1 + theta)^4 - 1|
<= 5 * 2^(-w) */
/* since x is chosen such that log(x)^2/2 >= 2 * (Pi^2/3), we should have
g >= 2*h, thus |g-h| >= |h|, and the relative error on g is at most
multiplied by 2 in the difference, and that by h is unchanged. */
MPFR_ASSERTN (MPFR_EXP (g) > MPFR_EXP (h));
mpfr_sub (g, h, g, GMP_RNDN); /* err <= ulp(g)/2 + g*2^(3-w) + g*5*2^(-w)
<= ulp(g) * (1/2 + 8 + 5) < 14 ulp(g).
If in addition 2/x <= 2 ulp(g), i.e.,
1/x <= ulp(g), then the total error is
bounded by 16 ulp(g). */
if ((MPFR_EXP (x) >= (mp_exp_t) w - MPFR_EXP (g)) &&
MPFR_CAN_ROUND (g, w - 4, MPFR_PREC (y), rnd_mode))
inex = mpfr_set (y, g, rnd_mode);
mpfr_clear (g);
mpfr_clear (h);
return inex;
}
