void zeroize_tiny(gmp_RR epsilon, ElementType &a) const
{
if (mpfr_cmp_d(epsilon, fabs(a.re)) > 0)
a.re = 0.0;
if (mpfr_cmp_d(epsilon, fabs(a.im)) > 0)
a.im = 0.0;
}
void increase_norm(gmp_RR& norm, const ElementType& a) const
{
double d;
abs(d,a);
if (mpfr_cmp_d(norm, d) < 0)
mpfr_set_d(norm, d, GMP_RNDN);
}
/* log base 4 of x -> log(x) / log(4), sets result to the result */
void log4(mpfr_t result, mpfr_t x) {
/* make sure values are initialized */
mpfr_t val1;
mpfr_init(val1);
mpfr_set_d(val1, 1, RND);
mpfr_t val2;
mpfr_init(val2);
mpfr_set_d(val2, 1, RND);
mpfr_t base;
mpfr_init(base);
mpfr_set_ui(base, 4, RND);
mpfr_set_ui(result, 1, RND);
/* set val1 and val2 to the proper logs */
mpfr_log(val1, x, RND);
mpfr_log(val2, base, RND);
assert(mpfr_cmp_d(val2, 0.0) != 0); // can the log ever be 0?
mpfr_div(result, val1, val2, RND);
mpfr_clear(val1);
mpfr_clear(val2);
mpfr_clear(base);
}
SeedValue seed_mpfr_cmp (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_ptr rop, op;
gdouble dop;
gint ret;
CHECK_ARG_COUNT("mpfr.cmp", 1);
rop = seed_object_get_private(this_object);
if ( seed_value_is_object_of_class(ctx, args[0], mpfr_class) )
{
op = seed_object_get_private(args[0]);
ret = mpfr_cmp(rop, op);
}
else if ( seed_value_is_number(ctx, args[0]))
{
dop = seed_value_to_double(ctx, args[0], exception);
ret = mpfr_cmp_d(rop, dop);
}
else
{
TYPE_EXCEPTION("mpfr.cmp", "mpfr_t or double");
}
return seed_value_from_int(ctx, ret, exception);
}
void
test_gc_get_floating (void* data)
{
mpfr_t* num = GC_NEW_FLOATING(runtime);
mpfr_t* num2 = GC_NEW_FLOATING(runtime);
mpfr_set_d(*num, 2.3, MPFR_RNDN);
mpfr_set_d(*num, 4.2, MPFR_RNDN);
mpfr_add(*num, *num, *num2, MPFR_RNDN);
tt_assert(mpfr_cmp_d(*num, 4.2) == 0);
end:;
}
static int phase1() {
int i, j;
mpfr_t u;
mpfr_zinit(u);
jmax = n3;
for (i = 0; i <= m; i++) {
if (col[i] > n2) mpfr_set_d(q[0][i], -1, GMP_RNDN);
}
minimize();
tableau(u, 0, 0);
if (mpfr_cmp(u, minuseps) < 0) {
mpfr_clear(u);
return 0;
}
for (i = 1; i <= m; i++) {
if (col[i] > n2) {
col[i] = -1;
}
}
mpfr_set_d(q[0][0], 1, GMP_RNDN);
for (j = 1; j <= m; j++) mpfr_set_d(q[0][j], 0, GMP_RNDN);
for (i = 1; i <= m; i++) {
if ((j = col[i]) > 0 && j <= n && mpfr_cmp_d(c[j], 0) != 0) {
mpfr_set(u, c[j], GMP_RNDN);
for (j = 1; j <= m; j++) {
mpfr_fms(q[0][j], q[i][j], u, q[0][j], GMP_RNDN);
mpfr_neg(q[0][j], q[0][j], GMP_RNDN);
}
}
}
mpfr_clear(u);
return 1;
}
void generate_2D_sample (FILE *output, struct speed_params2D param)
{
mpfr_t temp;
double incr_prec;
mpfr_t incr_x;
mpfr_t x, x2;
double prec;
struct speed_params s;
int i;
int test;
int nb_functions;
double *t; /* store the timing of each implementation */
/* We first determine how many implementations we have */
nb_functions = 0;
while (param.speed_funcs[nb_functions] != NULL)
nb_functions++;
t = malloc (nb_functions * sizeof (double));
if (t == NULL)
{
fprintf (stderr, "Can't allocate memory.\n");
abort ();
}
mpfr_init2 (temp, MPFR_SMALL_PRECISION);
/* The precision is sampled from min_prec to max_prec with */
/* approximately nb_points_prec points. If logarithmic_scale_prec */
/* is true, the precision is multiplied by incr_prec at each */
/* step. Otherwise, incr_prec is added at each step. */
if (param.logarithmic_scale_prec)
{
mpfr_set_ui (temp, (unsigned long int)param.max_prec, MPFR_RNDU);
mpfr_div_ui (temp, temp, (unsigned long int)param.min_prec, MPFR_RNDU);
mpfr_root (temp, temp,
(unsigned long int)param.nb_points_prec, MPFR_RNDU);
incr_prec = mpfr_get_d (temp, MPFR_RNDU);
}
else
{
incr_prec = (double)param.max_prec - (double)param.min_prec;
incr_prec = incr_prec/((double)param.nb_points_prec);
}
/* The points x are sampled according to the following rule: */
/* If logarithmic_scale_x = 0: */
/* nb_points_x points are equally distributed between min_x and max_x */
/* If logarithmic_scale_x = 1: */
/* nb_points_x points are sampled from 2^(min_x) to 2^(max_x). At */
/* each step, the current point is multiplied by incr_x. */
/* If logarithmic_scale_x = -1: */
/* nb_points_x/2 points are sampled from -2^(max_x) to -2^(min_x) */
/* (at each step, the current point is divided by incr_x); and */
/* nb_points_x/2 points are sampled from 2^(min_x) to 2^(max_x) */
/* (at each step, the current point is multiplied by incr_x). */
mpfr_init2 (incr_x, param.max_prec);
if (param.logarithmic_scale_x == 0)
{
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
}
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (incr_x,
2.*(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
else
{ /* other values of param.logarithmic_scale_x are considered as 1 */
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
/* Main loop */
mpfr_init2 (x, param.max_prec);
mpfr_init2 (x2, param.max_prec);
prec = (double)param.min_prec;
while (prec <= param.max_prec)
{
printf ("prec = %d\n", (int)prec);
if (param.logarithmic_scale_x == 0)
mpfr_set_d (temp, param.min_x, MPFR_RNDU);
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (temp, param.max_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
mpfr_neg (temp, temp, MPFR_RNDU);
}
else
{
mpfr_set_d (temp, param.min_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
}
/* We perturb x a little bit, in order to avoid trailing zeros that */
/* might change the behavior of algorithms. */
mpfr_const_pi (x, MPFR_RNDN);
mpfr_div_2ui (x, x, 7, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_mul (x, x, temp, MPFR_RNDN);
test = 1;
while (test)
{
mpfr_fprintf (output, "%e\t", mpfr_get_d (x, MPFR_RNDN));
mpfr_fprintf (output, "%Pu\t", (mpfr_prec_t)prec);
s.r = (mp_limb_t)mpfr_get_exp (x);
s.size = (mpfr_prec_t)prec;
s.align_xp = (mpfr_sgn (x) > 0)?1:2;
mpfr_set_prec (x2, (mpfr_prec_t)prec);
mpfr_set (x2, x, MPFR_RNDU);
s.xp = x2->_mpfr_d;
for (i=0; i<nb_functions; i++)
{
t[i] = speed_measure (param.speed_funcs[i], &s);
mpfr_fprintf (output, "%e\t", t[i]);
}
fprintf (output, "%d\n", 1 + find_best (t, nb_functions));
if (param.logarithmic_scale_x == 0)
{
mpfr_add (x, x, incr_x, MPFR_RNDU);
if (mpfr_cmp_d (x, param.max_x) > 0)
test=0;
}
else
{
if (mpfr_sgn (x) < 0 )
{ /* if x<0, it means that logarithmic_scale_x=-1 */
mpfr_div (x, x, incr_x, MPFR_RNDU);
mpfr_abs (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.min_x) < 0)
mpfr_neg (x, x, MPFR_RNDN);
}
else
{
mpfr_mul (x, x, incr_x, MPFR_RNDU);
mpfr_set (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.max_x) > 0)
test=0;
}
}
}
prec = ( (param.logarithmic_scale_prec) ? (prec * incr_prec)
: (prec + incr_prec) );
fprintf (output, "\n");
}
free (t);
mpfr_clear (incr_x);
mpfr_clear (x);
mpfr_clear (x2);
mpfr_clear (temp);
return;
}
int
main (void)
{
mpfr_t x;
int c;
tests_start_mpfr ();
mpfr_init2(x, IEEE_DBL_MANT_DIG);
mpfr_set_d (x, 2.34763465, MPFR_RNDN);
if (mpfr_cmp_d(x, 2.34763465)!=0) {
printf("Error in mpfr_cmp_d 2.34763465 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_d(x, 2.345)<=0) {
printf("Error in mpfr_cmp_d 2.345 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
if (mpfr_cmp_d(x, 2.4)>=0) {
printf("Error in mpfr_cmp_d 2.4 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, MPFR_RNDZ);
mpfr_neg (x, x, MPFR_RNDZ);
if (mpfr_cmp_d (x, 0.0)) {
printf("Error in mpfr_cmp_d 0.0 and ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit(1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_ui_div (x, 1, x, MPFR_RNDU);
if (mpfr_cmp_d (x, 0.0) == 0)
{
printf ("Error in mpfr_cmp_d (Inf, 0)\n");
exit (1);
}
#if !defined(MPFR_ERRDIVZERO)
/* Check NAN */
mpfr_clear_erangeflag ();
c = mpfr_cmp_d (x, DBL_NAN);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (1)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_erangeflag ();
c = mpfr_cmp_d (x, 2.0);
if (c != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for NAN (2)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
#endif /* MPFR_ERRDIVZERO */
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
/* Compute the alternating series
s = S(z) = \sum_{k=0}^infty B_{2k} (z))^{2k+1} / (2k+1)!
with 0 < z <= log(2) to the precision of s rounded in the direction
rnd_mode.
Return the maximum index of the truncature which is useful
for determinating the relative error.
*/
static int
li2_series (mpfr_t sum, mpfr_srcptr z, mpfr_rnd_t rnd_mode)
{
int i, Bm, Bmax;
mpfr_t s, u, v, w;
mpfr_prec_t sump, p;
mp_exp_t se, err;
mpz_t *B;
MPFR_ZIV_DECL (loop);
/* The series converges for |z| < 2 pi, but in mpfr_li2 the argument is
reduced so that 0 < z <= log(2). Here is additionnal check that z is
(nearly) correct */
MPFR_ASSERTD (MPFR_IS_STRICTPOS (z));
MPFR_ASSERTD (mpfr_cmp_d (z, 0.6953125) <= 0);
sump = MPFR_PREC (sum); /* target precision */
p = sump + MPFR_INT_CEIL_LOG2 (sump) + 4; /* the working precision */
mpfr_init2 (s, p);
mpfr_init2 (u, p);
mpfr_init2 (v, p);
mpfr_init2 (w, p);
B = bernoulli ((mpz_t *) 0, 0);
Bm = Bmax = 1;
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mpfr_sqr (u, z, GMP_RNDU);
mpfr_set (v, z, GMP_RNDU);
mpfr_set (s, z, GMP_RNDU);
se = MPFR_GET_EXP (s);
err = 0;
for (i = 1;; i++)
{
if (i >= Bmax)
B = bernoulli (B, Bmax++); /* B_2i * (2i+1)!, exact */
mpfr_mul (v, u, v, GMP_RNDU);
mpfr_div_ui (v, v, 2 * i, GMP_RNDU);
mpfr_div_ui (v, v, 2 * i, GMP_RNDU);
mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU);
mpfr_div_ui (v, v, 2 * i + 1, GMP_RNDU);
/* here, v_2i = v_{2i-2} / (2i * (2i+1))^2 */
mpfr_mul_z (w, v, B[i], GMP_RNDN);
/* here, w_2i = v_2i * B_2i * (2i+1)! with
error(w_2i) < 2^(5 * i + 8) ulp(w_2i) (see algorithms.tex) */
mpfr_add (s, s, w, GMP_RNDN);
err = MAX (err + se, 5 * i + 8 + MPFR_GET_EXP (w))
- MPFR_GET_EXP (s);
err = 2 + MAX (-1, err);
se = MPFR_GET_EXP (s);
if (MPFR_GET_EXP (w) <= se - (mp_exp_t) p)
break;
}
/* the previous value of err is the rounding error,
the truncation error is less than EXP(z) - 6 * i - 5
(see algorithms.tex) */
err = MAX (err, MPFR_GET_EXP (z) - 6 * i - 5) + 1;
if (MPFR_CAN_ROUND (s, (mp_exp_t) p - err, sump, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (s, p);
mpfr_set_prec (u, p);
mpfr_set_prec (v, p);
mpfr_set_prec (w, p);
}
MPFR_ZIV_FREE (loop);
mpfr_set (sum, s, rnd_mode);
Bm = Bmax;
while (Bm--)
mpz_clear (B[Bm]);
(*__gmp_free_func) (B, Bmax * sizeof (mpz_t));
mpfr_clears (s, u, v, w, (mpfr_ptr) 0);
/* Let K be the returned value.
1. As we compute an alternating series, the truncation error has the same
sign as the next term w_{K+2} which is positive iff K%4 == 0.
2. Assume that error(z) <= (1+t) z', where z' is the actual value, then
error(s) <= 2 * (K+1) * t (see algorithms.tex).
*/
return 2 * i;
}
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;
}
dgsl_mp_t *dgsl_mp_init(const fmpz_mat_t B, mpfr_t sigma,
mpfr_t *c, const dgsl_alg_t algorithm) {
assert(mpfr_cmp_ui(sigma, 0) > 0);
dgsl_mp_t *self = (dgsl_mp_t*)calloc(1, sizeof(dgsl_mp_t));
if(!self) dgs_die("out of memory");
dgsl_alg_t alg = algorithm;
long m = fmpz_mat_nrows(B);
long n = fmpz_mat_ncols(B);
const mpfr_prec_t prec = mpfr_get_prec(sigma);
fmpz_mat_init_set(self->B, B);
self->c_z = _fmpz_vec_init(n);
self->c = _mpfr_vec_init(n, prec);
mpfr_init2(self->sigma, prec);
mpfr_set(self->sigma, sigma, MPFR_RNDN);
if (alg == DGSL_DETECT) {
if (fmpz_mat_is_one(self->B)) {
alg = DGSL_IDENTITY;
} else if (_mpfr_vec_is_zero(c, n))
alg = DGSL_INLATTICE;
else
alg = DGSL_COSET; //TODO: we could test for lattice membership here
}
mpfr_t c_;
mpfr_init2(c_, prec);
size_t tau = 3;
if (2*ceil(sqrt(log2((double)n))) > tau)
tau = 2*ceil(sqrt(log2((double)n)));
switch(alg) {
case DGSL_IDENTITY:
self->D = (dgs_disc_gauss_mp_t**)calloc(1, sizeof(dgs_disc_gauss_mp_t*));
mpfr_set_d(c_, 0.0, MPFR_RNDN);
self->D[0] = dgs_disc_gauss_mp_init(self->sigma, c_, tau, DGS_DISC_GAUSS_DEFAULT);
self->call = dgsl_mp_call_identity;
break;
case DGSL_INLATTICE:
self->D = (dgs_disc_gauss_mp_t**)calloc(m, sizeof(dgs_disc_gauss_mp_t*));
if (c)
_fmpz_vec_set_mpfr_vec(self->c_z, c, n);
mpfr_mat_t G;
mpfr_mat_init(G, m, n, prec);
mpfr_mat_set_fmpz_mat(G, B);
mpfr_mat_gso(G, MPFR_RNDN);
mpfr_t sigma_;
mpfr_init2(sigma_, prec);
mpfr_t norm;
mpfr_init2(norm, prec);
mpfr_set_d(c_, 0.0, MPFR_RNDN);
for(long i=0; i<m; i++) {
_mpfr_vec_2norm(norm, G->rows[i], n, MPFR_RNDN);
assert(mpfr_cmp_d(norm, 0.0) > 0);
mpfr_div(sigma_, self->sigma, norm, MPFR_RNDN);
assert(mpfr_cmp_d(sigma_, 0.0) > 0);
self->D[i] = dgs_disc_gauss_mp_init(sigma_, c_, tau, DGS_DISC_GAUSS_DEFAULT);
}
mpfr_clear(sigma_);
mpfr_clear(norm);
mpfr_mat_clear(G);
self->call = dgsl_mp_call_inlattice;
break;
case DGSL_COSET:
mpfr_mat_init(self->G, m, n, prec);
mpfr_mat_set_fmpz_mat(self->G, B);
mpfr_mat_gso(self->G, MPFR_RNDN);
self->call = dgsl_mp_call_coset;
break;
default:
dgs_die("not implemented");
}
mpfr_clear(c_);
return self;
}
void zeroize_tiny(gmp_RR epsilon, ElementType &a) const
{
if (mpfr_cmp_d(epsilon, fabs(a)) > 0)
set_zero(a);
}
int
mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd)
{
int inex;
mpfr_t tmp, ump;
mp_exp_t err, te;
mp_prec_t prec;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd),
("y[%#R]=%R inexact=%d", y, y, inex));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
/* exp(NaN) = exp(-Inf) = NaN */
if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x)))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* eint(+inf) = +inf */
else if (MPFR_IS_INF (x))
{
MPFR_SET_INF(y);
MPFR_SET_POS(y);
MPFR_RET(0);
}
else /* eint(+/-0) = -Inf */
{
MPFR_SET_INF(y);
MPFR_SET_NEG(y);
MPFR_RET(0);
}
}
/* eint(x) = NaN for x < 0 */
if (MPFR_IS_NEG(x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
MPFR_SAVE_EXPO_MARK (expo);
/* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2).
Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax,
then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */
mpfr_init2 (tmp, 64);
mpfr_init2 (ump, 64);
mpfr_log (tmp, x, GMP_RNDU);
mpfr_sub (ump, x, tmp, GMP_RNDD);
mpfr_const_log2 (tmp, GMP_RNDU);
mpfr_div (ump, ump, tmp, GMP_RNDD);
/* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0)
{
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd, 1);
}
/* Init stuff */
prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6;
/* eint() has a root 0.37250741078136663446..., so if x is near,
already take more bits */
if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */
{
double d;
d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663;
d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d);
prec += -d;
}
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
MPFR_ZIV_INIT (loop, prec); /* Initialize the ZivLoop controler */
for (;;) /* Infinite loop */
{
/* We need that the smallest value of k!/x^k is smaller than 2^(-p).
The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x
for x>=1. */
if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec +
0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0)
err = mpfr_eint_asympt (tmp, x);
else
{
err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */
te = MPFR_GET_EXP(tmp);
mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err)
<= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp))
<= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */
err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp);
err = MAX(0, err);
te = MPFR_GET_EXP(tmp);
mpfr_log (ump, x, GMP_RNDN);
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* same formula as above, except now EXP(ump) is not 0 */
err += te + 1;
if (MPFR_LIKELY (!MPFR_IS_ZERO (ump)))
err = MAX (MPFR_GET_EXP (ump), err);
err = MAX(0, err - MPFR_GET_EXP (tmp));
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd)))
break;
MPFR_ZIV_NEXT (loop, prec); /* Increase used precision */
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
}
MPFR_ZIV_FREE (loop); /* Free the ZivLoop Controler */
inex = mpfr_set (y, tmp, rnd); /* Set y to the computed value */
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd);
}
static inline void
adjust_lunar_phase_to_zero(mpfr_t *result) {
mpfr_t ll, delta;
int mode = -1;
int loop = 1;
int count = 0;
/* Adjust values so that it's as close as possible to 0 degrees.
* if we have a delta of 1 degree, then we're about
* 1 / ( 360 / MEAN_SYNODIC_MONTH )
* days apart
*/
mpfr_init(ll);
mpfr_init_set_d(delta, 0.0001, GMP_RNDN);
while (loop) {
int flipped = mode;
mpfr_t new_moment;
count++;
mpfr_init(new_moment);
lunar_phase(&ll, result);
#if (TRACE)
mpfr_fprintf(stderr,
"Adjusting ll from (%.30RNf) moment is %.5RNf delta is %.30RNf\n", ll, *result, delta);
#endif
/* longitude was greater than 180, so we're looking to add a few
* degrees to make it close to 360 ( 0 )
*/
if (mpfr_cmp_ui( ll, 180 ) > 0) {
mode = 1;
mpfr_sub_ui(delta, ll, 360, GMP_RNDN);
mpfr_div_d(delta, delta, 360 / MEAN_SYNODIC_MONTH, GMP_RNDN);
mpfr_add( new_moment, *result, delta, GMP_RNDN );
#if (TRACE)
mpfr_fprintf(stderr, "add %.30RNf -> %.30RNf\n", *result, new_moment);
#endif
mpfr_set(*result, new_moment, GMP_RNDN);
if (mpfr_cmp(new_moment, *result) == 0) {
loop = 0;
}
} else if (mpfr_cmp_ui( ll, 180 ) < 0 ) {
if ( mpfr_cmp_d( ll, 0.000000000000000000001 ) < 0) {
loop = 0;
} else {
mode = 0;
mpfr_sub_ui(delta, ll, 0, GMP_RNDN);
mpfr_div_d(delta, delta, 360 / MEAN_SYNODIC_MONTH, GMP_RNDN);
mpfr_sub( new_moment, *result, delta, GMP_RNDN );
#if (TRACE)
mpfr_fprintf(stderr, "sub %.120RNf -> %.120RNf\n", *result, new_moment);
#endif
if (mpfr_cmp(new_moment, *result) == 0) {
loop = 0;
}
mpfr_set(*result, new_moment, GMP_RNDN);
}
} else {
loop = 0;
}
if (flipped != -1 && flipped != mode) {
mpfr_div_d(delta, delta, 1.1, GMP_RNDN);
}
mpfr_clear(new_moment);
}
mpfr_clear(delta);
mpfr_clear(ll);
}
/* Function to calculate the entropy */
void eff_point(mpfr_t *ent, mpfr_t *ipdf, mpfr_t *jdist, mpfr_t *pp, mpfr_t *gamma_bcs, mpfr_t *p0, int conns, int phi, int mu, int gamma, double pin, double xi, double yi, double delta, mpfr_prec_t prec)
{
unsigned int z,sx,sy,i;
int ppdex=0,p0dex=0,thr;
double po,cost;
double *bpdf;
bpdf=(double *) malloc((conns+1)*sizeof(double));
binomialpdf(bpdf,conns,pin); //CONSIDER USING GSL version here?
mpfr_t rp;
mpfr_init2(rp,prec);
mpfr_set_d(rp,0,MPFR_RNDN);
mpfr_t nunity;
mpfr_init2(nunity,prec);
mpfr_set_d(nunity,-1,MPFR_RNDN);
mpfr_t tbin;
mpfr_init2(tbin,prec);
mpfr_t t1;
mpfr_init2(t1,prec);
mpfr_t gate;
mpfr_init2(gate,prec);
mpfr_t qa;
mpfr_init2(qa,prec);
mpfr_t s0;
mpfr_init2(s0,prec);
mpfr_t jdist_tot;
mpfr_init2(jdist_tot,prec);
for(thr=phi;thr<=conns;thr++)
po=po+*(bpdf+thr);
cost=mu*(pin*xi+(1-pin))+delta*gamma*(po*yi+(1-po));
for(sx=0;sx<=mu;sx++)
{
ppdex=sx;
p0dex=sx;
for(sy=1;sy<=gamma;sy++)
{
mpfr_set_d(qa,0,MPFR_RNDN);
for(z=0;z<=gamma-sy;z++)
{
mpfr_pow_ui(rp,nunity,(unsigned long int)z,MPFR_RNDN);
mpfr_mul(rp,rp,*(gamma_bcs+(gamma-sy)*(gamma+1)+z),MPFR_RNDN);
if(mpfr_cmp_d(*(pp+ppdex),0)>0)
{
if(mpfr_cmp(*(p0+p0dex),*(pp+ppdex))>0)
mpfr_set_d(gate,1,MPFR_RNDN);
else
{
mpfr_sub(gate,*(pp+ppdex),*(p0+p0dex),MPFR_RNDN);
mpfr_div(gate,gate,*(pp+ppdex),MPFR_RNDN);
}
mpfr_pow_ui(t1,*(pp+ppdex),(unsigned long int)z+sy,MPFR_RNDN);
mpfr_mul(rp,rp,gate,MPFR_RNDN);
}
else
mpfr_set_d(t1,0,MPFR_RNDN);
mpfr_mul(rp,rp,t1,MPFR_RNDN);
mpfr_add(qa,qa,rp,MPFR_RNDN);
}
mpfr_add(qa,qa,*(p0+p0dex),MPFR_RNDN);
mpfr_set_d(jdist_tot,0,MPFR_RNDN);
for(i=0;i<=mu;i++)
{
if(i!=sx)
mpfr_add(jdist_tot, jdist_tot,*(jdist+i*(gamma+1)+sy),MPFR_RNDN);
}
mpfr_div(jdist_tot,jdist_tot,*(gamma_bcs+gamma*(gamma+1)+sy),MPFR_RNDN);
mpfr_mul(qa,qa,*(ipdf+sx),MPFR_RNDN);
mpfr_add(qa,qa,jdist_tot,MPFR_RNDN);
if(mpfr_cmp_d(qa,0)>0)
{
mpfr_log2(qa,qa,MPFR_RNDN);
mpfr_mul(qa,qa,*(jdist+sx*(gamma+1)+sy),MPFR_RNDN);
}
else
mpfr_set_d(qa,0,MPFR_RNDN);
mpfr_sub(*ent,*ent,qa,MPFR_RNDN);
}
}
mpfr_set_d(jdist_tot,0,MPFR_RNDN);
for(i=0;i<=mu;i++)
mpfr_add(jdist_tot, jdist_tot,*(jdist+i*(gamma+1)),MPFR_RNDN);
if(mpfr_cmp_d(jdist_tot,0)>0)
{
mpfr_log2(s0,jdist_tot,MPFR_RNDN);
mpfr_mul(s0,jdist_tot,s0,MPFR_RNDN);
mpfr_sub(*ent,*ent,s0,MPFR_RNDN);
mpfr_div_d(*ent,*ent,cost,MPFR_RNDN);
}
mpfr_clear(s0);
mpfr_clear(rp);
mpfr_clear(nunity);
mpfr_clear(tbin);
mpfr_clear(t1);
free(bpdf);
}
int
main (void)
{
mpfr_t x;
mpfr_exp_t emin;
tests_start_mpfr ();
emin = mpfr_get_emin ();
mpfr_init2 (x, IEEE_DBL_MANT_DIG);
mpfr_set_d (x, 2.34763465, MPFR_RNDN);
if (mpfr_cmp_d (x, 2.34763465) != 0)
{
printf ("Error in mpfr_cmp_d 2.34763465 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
if (mpfr_cmp_d (x, 2.345) <= 0)
{
printf ("Error in mpfr_cmp_d 2.345 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
if (mpfr_cmp_d (x, 2.4) >= 0)
{
printf ("Error in mpfr_cmp_d 2.4 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDZ);
mpfr_neg (x, x, MPFR_RNDZ);
if (mpfr_cmp_d (x, 0.0))
{
printf ("Error in mpfr_cmp_d 0.0 and ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar('\n');
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_ui_div (x, 1, x, MPFR_RNDU);
if (mpfr_cmp_d (x, 0.0) == 0)
{
printf ("Error in mpfr_cmp_d (Inf, 0)\n");
exit (1);
}
/* Test in reduced exponent range. */
set_emin (1);
mpfr_set_ui (x, 1, MPFR_RNDN);
if (mpfr_cmp_d (x, 0.9) <= 0)
{
printf ("Error in reduced exponent range.\n");
exit (1);
}
set_emin (emin);
#if !defined(MPFR_ERRDIVZERO)
/* Check NAN */
{
int c;
mpfr_clear_flags ();
c = mpfr_cmp_d (x, DBL_NAN);
if (c != 0 || __gmpfr_flags != MPFR_FLAGS_ERANGE)
{
printf ("ERROR for NAN (1)\n");
printf ("Expected 0, got %d\n", c);
printf ("Expected flags:");
flags_out (MPFR_FLAGS_ERANGE);
printf ("Got flags: ");
flags_out (__gmpfr_flags);
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_flags ();
c = mpfr_cmp_d (x, 2.0);
if (c != 0 || __gmpfr_flags != MPFR_FLAGS_ERANGE)
{
printf ("ERROR for NAN (2)\n");
printf ("Expected 0, got %d\n", c);
printf ("Expected flags:");
flags_out (MPFR_FLAGS_ERANGE);
printf ("Got flags: ");
flags_out (__gmpfr_flags);
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
}
#endif /* MPFR_ERRDIVZERO */
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
int solve_fr(mpfr_t *result, int n0, int m0, mpfr_t **a0, int *ineq0, mpfr_t *c0) {
int i,j;
m = m0; // number of inequations
n = n0+1; // number of variables
init(n, m);
mpfr_t csum;
mpfr_zinit(csum);
for(j=0;j<n0+1;j++) {
mpfr_set(c[j], c0[j], GMP_RNDN);
}
for(j=1;j<n0+1;j++) {
mpfr_add(csum, csum, c0[j], GMP_RNDN);
}
mpfr_set(c[n], csum, GMP_RNDN);
mpfr_neg(c[n], c[n], GMP_RNDN);
for(i=0;i<m;i++) {
mpfr_set_d(csum, 0, GMP_RNDN);
for(j=0;j<n0+1;j++) mpfr_set(a[i+1][j], a0[i][j], GMP_RNDN);
mpfr_neg(a[i+1][0], a[i+1][0], GMP_RNDN);
for(j=1;j<n0+1;j++) {
mpfr_add(csum, csum, a0[i][j], GMP_RNDN);
}
mpfr_set(a[i+1][n], csum, GMP_RNDN);
mpfr_neg(a[i+1][n], a[i+1][n], GMP_RNDN);
inequality[i+1] = ineq0[i];
if (mpfr_cmp_d(a[i+1][0], 0) < 0) {
if (inequality[i+1] == GEQ) inequality[i+1] = LEQ;
else if (inequality[i+1] == LEQ) inequality[i+1] = GEQ;
for (j = 0; j <= n; j++) mpfr_neg(a[i+1][j], a[i+1][j], GMP_RNDN);
} else if (mpfr_cmp_d(a[i+1][0], 0) == 0 && inequality[i+1] == GEQ) {
inequality[i+1] = LEQ;
for (j = 1; j <= n; j++) mpfr_neg(a[i+1][j], a[i+1][j], GMP_RNDN);
}
}
int p1r = 1;
prepare();
if (n3 != n2) p1r = phase1();
if (!p1r) {
dispose();
return NOT_FEASIBLE;
}
int b = phase2();
mpfr_t *s = calloc(sizeof(mpfr_t), n);
for(j=0;j<n;j++) {
mpfr_zinit(s[j]);
}
for (j = 1; j < n; j++) {
if ((i = row[j]) != 0) {
tableau(s[j], i, 0);
}
}
mpfr_t cs;
mpfr_zinit(cs);
if (row[n] != 0) tableau(cs, row[n], 0);
for (j = 1; j < n; j++) {
mpfr_sub(s[j], s[j], cs, GMP_RNDN);
}
for(j=0;j<n;j++) {
mpfr_set(result[j], s[j], GMP_RNDN);
}
mpfr_clear(cs);
for(j=0;j<n;j++) mpfr_clear(s[j]);
free(s);
dispose();
return b ? OK : MAXIMIZABLE_TO_INFINITY;
}
dgsl_rot_mp_t *dgsl_rot_mp_init(const long n, const fmpz_poly_t B, mpfr_t sigma, fmpq_poly_t c, const dgsl_alg_t algorithm, const oz_flag_t flags) {
assert(mpfr_cmp_ui(sigma, 0) > 0);
dgsl_rot_mp_t *self = (dgsl_rot_mp_t*)calloc(1, sizeof(dgsl_rot_mp_t));
if(!self) dgs_die("out of memory");
dgsl_alg_t alg = algorithm;
self->n = n;
self->prec = mpfr_get_prec(sigma);
fmpz_poly_init(self->B);
fmpz_poly_set(self->B, B);
if(fmpz_poly_length(self->B) > n)
dgs_die("polynomial is longer than length n");
else
fmpz_poly_realloc(self->B, n);
fmpz_poly_init(self->c_z);
fmpq_poly_init(self->c);
mpfr_init2(self->sigma, self->prec);
mpfr_set(self->sigma, sigma, MPFR_RNDN);
if (alg == DGSL_DETECT) {
if (fmpz_poly_is_one(self->B) && (c && fmpq_poly_is_zero(c))) {
alg = DGSL_IDENTITY;
} else if (c && fmpq_poly_is_zero(c))
alg = DGSL_INLATTICE;
else
alg = DGSL_COSET; //TODO: we could test for lattice membership here
}
size_t tau = 3;
if (2*ceil(sqrt(log2((double)n))) > tau)
tau = 2*ceil(sqrt(log2((double)n)));
switch(alg) {
case DGSL_IDENTITY: {
self->D = (dgs_disc_gauss_mp_t**)calloc(1, sizeof(dgs_disc_gauss_mp_t*));
mpfr_t c_;
mpfr_init2(c_, self->prec);
mpfr_set_d(c_, 0.0, MPFR_RNDN);
self->D[0] = dgs_disc_gauss_mp_init(self->sigma, c_, tau, DGS_DISC_GAUSS_DEFAULT);
self->call = dgsl_rot_mp_call_identity;
mpfr_clear(c_);
break;
}
case DGSL_GPV_INLATTICE: {
self->D = (dgs_disc_gauss_mp_t**)calloc(n, sizeof(dgs_disc_gauss_mp_t*));
if (c && !fmpq_poly_is_zero(c)) {
fmpq_t c_i;
fmpq_init(c_i);
for(int i=0; i<n; i++) {
fmpq_poly_get_coeff_fmpq(c_i, c, i);
fmpz_poly_set_coeff_fmpz(self->c_z, i, fmpq_numref(c_i));
}
fmpq_clear(c_i);
}
mpfr_mat_t G;
mpfr_mat_init(G, n, n, self->prec);
mpfr_mat_set_fmpz_poly(G, B);
mpfr_mat_gso(G, MPFR_RNDN);
mpfr_t sigma_;
mpfr_init2(sigma_, self->prec);
mpfr_t norm;
mpfr_init2(norm, self->prec);
mpfr_t c_;
mpfr_init2(c_, self->prec);
mpfr_set_d(c_, 0.0, MPFR_RNDN);
for(long i=0; i<n; i++) {
_mpfr_vec_2norm(norm, G->rows[i], n, MPFR_RNDN);
assert(mpfr_cmp_d(norm, 0.0) > 0);
mpfr_div(sigma_, self->sigma, norm, MPFR_RNDN);
assert(mpfr_cmp_d(sigma_, 0.0) > 0);
self->D[i] = dgs_disc_gauss_mp_init(sigma_, c_, tau, DGS_DISC_GAUSS_DEFAULT);
}
mpfr_clear(sigma_);
mpfr_clear(norm);
mpfr_clear(c_);
mpfr_mat_clear(G);
self->call = dgsl_rot_mp_call_gpv_inlattice;
break;
}
case DGSL_INLATTICE: {
fmpq_poly_init(self->sigma_sqrt);
long r= 2*ceil(sqrt(log(n)));
fmpq_poly_t Bq; fmpq_poly_init(Bq);
fmpq_poly_set_fmpz_poly(Bq, self->B);
fmpq_poly_oz_invert_approx(self->B_inv, Bq, n, self->prec, flags);
fmpq_poly_clear(Bq);
_dgsl_rot_mp_sqrt_sigma_2(self->sigma_sqrt, self->B, sigma, r, n, self->prec, flags);
mpfr_init2(self->r_f, self->prec);
mpfr_set_ui(self->r_f, r, MPFR_RNDN);
self->call = dgsl_rot_mp_call_inlattice;
break;
}
case DGSL_COSET:
dgs_die("not implemented");
default:
dgs_die("not implemented");
}
return self;
}
bool MpfrFloat::operator!=(double value) const
{
return mpfr_cmp_d(mData->mFloat, value) != 0;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("log....");
fflush(stdout);
flint_randinit(state);
/* compare with mpfr */
for (iter = 0; iter < 100000 * arb_test_multiplier(); iter++)
{
arb_t a, b;
fmpq_t q;
mpfr_t t;
slong prec = 2 + n_randint(state, 200);
arb_init(a);
arb_init(b);
fmpq_init(q);
mpfr_init2(t, prec + 100);
do {
arb_randtest(a, state, 1 + n_randint(state, 200), 10);
} while (arb_contains_nonpositive(a));
arb_randtest(b, state, 1 + n_randint(state, 200), 10);
arb_get_rand_fmpq(q, state, a, 1 + n_randint(state, 200));
fmpq_get_mpfr(t, q, MPFR_RNDN);
/* todo: estimate cancellation precisely */
if (mpfr_cmp_d(t, 1 - 1e-10) > 0 && mpfr_cmp_d(t, 1 + 1e-10) < 0)
{
mpfr_set_prec(t, prec + 1000);
fmpq_get_mpfr(t, q, MPFR_RNDN);
}
mpfr_log(t, t, MPFR_RNDN);
arb_log(b, a, prec);
if (!arb_contains_mpfr(b, t))
{
flint_printf("FAIL: containment\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
abort();
}
arb_log(a, a, prec);
if (!arb_equal(a, b))
{
flint_printf("FAIL: aliasing\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
fmpq_clear(q);
mpfr_clear(t);
}
/* compare with mpfr (higher precision) */
for (iter = 0; iter < 1000 * arb_test_multiplier(); iter++)
{
arb_t a, b;
fmpq_t q;
mpfr_t t;
slong prec = 2 + n_randint(state, 6000);
arb_init(a);
arb_init(b);
fmpq_init(q);
mpfr_init2(t, prec + 100);
do {
arb_randtest(a, state, 1 + n_randint(state, 6000), 10);
} while (arb_contains_nonpositive(a));
arb_randtest(b, state, 1 + n_randint(state, 6000), 10);
arb_get_rand_fmpq(q, state, a, 1 + n_randint(state, 200));
fmpq_get_mpfr(t, q, MPFR_RNDN);
/* todo: estimate cancellation precisely */
if (mpfr_cmp_d(t, 1 - 1e-10) > 0 && mpfr_cmp_d(t, 1 + 1e-10) < 0)
{
mpfr_set_prec(t, prec + 10000);
fmpq_get_mpfr(t, q, MPFR_RNDN);
}
mpfr_log(t, t, MPFR_RNDN);
arb_log(b, a, prec);
if (!arb_contains_mpfr(b, t))
{
flint_printf("FAIL: containment\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
abort();
}
arb_log(a, a, prec);
if (!arb_equal(a, b))
{
flint_printf("FAIL: aliasing\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
fmpq_clear(q);
mpfr_clear(t);
}
/* test large numbers */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, ab, lab, la, lb, lalb;
slong prec = 2 + n_randint(state, 6000);
arb_init(a);
arb_init(b);
arb_init(ab);
arb_init(lab);
arb_init(la);
arb_init(lb);
arb_init(lalb);
arb_randtest(a, state, 1 + n_randint(state, 400), 400);
arb_randtest(b, state, 1 + n_randint(state, 400), 400);
arb_log(la, a, prec);
arb_log(lb, b, prec);
arb_mul(ab, a, b, prec);
arb_log(lab, ab, prec);
arb_add(lalb, la, lb, prec);
if (!arb_overlaps(lab, lalb))
{
flint_printf("FAIL: containment\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("la = "); arb_print(la); flint_printf("\n\n");
flint_printf("lb = "); arb_print(lb); flint_printf("\n\n");
flint_printf("ab = "); arb_print(ab); flint_printf("\n\n");
flint_printf("lab = "); arb_print(lab); flint_printf("\n\n");
flint_printf("lalb = "); arb_print(lalb); flint_printf("\n\n");
abort();
}
arb_log(a, a, prec);
if (!arb_overlaps(a, la))
{
flint_printf("FAIL: aliasing\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(ab);
arb_clear(lab);
arb_clear(la);
arb_clear(lb);
arb_clear(lalb);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
/* Compute the real part of the dilogarithm defined by
Li2(x) = -\Int_{t=0}^x log(1-t)/t dt */
int
mpfr_li2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
int inexact;
mp_exp_t err;
mpfr_prec_t yp, m;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode), ("y[%#R]=%R", y));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
MPFR_SET_NEG (y);
MPFR_SET_INF (y);
MPFR_RET (0);
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_SAME_SIGN (y, x);
MPFR_SET_ZERO (y);
MPFR_RET (0);
}
}
/* Li2(x) = x + x^2/4 + x^3/9 + ..., more precisely for 0 < x <= 1/2
we have |Li2(x) - x| < x^2/2 <= 2^(2EXP(x)-1) and for -1/2 <= x < 0
we have |Li2(x) - x| < x^2/4 <= 2^(2EXP(x)-2) */
if (MPFR_IS_POS (x))
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 1, 1, rnd_mode,
{});
else
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -MPFR_GET_EXP (x), 2, 0, rnd_mode,
{});
MPFR_SAVE_EXPO_MARK (expo);
yp = MPFR_PREC (y);
m = yp + MPFR_INT_CEIL_LOG2 (yp) + 13;
if (MPFR_LIKELY ((mpfr_cmp_ui (x, 0) > 0) && (mpfr_cmp_d (x, 0.5) <= 0)))
/* 0 < x <= 1/2: Li2(x) = S(-log(1-x))-log^2(1-x)/4 */
{
mpfr_t s, u;
mp_exp_t expo_l;
int k;
mpfr_init2 (u, m);
mpfr_init2 (s, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_ui_sub (u, 1, x, GMP_RNDN);
mpfr_log (u, u, GMP_RNDU);
if (MPFR_IS_ZERO(u))
goto next_m;
mpfr_neg (u, u, GMP_RNDN); /* u = -log(1-x) */
expo_l = MPFR_GET_EXP (u);
k = li2_series (s, u, GMP_RNDU);
err = 1 + MPFR_INT_CEIL_LOG2 (k + 1);
mpfr_sqr (u, u, GMP_RNDU);
mpfr_div_2ui (u, u, 2, GMP_RNDU); /* u = log^2(1-x) / 4 */
mpfr_sub (s, s, u, GMP_RNDN);
/* error(s) <= (0.5 + 2^(d-EXP(s))
+ 2^(3 + MAX(1, - expo_l) - EXP(s))) ulp(s) */
err = MAX (err, MAX (1, - expo_l) - 1) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err);
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
next_m:
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (u, m);
mpfr_set_prec (s, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (u);
mpfr_clear (s);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else if (!mpfr_cmp_ui (x, 1))
/* Li2(1)= pi^2 / 6 */
{
mpfr_t u;
mpfr_init2 (u, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_const_pi (u, GMP_RNDU);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_ui (u, u, 6, GMP_RNDN);
err = m - 4; /* error(u) <= 19/2 ulp(u) */
if (MPFR_CAN_ROUND (u, err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (u, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, u, rnd_mode);
mpfr_clear (u);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else if (mpfr_cmp_ui (x, 2) >= 0)
/* x >= 2: Li2(x) = -S(-log(1-1/x))-log^2(x)/2+log^2(1-1/x)/4+pi^2/3 */
{
int k;
mp_exp_t expo_l;
mpfr_t s, u, xx;
if (mpfr_cmp_ui (x, 38) >= 0)
{
inexact = mpfr_li2_asympt_pos (y, x, rnd_mode);
if (inexact != 0)
goto end_of_case_gt2;
}
mpfr_init2 (u, m);
mpfr_init2 (s, m);
mpfr_init2 (xx, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_ui_div (xx, 1, x, GMP_RNDN);
mpfr_neg (xx, xx, GMP_RNDN);
mpfr_log1p (u, xx, GMP_RNDD);
mpfr_neg (u, u, GMP_RNDU); /* u = -log(1-1/x) */
expo_l = MPFR_GET_EXP (u);
k = li2_series (s, u, GMP_RNDN);
mpfr_neg (s, s, GMP_RNDN);
err = MPFR_INT_CEIL_LOG2 (k + 1) + 1; /* error(s) <= 2^err ulp(s) */
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u= log^2(1-1/x)/4 */
mpfr_add (s, s, u, GMP_RNDN);
err =
MAX (err,
3 + MAX (1, -expo_l) + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */
err += MPFR_GET_EXP (s);
mpfr_log (u, x, GMP_RNDU);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_2ui (u, u, 1, GMP_RNDN); /* u = log^2(x)/2 */
mpfr_sub (s, s, u, GMP_RNDN);
err = MAX (err, 3 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */
err += MPFR_GET_EXP (s);
mpfr_const_pi (u, GMP_RNDU);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_ui (u, u, 3, GMP_RNDN); /* u = pi^2/3 */
mpfr_add (s, s, u, GMP_RNDN);
err = MAX (err, 2) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err); /* error(s) <= 2^err ulp(s) */
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (u, m);
mpfr_set_prec (s, m);
mpfr_set_prec (xx, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clears (s, u, xx, (mpfr_ptr) 0);
end_of_case_gt2:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else if (mpfr_cmp_ui (x, 1) > 0)
/* 2 > x > 1: Li2(x) = S(log(x))+log^2(x)/4-log(x)log(x-1)+pi^2/6 */
{
int k;
mp_exp_t e1, e2;
mpfr_t s, u, v, xx;
mpfr_init2 (s, m);
mpfr_init2 (u, m);
mpfr_init2 (v, m);
mpfr_init2 (xx, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_log (v, x, GMP_RNDU);
k = li2_series (s, v, GMP_RNDN);
e1 = MPFR_GET_EXP (s);
mpfr_sqr (u, v, GMP_RNDN);
mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(x)/4 */
mpfr_add (s, s, u, GMP_RNDN);
mpfr_sub_ui (xx, x, 1, GMP_RNDN);
mpfr_log (u, xx, GMP_RNDU);
e2 = MPFR_GET_EXP (u);
mpfr_mul (u, v, u, GMP_RNDN); /* u = log(x) * log(x-1) */
mpfr_sub (s, s, u, GMP_RNDN);
mpfr_const_pi (u, GMP_RNDU);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_ui (u, u, 6, GMP_RNDN); /* u = pi^2/6 */
mpfr_add (s, s, u, GMP_RNDN);
/* error(s) <= (31 + (k+1) * 2^(1-e1) + 2^(1-e2)) ulp(s)
see algorithms.tex */
err = MAX (MPFR_INT_CEIL_LOG2 (k + 1) + 1 - e1, 1 - e2);
err = 2 + MAX (5, err);
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (s, m);
mpfr_set_prec (u, m);
mpfr_set_prec (v, m);
mpfr_set_prec (xx, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clears (s, u, v, xx, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else if (mpfr_cmp_ui_2exp (x, 1, -1) > 0) /* 1/2 < x < 1 */
/* 1 > x > 1/2: Li2(x) = -S(-log(x))+log^2(x)/4-log(x)log(1-x)+pi^2/6 */
{
int k;
mpfr_t s, u, v, xx;
mpfr_init2 (s, m);
mpfr_init2 (u, m);
mpfr_init2 (v, m);
mpfr_init2 (xx, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_log (u, x, GMP_RNDD);
mpfr_neg (u, u, GMP_RNDN);
k = li2_series (s, u, GMP_RNDN);
mpfr_neg (s, s, GMP_RNDN);
err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s);
mpfr_ui_sub (xx, 1, x, GMP_RNDN);
mpfr_log (v, xx, GMP_RNDU);
mpfr_mul (v, v, u, GMP_RNDN); /* v = - log(x) * log(1-x) */
mpfr_add (s, s, v, GMP_RNDN);
err = MAX (err, 1 - MPFR_GET_EXP (v));
err = 2 + MAX (3, err) - MPFR_GET_EXP (s);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(x)/4 */
mpfr_add (s, s, u, GMP_RNDN);
err = MAX (err, 2 + MPFR_GET_EXP (u)) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);
mpfr_const_pi (u, GMP_RNDU);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_ui (u, u, 6, GMP_RNDN); /* u = pi^2/6 */
mpfr_add (s, s, u, GMP_RNDN);
err = MAX (err, 3) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err);
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (s, m);
mpfr_set_prec (u, m);
mpfr_set_prec (v, m);
mpfr_set_prec (xx, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clears (s, u, v, xx, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else if (mpfr_cmp_si (x, -1) >= 0)
/* 0 > x >= -1: Li2(x) = -S(log(1-x))-log^2(1-x)/4 */
{
int k;
mp_exp_t expo_l;
mpfr_t s, u, xx;
mpfr_init2 (s, m);
mpfr_init2 (u, m);
mpfr_init2 (xx, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_neg (xx, x, GMP_RNDN);
mpfr_log1p (u, xx, GMP_RNDN);
k = li2_series (s, u, GMP_RNDN);
mpfr_neg (s, s, GMP_RNDN);
expo_l = MPFR_GET_EXP (u);
err = 1 + MPFR_INT_CEIL_LOG2 (k + 1) - MPFR_GET_EXP (s);
mpfr_sqr (u, u, GMP_RNDN);
mpfr_div_2ui (u, u, 2, GMP_RNDN); /* u = log^2(1-x)/4 */
mpfr_sub (s, s, u, GMP_RNDN);
err = MAX (err, - expo_l);
err = 2 + MAX (err, 3);
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (s, m);
mpfr_set_prec (u, m);
mpfr_set_prec (xx, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clears (s, u, xx, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
else
/* x < -1: Li2(x)
= S(log(1-1/x))-log^2(-x)/4-log(1-x)log(-x)/2+log^2(1-x)/4-pi^2/6 */
{
int k;
mpfr_t s, u, v, w, xx;
if (mpfr_cmp_si (x, -7) <= 0)
{
inexact = mpfr_li2_asympt_neg (y, x, rnd_mode);
if (inexact != 0)
goto end_of_case_ltm1;
}
mpfr_init2 (s, m);
mpfr_init2 (u, m);
mpfr_init2 (v, m);
mpfr_init2 (w, m);
mpfr_init2 (xx, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_ui_div (xx, 1, x, GMP_RNDN);
mpfr_neg (xx, xx, GMP_RNDN);
mpfr_log1p (u, xx, GMP_RNDN);
k = li2_series (s, u, GMP_RNDN);
mpfr_ui_sub (xx, 1, x, GMP_RNDN);
mpfr_log (u, xx, GMP_RNDU);
mpfr_neg (xx, x, GMP_RNDN);
mpfr_log (v, xx, GMP_RNDU);
mpfr_mul (w, v, u, GMP_RNDN);
mpfr_div_2ui (w, w, 1, GMP_RNDN); /* w = log(-x) * log(1-x) / 2 */
mpfr_sub (s, s, w, GMP_RNDN);
err = 1 + MAX (3, MPFR_INT_CEIL_LOG2 (k+1) + 1 - MPFR_GET_EXP (s))
+ MPFR_GET_EXP (s);
mpfr_sqr (w, v, GMP_RNDN);
mpfr_div_2ui (w, w, 2, GMP_RNDN); /* w = log^2(-x) / 4 */
mpfr_sub (s, s, w, GMP_RNDN);
err = MAX (err, 3 + MPFR_GET_EXP(w)) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);
mpfr_sqr (w, u, GMP_RNDN);
mpfr_div_2ui (w, w, 2, GMP_RNDN); /* w = log^2(1-x) / 4 */
mpfr_add (s, s, w, GMP_RNDN);
err = MAX (err, 3 + MPFR_GET_EXP (w)) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);
mpfr_const_pi (w, GMP_RNDU);
mpfr_sqr (w, w, GMP_RNDN);
mpfr_div_ui (w, w, 6, GMP_RNDN); /* w = pi^2 / 6 */
mpfr_sub (s, s, w, GMP_RNDN);
err = MAX (err, 3) - MPFR_GET_EXP (s);
err = 2 + MAX (-1, err) + MPFR_GET_EXP (s);
if (MPFR_CAN_ROUND (s, (mp_exp_t) m - err, yp, rnd_mode))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (s, m);
mpfr_set_prec (u, m);
mpfr_set_prec (v, m);
mpfr_set_prec (w, m);
mpfr_set_prec (xx, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clears (s, u, v, w, xx, (mpfr_ptr) 0);
end_of_case_ltm1:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
MPFR_ASSERTN (0); /* should never reach this point */
}
