int main(int argc, char *argv[])
{
int prec, n ; mpfr_t x, y, z, z2;
iRRAM_initialize(argc,argv);
if (argc != 2 && argc != 3) {
fprintf(stderr, "Usage: timing digits \n"); exit(1);
}
n = atoi(argv[1]);
prec = (int) ( n * log(10.0) / log(2.0) + 1.0 );
printf("prec=%u\n", prec);
mpfr_init2(x, prec); mpfr_init2(y, prec); mpfr_init2(z, prec);
mpfr_init2(z2, prec);
mpfr_set_d(x, 3.0, GMP_RNDN); mpfr_sqrt(x, x, GMP_RNDN);
mpfr_set_d(y, 5.0, GMP_RNDN); mpfr_sqrt(y, y, GMP_RNDN);
mpfr_log(z, x, GMP_RNDN);
mpfr_out_str(stdout,10,0,x,GMP_RNDD);
printf("value 1 : ");
mpfr_ext_test(z, x, prec,GMP_RNDD);
printf("\nvalue 2 : ");mpfr_out_str(stdout,10,0,z,GMP_RNDD);
printf("\n");
mpfr_clear(x); mpfr_clear(y); mpfr_clear(z);
return 0;
}
int
mpfr_sqrt_ui (mpfr_ptr r, unsigned long u, mpfr_rnd_t rnd_mode)
{
if (u)
{
mpfr_t uu;
mp_limb_t up[1];
unsigned long cnt;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_TMP_INIT1 (up, uu, GMP_NUMB_BITS);
MPFR_ASSERTN (u == (mp_limb_t) u);
count_leading_zeros (cnt, (mp_limb_t) u);
*up = (mp_limb_t) u << cnt;
MPFR_SAVE_EXPO_MARK (expo);
MPFR_SET_EXP (uu, GMP_NUMB_BITS - cnt);
inex = mpfr_sqrt(r, uu, rnd_mode);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range(r, inex, rnd_mode);
}
else /* sqrt(0) = 0 */
{
MPFR_SET_ZERO(r);
MPFR_SET_POS(r);
MPFR_RET(0);
}
}
void F_mpz_mat_RQ_factor(F_mpz_mat_t B, __mpfr_struct ** R, __mpfr_struct ** Q, long r, long c, mp_prec_t prec){
//Doing modified GSO will convert Q from B to Q row by row
mpfr_t tmp;
mpfr_init2(tmp, prec);
long i, k, j;
for (i = 0; i < r; i++)
_F_mpz_vec_to_mpfr_vec(Q[i], B->rows[i], c);
//iteration k should start with Q = q1, ..., q_(k-1), a_k', ... a_r' then convert a_k to q_k by a subtraction and the other a_j' should be modded by a_k
for (k = 0; k < r; k++){
_mpfr_vec_norm2(R[k]+k, Q[k], c, prec);
mpfr_sqrt(R[k]+k, R[k]+k, GMP_RNDN);
for (i = 0; i < c; i++)
mpfr_div(Q[k]+i, Q[k]+i, R[k]+k, GMP_RNDN);
for (j = k+1; j < r; j++){
_mpfr_vec_clean_scalar_product2(R[j]+k, Q[k], Q[j], c, prec);
for (i = 0; i < c; i++){
mpfr_mul(tmp, R[j]+k, Q[k]+i, GMP_RNDN);
mpfr_sub(Q[j]+i, Q[j]+i, tmp, GMP_RNDN);
}
}
}
mpfr_clear(tmp);
return;
}
SeedValue seed_mpfr_sqrt (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_rnd_t rnd;
mpfr_ptr rop, op;
gint ret;
CHECK_ARG_COUNT("mpfr.sqrt", 2);
rop = seed_object_get_private(this_object);
rnd = seed_value_to_mpfr_rnd_t(ctx, args[1], exception);
if ( seed_value_is_object_of_class(ctx, args[0], mpfr_class) )
{
op = seed_object_get_private(args[0]);
}
else
{
TYPE_EXCEPTION("mpfr.sqrt", "mpfr_t");
}
ret = mpfr_sqrt(rop, op, rnd);
return seed_value_from_int(ctx, ret, exception);
}
mpfr_t* compute_rho_to_z_matrix(unsigned long Lambda_arg, long prec){
/* To avoid writing lambda + 1 so many times...*/
unsigned long Lambda=Lambda_arg+1;
mpfr_t* temps=malloc(sizeof(mpfr_t)*(Lambda));
mpfr_init2(temps[0],prec);
mpfr_set_ui(temps[0],8,MPFR_RNDN);
mpfr_sqrt(temps[0],temps[0],MPFR_RNDN);
mpfr_neg(temps[0],temps[0],MPFR_RNDN);
for(unsigned long j=1;j<Lambda;j++){
mpfr_init2(temps[j],prec);
mpfr_mul_si(temps[j],temps[j-1],2*j-3,MPFR_RNDN);
mpfr_div_ui(temps[j],temps[j],j,MPFR_RNDN);
}
mpfr_sub_ui(temps[1],temps[1],2,MPFR_RNDN);
mpfr_add_ui(temps[0],temps[0],3,MPFR_RNDN);
mpfr_t temp;
mpfr_init2(temp,prec);
mpfr_t temp2;
mpfr_init2(temp2,prec);
mpfr_t* result=malloc(sizeof(mpfr_t)*(Lambda)*(Lambda));
mpfr_init2(result[0],prec);
mpfr_set_ui(result[0],1,MPFR_RNDN);
for(unsigned long j=1; j<(Lambda*Lambda); j++){
mpfr_init2(result[j],prec);
mpfr_set_zero(result[j],1);
}
for(unsigned long j=1;j<Lambda;j++){
mpfr_set_ui(temp,1,MPFR_RNDN);
for(unsigned long k=0;k<=j;k++){
mpfr_mul(temp2,temps[j-k],temp,MPFR_RNDN);
mpfr_add(result[j+Lambda],result[j+Lambda],temp2,MPFR_RNDN);
mpfr_mul_si(temp,temp,-2,MPFR_RNDN);
}
}
for(unsigned long i=2;i<Lambda;i++){
for(unsigned long j=1;j<Lambda;j++){
for(unsigned long k=i-1;k<Lambda-j;k++){
mpfr_mul(temp,result[Lambda*(i-1)+k],result[j+Lambda],MPFR_RNDN);
mpfr_add(result[Lambda*i+k+j],result[Lambda*i+k+j],temp,MPFR_RNDN);
}
}
}
/* transposition */
for(unsigned long i=0;i<Lambda;i++){
for(unsigned long j=0;j<i;j++){
mpfr_swap(result[i+Lambda*j],result[j+Lambda*i]);
}
}
for(unsigned long j=0;j<Lambda;j++){
mpfr_clear(temps[j]);
}
free(temps);
mpfr_clear(temp);
mpfr_clear(temp2);
return result;
}
decimal r_sqrt(const decimal& a,bool round)
{
#ifdef USE_CGAL
CGAL::Gmpfr m;
CGAL::Gmpfr n=to_gmpfr(a);
mpfr_sqrt(m.fr(),n.fr(),MPFR_RNDN);
return r_round_preference(decimal(m),round);
#else
return r_round_preference(sqrt(a),round);
#endif
}
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;
}
/* basic constructor for cb_context */
cb_context context_construct(long n_Max, mpfr_prec_t prec, int lambda){
cb_context result;
result.n_Max = n_Max;
result.prec = prec;
result.rnd = MPFR_RNDN;
result.rho_to_z_matrix = compute_rho_to_z_matrix(lambda,prec);
result.lambda = lambda;
mpfr_init2(result.rho, prec);
mpfr_set_ui(result.rho,8, MPFR_RNDN);
mpfr_sqrt(result.rho,result.rho,MPFR_RNDN);
mpfr_ui_sub(result.rho,3,result.rho,MPFR_RNDN);
return result;
}
//-----------------------------------------------------------
// base <- exp((1/2) sqrt(ln(n) ln(ln(n))))
//-----------------------------------------------------------
void get_smoothness_base(mpz_t base, mpz_t n) {
mpfr_t fN, lnN, lnlnN;
mpfr_init(fN), mpfr_init(lnN), mpfr_init(lnlnN);
mpfr_set_z(fN, n, MPFR_RNDU);
mpfr_log(lnN, fN, MPFR_RNDU);
mpfr_log(lnlnN, lnN, MPFR_RNDU);
mpfr_mul(fN, lnN, lnlnN, MPFR_RNDU);
mpfr_sqrt(fN, fN, MPFR_RNDU);
mpfr_div_ui(fN, fN, 2, MPFR_RNDU);
mpfr_exp(fN, fN, MPFR_RNDU);
mpfr_get_z(base, fN, MPFR_RNDU);
mpfr_clears(fN, lnN, lnlnN, NULL);
}
static void
check_large (void)
{
mpfr_t x, z;
mpfr_prec_t prec;
/* bug found by Patrick Pe'lissier on 7 Jun 2004 */
prec = 203780;
mpfr_init2 (x, prec);
mpfr_init2 (z, prec);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_sqrt (x, x, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_exp_3 (z, x, MPFR_RNDN);
mpfr_clear (x);
mpfr_clear (z);
}
static void
compare_exp2_exp3 (int n)
{
mpfr_t x, y, z; int prec; mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
for (prec = 20; prec <= n; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
mpfr_random (x);
rnd = (mp_rnd_t) RND_RAND();
mpfr_exp_2 (y, x, rnd);
mpfr_exp_3 (z, x, rnd);
if (mpfr_cmp (y,z))
{
printf ("mpfr_exp_2 and mpfr_exp_3 disagree for rnd=%s and\nx=",
mpfr_print_rnd_mode (rnd));
mpfr_print_binary (x);
puts ("");
printf ("mpfr_exp_2 gives ");
mpfr_print_binary (y);
puts ("");
printf ("mpfr_exp_3 gives ");
mpfr_print_binary (z);
puts ("");
exit (1);
}
}
/* bug found by Patrick Pe'lissier on 7 Jun 2004 */
prec = 203780;
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_d (x, 3.0, GMP_RNDN);
mpfr_sqrt (x, x, GMP_RNDN);
mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_exp_3 (z, x, GMP_RNDN);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
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);
}
static int
test_sqrt (mpfr_ptr a, mpfr_srcptr b, mpfr_rnd_t rnd_mode)
{
int res;
int ok = rnd_mode == MPFR_RNDN && mpfr_number_p (b);
if (ok)
{
mpfr_print_raw (b);
}
res = mpfr_sqrt (a, b, rnd_mode);
if (ok)
{
printf (" ");
mpfr_print_raw (a);
printf ("\n");
}
return res;
}
//------------------------------------------------------------------------------
// Name:
//------------------------------------------------------------------------------
knumber_base *knumber_float::sqrt() {
if(sign() < 0) {
delete this;
return new knumber_error(knumber_error::ERROR_UNDEFINED);
}
#ifdef KNUMBER_USE_MPFR
mpfr_t mpfr;
mpfr_init_set_f(mpfr, mpf_, rounding_mode);
mpfr_sqrt(mpfr, mpfr, rounding_mode);
mpfr_get_f(mpf_, mpfr, rounding_mode);
mpfr_clear(mpfr);
#else
mpf_sqrt(mpf_, mpf_);
#endif
return this;
}
static void
test_small (void)
{
mpfr_t x, y, z1, z2;
int inex1, inex2;
unsigned int flags;
/* Test hypot(x,x) with x = 2^(emin-1). Result is x * sqrt(2). */
mpfr_inits2 (8, x, y, z1, z2, (mpfr_ptr) 0);
mpfr_set_si_2exp (x, 1, mpfr_get_emin () - 1, MPFR_RNDN);
mpfr_set_si_2exp (y, 1, mpfr_get_emin () - 1, MPFR_RNDN);
mpfr_set_ui (z1, 2, MPFR_RNDN);
inex1 = mpfr_sqrt (z1, z1, MPFR_RNDN);
inex2 = mpfr_mul (z1, z1, x, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
mpfr_clear_flags ();
inex2 = mpfr_hypot (z2, x, y, MPFR_RNDN);
flags = __gmpfr_flags;
if (mpfr_cmp (z1, z2) != 0)
{
printf ("Error in test_small%s\nExpected ",
ext ? ", extended exponent range" : "");
mpfr_out_str (stdout, 2, 0, z1, MPFR_RNDN);
printf ("\nGot ");
mpfr_out_str (stdout, 2, 0, z2, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (! SAME_SIGN (inex1, inex2))
{
printf ("Bad ternary value in test_small%s\nExpected %d, got %d\n",
ext ? ", extended exponent range" : "", inex1, inex2);
exit (1);
}
if (flags != MPFR_FLAGS_INEXACT)
{
printf ("Bad flags in test_small%s\nExpected %u, got %u\n",
ext ? ", extended exponent range" : "",
(unsigned int) MPFR_FLAGS_INEXACT, flags);
exit (1);
}
mpfr_clears (x, y, z1, z2, (mpfr_ptr) 0);
}
static PyObject *
_GMPy_MPFR_Sqrt(PyObject *x, CTXT_Object *context)
{
MPFR_Object *result;
CHECK_CONTEXT(context);
if (mpfr_sgn(MPFR(x)) < 0 && context->ctx.allow_complex) {
return GMPy_Complex_Sqrt(x, context);
}
if (!(result = GMPy_MPFR_New(0, context))) {
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_sqrt(result->f, MPFR(x), GET_MPFR_ROUND(context));
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
void MathUtils::GetSmoothnessBase(mpz_class& ret_base, mpz_class& N)
{
mpfr_t f_N, log_N, log_log_N;
mpz_t base_mpz;
mpz_init(base_mpz);
mpfr_init(f_N); mpfr_init(log_N); mpfr_init(log_log_N);
mpfr_set_z(f_N, N.get_mpz_t(), MPFR_RNDU); //f_N = N
mpfr_log(log_N, f_N, MPFR_RNDU); //log_N = log(N)
mpfr_log(log_log_N, log_N, MPFR_RNDU); //log_log_N = log(log(N))
mpfr_mul(f_N, log_N, log_log_N, MPFR_RNDU); //f_N = log(N) * log(log(N))
mpfr_sqrt(f_N, f_N, MPFR_RNDU); //f_N = sqrt(f_N)
mpfr_div_ui(f_N, f_N, 2, MPFR_RNDU); //f_N = f_N/2
mpfr_exp(f_N, f_N, MPFR_RNDU); //f_N = e^f_N
mpfr_get_z(base_mpz, f_N, MPFR_RNDU);
ret_base = mpz_class(base_mpz);
mpfr_clears(f_N, log_N, log_log_N, NULL);
}
/* 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;
}
/* check sqrt(x^2) = x */
static void
test_property2 (mpfr_prec_t p, mpfr_rnd_t r)
{
mpfr_t x, y;
mpfr_init2 (x, p);
mpfr_init2 (y, p);
mpfr_urandomb (x, RANDS);
mpfr_mul (y, x, x, r);
mpfr_sqrt (y, y, r);
if (mpfr_cmp (y, x))
{
printf ("Error, sqrt(x^2) = x does not hold for r=%s\n",
mpfr_print_rnd_mode (r));
printf ("x="); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/* check that -1 <= x/sqrt(x^2+s*y^2) <= 1 for rounding to nearest or up
with s = 0 and s = 1 */
static void
test_property1 (mpfr_prec_t p, mpfr_rnd_t r, int s)
{
mpfr_t x, y, z, t;
mpfr_init2 (x, p);
mpfr_init2 (y, p);
mpfr_init2 (z, p);
mpfr_init2 (t, p);
mpfr_urandomb (x, RANDS);
mpfr_mul (z, x, x, r);
if (s)
{
mpfr_urandomb (y, RANDS);
mpfr_mul (t, y, y, r);
mpfr_add (z, z, t, r);
}
mpfr_sqrt (z, z, r);
mpfr_div (z, x, z, r);
/* Note: if both x and y are 0, z is NAN, but the test below will
be false. So, everything is fine. */
if (mpfr_cmp_si (z, -1) < 0 || mpfr_cmp_ui (z, 1) > 0)
{
printf ("Error, -1 <= x/sqrt(x^2+y^2) <= 1 does not hold for r=%s\n",
mpfr_print_rnd_mode (r));
printf ("x="); mpfr_dump (x);
printf ("y="); mpfr_dump (y);
printf ("got "); mpfr_dump (z);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
int
mpfr_grandom (mpfr_ptr rop1, mpfr_ptr rop2, gmp_randstate_t rstate,
mpfr_rnd_t rnd)
{
int inex1, inex2, s1, s2;
mpz_t x, y, xp, yp, t, a, b, s;
mpfr_t sfr, l, r1, r2;
mpfr_prec_t tprec, tprec0;
inex2 = inex1 = 0;
if (rop2 == NULL) /* only one output requested. */
{
tprec0 = MPFR_PREC (rop1);
}
else
{
tprec0 = MAX (MPFR_PREC (rop1), MPFR_PREC (rop2));
}
tprec0 += 11;
/* We use "Marsaglia polar method" here (cf.
George Marsaglia, Normal (Gaussian) random variables for supercomputers
The Journal of Supercomputing, Volume 5, Number 1, 49–55
DOI: 10.1007/BF00155857).
First we draw uniform x and y in [0,1] using mpz_urandomb (in
fixed precision), and scale them to [-1, 1].
*/
mpz_init (xp);
mpz_init (yp);
mpz_init (x);
mpz_init (y);
mpz_init (t);
mpz_init (s);
mpz_init (a);
mpz_init (b);
mpfr_init2 (sfr, MPFR_PREC_MIN);
mpfr_init2 (l, MPFR_PREC_MIN);
mpfr_init2 (r1, MPFR_PREC_MIN);
if (rop2 != NULL)
mpfr_init2 (r2, MPFR_PREC_MIN);
mpz_set_ui (xp, 0);
mpz_set_ui (yp, 0);
for (;;)
{
tprec = tprec0;
do
{
mpz_urandomb (xp, rstate, tprec);
mpz_urandomb (yp, rstate, tprec);
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
while (mpz_sizeinbase (s, 2) > tprec * 2); /* x^2 + y^2 <= 2^{2tprec} */
for (;;)
{
/* FIXME: compute s as s += 2x + 2y + 2 */
mpz_add_ui (a, xp, 1);
mpz_add_ui (b, yp, 1);
mpz_mul (a, a, a);
mpz_mul (b, b, b);
mpz_add (s, a, b);
if ((mpz_sizeinbase (s, 2) <= 2 * tprec) ||
((mpz_sizeinbase (s, 2) == 2 * tprec + 1) &&
(mpz_scan1 (s, 0) == 2 * tprec)))
goto yeepee;
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
if (mpz_sizeinbase (s, 2) > tprec * 2)
break;
}
}
yeepee:
/* FIXME: compute s with s -= 2x + 2y + 2 */
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
/* Compute the signs of the output */
mpz_urandomb (x, rstate, 2);
s1 = mpz_tstbit (x, 0);
s2 = mpz_tstbit (x, 1);
for (;;)
{
/* s = xp^2 + yp^2 (loop invariant) */
mpfr_set_prec (sfr, 2 * tprec);
mpfr_set_prec (l, tprec);
mpfr_set_z (sfr, s, MPFR_RNDN); /* exact */
mpfr_mul_2si (sfr, sfr, -2 * tprec, MPFR_RNDN); /* exact */
mpfr_log (l, sfr, MPFR_RNDN);
mpfr_neg (l, l, MPFR_RNDN);
mpfr_mul_2si (l, l, 1, MPFR_RNDN);
mpfr_div (l, l, sfr, MPFR_RNDN);
mpfr_sqrt (l, l, MPFR_RNDN);
mpfr_set_prec (r1, tprec);
mpfr_mul_z (r1, l, xp, MPFR_RNDN);
mpfr_div_2ui (r1, r1, tprec, MPFR_RNDN); /* exact */
if (s1)
mpfr_neg (r1, r1, MPFR_RNDN);
if (MPFR_CAN_ROUND (r1, tprec - 2, MPFR_PREC (rop1), rnd))
{
if (rop2 != NULL)
{
mpfr_set_prec (r2, tprec);
mpfr_mul_z (r2, l, yp, MPFR_RNDN);
mpfr_div_2ui (r2, r2, tprec, MPFR_RNDN); /* exact */
if (s2)
mpfr_neg (r2, r2, MPFR_RNDN);
if (MPFR_CAN_ROUND (r2, tprec - 2, MPFR_PREC (rop2), rnd))
break;
}
else
break;
}
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
inex1 = mpfr_set (rop1, r1, rnd);
if (rop2 != NULL)
{
inex2 = mpfr_set (rop2, r2, rnd);
inex2 = mpfr_check_range (rop2, inex2, rnd);
}
inex1 = mpfr_check_range (rop1, inex1, rnd);
if (rop2 != NULL)
mpfr_clear (r2);
mpfr_clear (r1);
mpfr_clear (l);
mpfr_clear (sfr);
mpz_clear (b);
mpz_clear (a);
mpz_clear (s);
mpz_clear (t);
mpz_clear (y);
mpz_clear (x);
mpz_clear (yp);
mpz_clear (xp);
return INEX (inex1, inex2);
}
/* agm(x,y) is between x and y, so we don't need to save exponent range */
int
mpfr_agm (mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, mp_rnd_t rnd_mode)
{
int compare, inexact;
mp_size_t s;
mp_prec_t p, q;
mp_limb_t *up, *vp, *tmpp;
mpfr_t u, v, tmp;
unsigned long n; /* number of iterations */
unsigned long err = 0;
MPFR_ZIV_DECL (loop);
MPFR_TMP_DECL(marker);
MPFR_LOG_FUNC (("op2[%#R]=%R op1[%#R]=%R rnd=%d", op2,op2,op1,op1,rnd_mode),
("r[%#R]=%R inexact=%d", r, r, inexact));
/* Deal with special values */
if (MPFR_ARE_SINGULAR (op1, op2))
{
/* If a or b is NaN, the result is NaN */
if (MPFR_IS_NAN(op1) || MPFR_IS_NAN(op2))
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
/* now one of a or b is Inf or 0 */
/* If a and b is +Inf, the result is +Inf.
Otherwise if a or b is -Inf or 0, the result is NaN */
else if (MPFR_IS_INF(op1) || MPFR_IS_INF(op2))
{
if (MPFR_IS_STRICTPOS(op1) && MPFR_IS_STRICTPOS(op2))
{
MPFR_SET_INF(r);
MPFR_SET_SAME_SIGN(r, op1);
MPFR_RET(0); /* exact */
}
else
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
}
else /* a and b are neither NaN nor Inf, and one is zero */
{ /* If a or b is 0, the result is +0 since a sqrt is positive */
MPFR_ASSERTD (MPFR_IS_ZERO (op1) || MPFR_IS_ZERO (op2));
MPFR_SET_POS (r);
MPFR_SET_ZERO (r);
MPFR_RET (0); /* exact */
}
}
MPFR_CLEAR_FLAGS (r);
/* If a or b is negative (excluding -Infinity), the result is NaN */
if (MPFR_UNLIKELY(MPFR_IS_NEG(op1) || MPFR_IS_NEG(op2)))
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
/* Precision of the following calculus */
q = MPFR_PREC(r);
p = q + MPFR_INT_CEIL_LOG2(q) + 15;
MPFR_ASSERTD (p >= 7); /* see algorithms.tex */
s = (p - 1) / BITS_PER_MP_LIMB + 1;
/* b (op2) and a (op1) are the 2 operands but we want b >= a */
compare = mpfr_cmp (op1, op2);
if (MPFR_UNLIKELY( compare == 0 ))
{
mpfr_set (r, op1, rnd_mode);
MPFR_RET (0); /* exact */
}
else if (compare > 0)
{
mpfr_srcptr t = op1;
op1 = op2;
op2 = t;
}
/* Now b(=op2) >= a (=op1) */
MPFR_TMP_MARK(marker);
/* Main loop */
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mp_prec_t eq;
/* Init temporary vars */
MPFR_TMP_INIT (up, u, p, s);
MPFR_TMP_INIT (vp, v, p, s);
MPFR_TMP_INIT (tmpp, tmp, p, s);
/* Calculus of un and vn */
mpfr_mul (u, op1, op2, GMP_RNDN); /* Faster since PREC(op) < PREC(u) */
mpfr_sqrt (u, u, GMP_RNDN);
mpfr_add (v, op1, op2, GMP_RNDN); /* add with !=prec is still good*/
mpfr_div_2ui (v, v, 1, GMP_RNDN);
n = 1;
while (mpfr_cmp2 (u, v, &eq) != 0 && eq <= p - 2)
{
mpfr_add (tmp, u, v, GMP_RNDN);
mpfr_div_2ui (tmp, tmp, 1, GMP_RNDN);
/* See proof in algorithms.tex */
if (4*eq > p)
{
mpfr_t w;
/* tmp = U(k) */
mpfr_init2 (w, (p + 1) / 2);
mpfr_sub (w, v, u, GMP_RNDN); /* e = V(k-1)-U(k-1) */
mpfr_sqr (w, w, GMP_RNDN); /* e = e^2 */
mpfr_div_2ui (w, w, 4, GMP_RNDN); /* e*= (1/2)^2*1/4 */
mpfr_div (w, w, tmp, GMP_RNDN); /* 1/4*e^2/U(k) */
mpfr_sub (v, tmp, w, GMP_RNDN);
err = MPFR_GET_EXP (tmp) - MPFR_GET_EXP (v); /* 0 or 1 */
mpfr_clear (w);
break;
}
mpfr_mul (u, u, v, GMP_RNDN);
mpfr_sqrt (u, u, GMP_RNDN);
mpfr_swap (v, tmp);
n ++;
}
/* the error on v is bounded by (18n+51) ulps, or twice if there
was an exponent loss in the final subtraction */
err += MPFR_INT_CEIL_LOG2(18 * n + 51); /* 18n+51 should not overflow
since n is about log(p) */
/* we should have n+2 <= 2^(p/4) [see algorithms.tex] */
if (MPFR_LIKELY (MPFR_INT_CEIL_LOG2(n + 2) <= p / 4 &&
MPFR_CAN_ROUND (v, p - err, q, rnd_mode)))
break; /* Stop the loop */
/* Next iteration */
MPFR_ZIV_NEXT (loop, p);
s = (p - 1) / BITS_PER_MP_LIMB + 1;
}
MPFR_ZIV_FREE (loop);
/* Setting of the result */
inexact = mpfr_set (r, v, rnd_mode);
/* Let's clean */
MPFR_TMP_FREE(marker);
return inexact; /* agm(u,v) can be exact for u, v rational only for u=v.
Proof (due to Nicolas Brisebarre): it suffices to consider
u=1 and v<1. Then 1/AGM(1,v) = 2F1(1/2,1/2,1;1-v^2),
and a theorem due to G.V. Chudnovsky states that for x a
non-zero algebraic number with |x|<1, then
2F1(1/2,1/2,1;x) and 2F1(-1/2,1/2,1;x) are algebraically
independent over Q. */
}
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp;
int compared, inexact;
mpfr_prec_t prec;
mpfr_exp_t xp_exp;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (
("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("asin[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (asin), mpfr_log_prec, asin,
inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (asin);
MPFR_RET_NAN;
}
else /* x = 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (asin);
MPFR_SET_SAME_SIGN (asin, x);
MPFR_RET (0); /* exact result */
}
}
/* asin(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (asin, x, -2 * MPFR_GET_EXP (x), 2, 1,
rnd_mode, {});
/* Set x_p=|x| (x is a normal number) */
mpfr_init2 (xp, MPFR_PREC (x));
inexact = mpfr_abs (xp, x, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
compared = mpfr_cmp_ui (xp, 1);
MPFR_SAVE_EXPO_MARK (expo);
if (MPFR_UNLIKELY (compared >= 0))
{
mpfr_clear (xp);
if (compared > 0) /* asin(x) = NaN for |x| > 1 */
{
MPFR_SAVE_EXPO_FREE (expo);
MPFR_SET_NAN (asin);
MPFR_RET_NAN;
}
else /* x = 1 or x = -1 */
{
if (MPFR_IS_POS (x)) /* asin(+1) = Pi/2 */
inexact = mpfr_const_pi (asin, rnd_mode);
else /* asin(-1) = -Pi/2 */
{
inexact = -mpfr_const_pi (asin, MPFR_INVERT_RND(rnd_mode));
MPFR_CHANGE_SIGN (asin);
}
mpfr_div_2ui (asin, asin, 1, rnd_mode);
}
}
else
{
/* Compute exponent of 1 - ABS(x) */
mpfr_ui_sub (xp, 1, xp, MPFR_RNDD);
MPFR_ASSERTD (MPFR_GET_EXP (xp) <= 0);
MPFR_ASSERTD (MPFR_GET_EXP (x) <= 0);
xp_exp = 2 - MPFR_GET_EXP (xp);
/* Set up initial prec */
prec = MPFR_PREC (asin) + 10 + xp_exp;
/* use asin(x) = atan(x/sqrt(1-x^2)) */
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (xp, prec);
mpfr_sqr (xp, x, MPFR_RNDN);
mpfr_ui_sub (xp, 1, xp, MPFR_RNDN);
mpfr_sqrt (xp, xp, MPFR_RNDN);
mpfr_div (xp, x, xp, MPFR_RNDN);
mpfr_atan (xp, xp, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (xp, prec - xp_exp,
MPFR_PREC (asin), rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (asin, xp, rnd_mode);
mpfr_clear (xp);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (asin, inexact, rnd_mode);
}
int dgsl_mp_call_coset(fmpz *rop, const dgsl_mp_t *self, gmp_randstate_t state) {
assert(rop); assert(self);
const long n = fmpz_mat_ncols(self->B);
_fmpz_vec_zero(rop, n);
mpfr_t *c = _mpfr_vec_init(n, mpfr_get_prec(self->sigma));
_mpfr_vec_set(c, self->c, n, MPFR_RNDN);
mpfr_t c_prime;
mpfr_init2(c_prime, mpfr_get_prec(self->sigma));
mpfr_t tmp;
mpfr_init2(tmp, mpfr_get_prec(self->sigma));
mpfr_t sigma_prime;
mpfr_init2(sigma_prime, mpfr_get_prec(self->sigma));
mpz_t z;
mpz_init(z);
mpfr_t z_mpfr;
mpfr_init2(z_mpfr, mpfr_get_prec(self->sigma));
fmpz_t z_fmpz;
fmpz_init(z_fmpz);
size_t tau = 3;
if (ceil(sqrt(log2((double)n))) > tau)
tau = ceil(sqrt(log2((double)n)));
mpfr_t *b = _mpfr_vec_init(n, mpfr_get_prec(self->sigma));
const long m = fmpz_mat_nrows(self->B);
for(long j=0; j<m; j++) {
long i = m-j-1;
_mpfr_vec_dot_product(c_prime, c, self->G->rows[i], n, MPFR_RNDN);
_mpfr_vec_dot_product(tmp, self->G->rows[i], self->G->rows[i], n, MPFR_RNDN);
mpfr_div(c_prime, c_prime, tmp, MPFR_RNDN);
mpfr_sqrt(tmp, tmp, MPFR_RNDN);
mpfr_div(sigma_prime, self->sigma, tmp, MPFR_RNDN);
assert(mpfr_cmp_d(sigma_prime, 0.0) > 0);
dgs_disc_gauss_mp_t *D = dgs_disc_gauss_mp_init(sigma_prime, c_prime, tau, DGS_DISC_GAUSS_UNIFORM_ONLINE);
D->call(z, D, state);
dgs_disc_gauss_mp_clear(D);
mpfr_set_z(z_mpfr, z, MPFR_RNDN);
mpfr_neg(z_mpfr, z_mpfr, MPFR_RNDN);
_mpfr_vec_set_fmpz_vec(b, self->B->rows[i], n, MPFR_RNDN);
_mpfr_vec_scalar_addmul_mpfr(c, b, n, z_mpfr, MPFR_RNDN);
fmpz_set_mpz(z_fmpz, z);
_fmpz_vec_scalar_addmul_fmpz(rop, self->B->rows[i], n, z_fmpz);
}
fmpz_clear(z_fmpz);
mpfr_clear(z_mpfr);
mpfr_clear(sigma_prime);
mpfr_clear(tmp);
mpfr_clear(c_prime);
_mpfr_vec_clear(c, n);
_mpfr_vec_clear(b, n);
return 0;
}
/* Don't need to save/restore exponent range: the cache does it */
int
mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t a, A, B, D, S;
mpfr_prec_t px, p, cancel, k, kmax;
MPFR_ZIV_DECL (loop);
int inex;
MPFR_LOG_FUNC
(("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex));
px = MPFR_PREC (x);
/* we need 9*2^kmax - 4 >= px+2*kmax+8 */
for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++);
p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */
mpfr_init2 (a, p);
mpfr_init2 (A, p);
mpfr_init2 (B, p);
mpfr_init2 (D, p);
mpfr_init2 (S, p);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_set_ui (a, 1, MPFR_RNDN); /* a = 1 */
mpfr_set_ui (A, 1, MPFR_RNDN); /* A = a^2 = 1 */
mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */
mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */
#define b B
#define ap a
#define Ap A
#define Bp B
for (k = 0; ; k++)
{
/* invariant: 1/2 <= B <= A <= a < 1 */
mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */
mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */
mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */
mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */
mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */
mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */
mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */
mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */
mpfr_sub (S, Ap, Bp, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0);
cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p;
/* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */
mpfr_mul_2ui (S, S, k, MPFR_RNDN);
mpfr_sub (D, D, S, MPFR_RNDN);
/* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */
if (cancel + k >= p)
break;
}
#undef b
#undef ap
#undef Ap
#undef Bp
mpfr_div (A, B, D, MPFR_RNDN);
/* MPFR_ASSERTN(p >= 2 * k + 8); */
if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode)))
break;
p += kmax;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (a, p);
mpfr_set_prec (A, p);
mpfr_set_prec (B, p);
mpfr_set_prec (D, p);
mpfr_set_prec (S, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (x, A, rnd_mode);
mpfr_clear (a);
mpfr_clear (A);
mpfr_clear (B);
mpfr_clear (D);
mpfr_clear (S);
return inex;
}
int
main (int argc, char *argv[])
{
int n, prec, st, st2, N, i;
mpfr_t x, y, z;
if (argc != 2 && argc != 3)
{
fprintf(stderr, "Usage: timing digits \n");
exit(1);
}
printf ("Using MPFR-%s with GMP-%s\n", mpfr_version, gmp_version);
n = atoi(argv[1]);
prec = (int) ( n * log(10.0) / log(2.0) + 1.0 );
printf("[precision is %u bits]\n", prec);
mpfr_init2(x, prec); mpfr_init2(y, prec); mpfr_init2(z, prec);
mpfr_set_d(x, 3.0, GMP_RNDN); mpfr_sqrt(x, x, GMP_RNDN); mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_set_d(y, 5.0, GMP_RNDN); mpfr_sqrt(y, y, GMP_RNDN);
mpfr_log (z, x, GMP_RNDN);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*x took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_div(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x/y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sqrt(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sqrt(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_exp(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("exp(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_log(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("log(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sin(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sin(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_cos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("cos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_acos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arccos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_atan(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arctan(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
mpfr_clear(x); mpfr_clear(y); mpfr_clear(z);
return 0;
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mp_exp_t emin, emax;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
/* Check special case: An overflow in const_pi could occurs! */
set_emin (-125);
set_emax (128);
mpfr_set_prec (y, 24*2);
mpfr_set_prec (x, 24);
mpfr_set_str_binary (x, "0.111110101010101011110101E0");
test_log (y, x, GMP_RNDN);
set_emin (emin);
set_emax (emax);
mpfr_set_prec (y, 53);
mpfr_set_prec (x, 53);
mpfr_set_ui (x, 3, GMP_RNDD);
test_log (y, x, GMP_RNDD);
if (mpfr_cmp_str1 (y, "1.09861228866810956"))
{
printf ("Error in mpfr_log(3) for GMP_RNDD\n");
exit (1);
}
/* check large precision */
mpfr_set_prec (x, 3322);
mpfr_set_prec (y, 3322);
mpfr_set_ui (x, 3, GMP_RNDN);
mpfr_sqrt (x, x, GMP_RNDN);
test_log (y, x, GMP_RNDN);
/* negative argument */
mpfr_set_si (x, -1, GMP_RNDN);
test_log (y, x, GMP_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
/* infinite loop when */
set_emax (128);
mpfr_set_prec (x, 251);
mpfr_set_prec (y, 251);
mpfr_set_str_binary (x, "0.10010111000000000001101E8");
/* x = 4947981/32768, log(x) ~ 5.017282... */
test_log (y, x, GMP_RNDN);
set_emax (emax);
mpfr_set_ui (x, 0, GMP_RNDN);
inex = test_log (y, x, GMP_RNDN);
MPFR_ASSERTN (inex == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
inex = test_log (y, x, GMP_RNDN);
MPFR_ASSERTN (inex == 0);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_clear (x);
mpfr_clear (y);
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact
ie, iff x = 0 */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mp_prec_t prec, m;
int neg, reduce;
mpfr_t c, xr;
mpfr_srcptr xx;
mp_exp_t err, expx;
MPFR_ZIV_DECL (loop);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN (y);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
/* y = 0, thus exact, but z is inexact in case of underflow
or overflow */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("sin[%#R]=%R cos[%#R]=%R", y, y, z, z));
prec = MAX (MPFR_PREC (y), MPFR_PREC (z));
m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* the following is copied from sin.c */
if (expx >= 2) /* reduce the argument */
{
reduce = 1;
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN);
mpfr_remainder (xr, x, c, GMP_RNDN);
mpfr_div_2ui (c, c, 1, GMP_RNDN);
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, GMP_RNDZ);
else
mpfr_add (c, c, xr, GMP_RNDZ);
if (MPFR_IS_ZERO(xr) || MPFR_EXP(xr) < (mp_exp_t) 3 - (mp_exp_t) m
|| MPFR_EXP(c) < (mp_exp_t) 3 - (mp_exp_t) m)
goto next_step;
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
neg = MPFR_IS_NEG (xx); /* gives sign of sin(x) */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, GMP_RNDZ);
/* If no argument reduction was performed, the error is at most ulp(c),
otherwise it is at most ulp(c) + 2^(2-m). Since |c| < 1, we have
ulp(c) <= 2^(-m), thus the error is bounded by 2^(3-m) in that later
case. */
if (reduce == 0)
err = m;
else
err = MPFR_GET_EXP (c) + (mp_exp_t) (m - 3);
if (!mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (z) + (rnd_mode == GMP_RNDN)))
goto next_step;
mpfr_set (z, c, rnd_mode);
mpfr_sqr (c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
err = 2 + (- MPFR_GET_EXP (c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
MPFR_CHANGE_SIGN (c);
/* the absolute error on c is at most 2^(err-m), which we must put
in the form 2^(EXP(c)-err). If there was an argument reduction,
we need to add 2^(2-m); since err >= 2, the error is bounded by
2^(err+1-m) in that case. */
err = MPFR_GET_EXP (c) + (mp_exp_t) m - (err + reduce);
if (mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (y) + (rnd_mode == GMP_RNDN)))
break;
/* check for huge cancellation */
if (err < (mp_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1
&& MPFR_MANT (c)[MPFR_LIMB_SIZE (c)-1] == MPFR_LIMB_HIGHBIT)
m += m;
next_step:
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (c, m);
}
MPFR_ZIV_FREE (loop);
mpfr_set (y, c, rnd_mode);
mpfr_clear (c);
mpfr_clear (xr);
MPFR_RET (1); /* Always inexact */
}
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
from Abramowitz & Stegun).
Assumes |z| > p log(2)/2, where p is the target precision
(z can be negative only for jn).
Return 0 if the expansion does not converge enough (the value 0 as inexact
flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
mpfr_prec_t w;
long k;
int inex, stop, diverge = 0;
mpfr_exp_t err2, err;
MPFR_ZIV_DECL (loop);
mpfr_init (c);
w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;
MPFR_ZIV_INIT (loop, w);
for (;;)
{
mpfr_set_prec (c, w);
mpfr_init2 (s, w);
mpfr_init2 (P, w);
mpfr_init2 (Q, w);
mpfr_init2 (t, w);
mpfr_init2 (iz, w);
mpfr_init2 (err_t, 31);
mpfr_init2 (err_s, 31);
mpfr_init2 (err_u, 31);
/* Approximate sin(z) and cos(z). In the following, err <= k means that
the approximate value y and the true value x are related by
y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
mpfr_sin_cos (s, c, z, MPFR_RNDN);
if (MPFR_IS_NEG(z))
mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
/* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
mpfr_add (t, s, c, MPFR_RNDN);
mpfr_sub (c, s, c, MPFR_RNDN);
mpfr_swap (s, t);
/* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
with total absolute error bounded by 2^(1-w). */
/* precompute 1/(8|z|) */
mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */
mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);
/* compute P and Q */
mpfr_set_ui (P, 1, MPFR_RNDN);
mpfr_set_ui (Q, 0, MPFR_RNDN);
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
for (k = 1, stop = 0; stop < 4; k++)
{
/* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */
mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */
/* the relative error on t is bounded by (1+u)^(5k)-1, which is
bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
/* the absolute error on t is bounded by err_t * 2^(-w) */
mpfr_abs (err_u, t, MPFR_RNDU);
mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
if (stop >= 2)
{
/* take into account the neglected terms: t * 2^w */
mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
if (MPFR_IS_POS(t))
mpfr_add (err_s, err_s, t, MPFR_RNDU);
else
mpfr_sub (err_s, err_s, t, MPFR_RNDU);
mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
stop ++;
}
/* if k is odd, add to Q, otherwise to P */
else if (k & 1)
{
/* if k = 1 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (Q, Q, t, MPFR_RNDN);
else
mpfr_sub (Q, Q, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(Q): if EXP(err_u)
<= EXP(Q), since the current term is bounded by
err_u * 2^(-w), it is bounded by ulp(Q) */
if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
stop ++;
else
stop = 0;
}
else
{
/* if k = 0 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (P, P, t, MPFR_RNDN);
else
mpfr_sub (P, P, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(P) */
if (MPFR_EXP(err_u) <= MPFR_EXP(P))
stop ++;
else
stop = 0;
}
mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
/* the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w) */
/* stop when start to diverge */
if (stop < 2 &&
((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
(MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
{
/* if we have to stop the series because it diverges, then
increasing the precision will most probably fail, since
we will stop to the same point, and thus compute a very
similar approximation */
diverge = 1;
stop = 2; /* force stop */
}
}
/* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */
/* Now combine: the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
Q * (sin + cos) + P (sin - cos) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_sub (s, s, c, MPFR_RNDN);
#else
mpfr_add (s, s, c, MPFR_RNDN);
#endif
}
else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
Q * (sin - cos) - P (cos + sin) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_add (s, s, c, MPFR_RNDN);
#else
mpfr_sub (s, c, s, MPFR_RNDN);
#endif
}
if ((n & 2) != 0)
mpfr_neg (s, s, MPFR_RNDN);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
/* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
+ err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
<= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
since |c|, |old_s| <= 2. */
err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
/* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
/* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
err2 = (err >= err2) ? err + 1 : err2 + 1;
/* now the absolute error on s is bounded by 2^(err2 - w) */
/* multiply by sqrt(1/(Pi*z)) */
mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */
mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */
mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is
bounded by 3*u*|c| for |u| <= 0.25 */
mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDU);
mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
/* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
err2 += MPFR_EXP(c);
/* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by
1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
+ |old_c| * 2^(err2 - w) */
/* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
/* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
/* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
err = (err >= err2) ? err + 1 : err2 + 1;
/* the absolute error on c is bounded by 2^(err - w) */
mpfr_clear (s);
mpfr_clear (P);
mpfr_clear (Q);
mpfr_clear (t);
mpfr_clear (iz);
mpfr_clear (err_t);
mpfr_clear (err_s);
mpfr_clear (err_u);
err -= MPFR_EXP(c);
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
break;
if (diverge != 0)
{
mpfr_set (c, z, r); /* will force inex=0 below, which means the
asymptotic expansion failed */
break;
}
MPFR_ZIV_NEXT (loop, w);
}
MPFR_ZIV_FREE (loop);
inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
: mpfr_neg (res, c, r);
mpfr_clear (c);
return inex;
}
