void mpfr_taylor_sin_bounded(mpfr_t R, mpfr_t x, unsigned int N)
{
mpfr_printf("%.20RNF\n", x);
assert(mpfr_cmp_ui(x, 0) >= 0 && mpfr_cmp(x, MPFR_HALF_PI) <= 0);
mpfr_t t, x_2;
mpfr_init_set(R, x, MPFR_RNDN);
mpfr_init_set(t, x, MPFR_RNDN);
mpfr_init(x_2);
mpfr_mul(x_2, x, x, MPFR_RNDN);
for(int n = 1; n < N; n++)
{
mpfr_div_ui(t, t, (2*n+1)*(2*(n++)), MPFR_RNDN);
mpfr_mul(t, t, x_2, MPFR_RNDN);
mpfr_sub(R, R, t, MPFR_RNDN);
mpfr_div_ui(t, t, (2*n+1)*(2*n), MPFR_RNDN);
mpfr_mul(t, t, x_2, MPFR_RNDN);
mpfr_add(R, R, t, MPFR_RNDN);
}
}
/* With pow.c r5497, the following test fails on a 64-bit Linux machine
* due to a double-rounding problem when rescaling the result:
* Error with underflow_up2 and extended exponent range
* x = 7.fffffffffffffff0@-1,
* y = 4611686018427387904, MPFR_RNDN
* Expected 1.0000000000000000@-1152921504606846976, inex = 1, flags = 9
* Got 0, inex = -1, flags = 9
* With pow_ui.c r5423, the following test fails on a 64-bit Linux machine
* as underflows and overflows are not handled correctly (the approximation
* error is ignored):
* Error with mpfr_pow_ui, flags cleared
* x = 7.fffffffffffffff0@-1,
* y = 4611686018427387904, MPFR_RNDN
* Expected 1.0000000000000000@-1152921504606846976, inex = 1, flags = 9
* Got 0, inex = -1, flags = 9
*/
static void
underflow_up2 (void)
{
mpfr_t x, y, z, z0, eps;
mpfr_exp_t n;
int inex;
int rnd;
n = 1 - mpfr_get_emin ();
MPFR_ASSERTN (n > 1);
if (n > ULONG_MAX)
return;
mpfr_init2 (eps, 2);
mpfr_set_ui_2exp (eps, 1, -1, MPFR_RNDN); /* 1/2 */
mpfr_div_ui (eps, eps, n, MPFR_RNDZ); /* 1/(2n) rounded toward zero */
mpfr_init2 (x, sizeof (unsigned long) * CHAR_BIT + 1);
inex = mpfr_ui_sub (x, 1, eps, MPFR_RNDN);
MPFR_ASSERTN (inex == 0); /* since n < 2^(size_of_long_in_bits) */
inex = mpfr_div_2ui (x, x, 1, MPFR_RNDN); /* 1/2 - eps/2 exactly */
MPFR_ASSERTN (inex == 0);
mpfr_init2 (y, sizeof (unsigned long) * CHAR_BIT);
inex = mpfr_set_ui (y, n, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
/* 0 < eps < 1 / (2n), thus (1 - eps)^n > 1/2,
and 1/2 (1/2)^n < (1/2 - eps/2)^n < (1/2)^n. */
mpfr_inits2 (64, z, z0, (mpfr_ptr) 0);
RND_LOOP (rnd)
{
unsigned int ufinex = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
int expected_inex;
char sy[256];
mpfr_set_ui (z0, 0, MPFR_RNDN);
expected_inex = rnd == MPFR_RNDN || rnd == MPFR_RNDU || rnd == MPFR_RNDA ?
(mpfr_nextabove (z0), 1) : -1;
sprintf (sy, "%lu", (unsigned long) n);
mpfr_clear_flags ();
inex = mpfr_pow (z, x, y, (mpfr_rnd_t) rnd);
cmpres (0, x, sy, (mpfr_rnd_t) rnd, z0, expected_inex, z, inex, ufinex,
"underflow_up2", "mpfr_pow");
test_others (NULL, sy, (mpfr_rnd_t) rnd, x, y, z, inex, ufinex,
"underflow_up2");
}
mpfr_clears (x, y, z, z0, eps, (mpfr_ptr) 0);
}
void coords_center_to_rect(coords* c)
{
mpfr_t tmp;
mpfr_init2(tmp, c->precision);
DMSG("updating from center to rect\n");
if (c->aspect > 1.0)
{
DMSG("wide image");
mpfr_div_d( c->height, c->width, c->aspect, GMP_RNDN);
mpfr_div_ui(tmp, c->width, 2, GMP_RNDN);
mpfr_sub( c->xmin, c->cx, tmp, GMP_RNDN);
mpfr_add( c->xmax, c->xmin, c->width, GMP_RNDN);
mpfr_div_d( tmp, tmp, c->aspect, GMP_RNDN);
mpfr_sub( c->ymin, c->cy, tmp, GMP_RNDN);
mpfr_add( c->ymax, c->ymin, c->height, GMP_RNDN);
}
else
{
DMSG("tall image");
mpfr_mul_d( c->width, c->height, c->aspect, GMP_RNDN);
mpfr_div_ui(tmp, c->height, 2, GMP_RNDN);
mpfr_sub( c->ymin, c->cy, tmp, GMP_RNDN);
mpfr_add( c->ymax, c->ymin, c->height, GMP_RNDN);
mpfr_mul_d( tmp, tmp, c->aspect, GMP_RNDN);
mpfr_sub( c->xmin, c->cx, tmp, GMP_RNDN);
mpfr_add( c->xmax, c->xmin, c->width, GMP_RNDN);
}
mpfr_clear(tmp);
}
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;
}
//-----------------------------------------------------------
// 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);
}
__inline__ static void
log2_L2_norm_4arg(mpfr_t tgt, const mpz_square_mat_t A, slong k, slong n)
// log2(L2 norm) rounded down. tgt initialized by caller
{
mpz_t norm; mpz_init(norm);
slong i;
square_L2_mpz(norm,A->rows[k],n);
i=mpz_size(norm);
if(i>2)
i=2;
mpfr_t normF; mpfr_init2(normF,i*FLINT_BITS);
mpfr_set_z(normF,norm,MPFR_RNDU);
mpz_clear(norm);
mpfr_log2(tgt, normF, MPFR_RNDU);
mpfr_div_ui(tgt,tgt,2,MPFR_RNDU);
mpfr_clear(normF);
}
/*
Parameters:
s - the input floating-point number
n, p - parameters from the algorithm
tc - an array of p floating-point numbers tc[1]..tc[p]
Output:
b is the result, i.e.
sum(tc[i]*product((s+2j)*(s+2j-1)/n^2,j=1..i-1), i=1..p)*s*n^(-s-1)
*/
static void
mpfr_zeta_part_b (mpfr_t b, mpfr_srcptr s, int n, int p, mpfr_t *tc)
{
mpfr_t s1, d, u;
unsigned long n2;
int l, t;
MPFR_GROUP_DECL (group);
if (p == 0)
{
MPFR_SET_ZERO (b);
MPFR_SET_POS (b);
return;
}
n2 = n * n;
MPFR_GROUP_INIT_3 (group, MPFR_PREC (b), s1, d, u);
/* t equals 2p-2, 2p-3, ... ; s1 equals s+t */
t = 2 * p - 2;
mpfr_set (d, tc[p], GMP_RNDN);
for (l = 1; l < p; l++)
{
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l-1) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_div_ui (d, d, n2, GMP_RNDN);
mpfr_add (d, d, tc[p-l], GMP_RNDN);
/* since s is positive and the tc[i] have alternate signs,
the following is unlikely */
if (MPFR_UNLIKELY (mpfr_cmpabs (d, tc[p-l]) > 0))
mpfr_set (d, tc[p-l], GMP_RNDN);
}
mpfr_mul (d, d, s, GMP_RNDN);
mpfr_add (s1, s, __gmpfr_one, GMP_RNDN);
mpfr_neg (s1, s1, GMP_RNDN);
mpfr_ui_pow (u, n, s1, GMP_RNDN);
mpfr_mul (b, d, u, GMP_RNDN);
MPFR_GROUP_CLEAR (group);
}
static void
check (const char *ds, unsigned long u, mpfr_rnd_t rnd, const char *es)
{
mpfr_t x, y;
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
mpfr_set_str1 (x, ds);
mpfr_div_ui (y, x, u, rnd);
if (mpfr_cmp_str1 (y, es))
{
printf ("mpfr_div_ui failed for x=%s, u=%lu, rnd=%s\n", ds, u,
mpfr_print_rnd_mode (rnd));
printf ("expected result is %s, got", es);
mpfr_out_str(stdout, 10, 0, y, MPFR_RNDN);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
slong
hadamard_2arg(mpfr_t b,const fmpz_mat_t m)
/*
upper bound on log2( 2*abs(m det) )
returns -1 if zero row found, smallest row index otherwise
b on entry is uninitialized
b on exit is initialized iff no zero row found
*/
{
const slong n=m->r;
slong smallest=0,j;
// gcc warning: initialization from incompatible pointer type --- don't know
// how to fix
const fmpz** const rows=m->rows;
mpfr_t v,u;
if(log2_L2_fmpz_3arg( v, rows[0], n ))
return -1;
mpfr_copy_bound(b, v);
// v and b must be freed
for(j=1;j<n;j++)
{
if(log2_L2_fmpz_3arg( u, rows[j], n ))
{
mpfr_clear(b); mpfr_clear(v);
return -1;
}
mpfr_add_bound(b, u);
if( mpfr_cmp(u, v)<0 )
{
smallest=j;
mpfr_swap(v, u);
}
mpfr_clear(u);
// v and b must be freed
}
mpfr_clear(v);
mpfr_div_ui( b, b, 2, MPFR_RNDU ); // instead of taking root
mpfr_add_ui( b, b, 1, MPFR_RNDU ); // instead of multiplying by 2
return smallest;
}
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);
}
}
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);
}
/* 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;
}
int
main (int argc, char *argv[])
{
mpfr_t x, c, s, c2, s2;
tests_start_mpfr ();
check_regression ();
check_nans ();
/* worst case from PhD thesis of Vincent Lefe`vre: x=8980155785351021/2^54 */
check53 ("4.984987858808754279e-1", "4.781075595393330379e-1", MPFR_RNDN);
check53 ("4.984987858808754279e-1", "4.781075595393329824e-1", MPFR_RNDD);
check53 ("4.984987858808754279e-1", "4.781075595393329824e-1", MPFR_RNDZ);
check53 ("4.984987858808754279e-1", "4.781075595393330379e-1", MPFR_RNDU);
check53 ("1.00031274099908640274", "8.416399183372403892e-1", MPFR_RNDN);
check53 ("1.00229256850978698523", "8.427074524447979442e-1", MPFR_RNDZ);
check53 ("1.00288304857059840103", "8.430252033025980029e-1", MPFR_RNDZ);
check53 ("1.00591265847407274059", "8.446508805292128885e-1", MPFR_RNDN);
/* Other worst cases showing a bug introduced on 2005-01-29 in rev 3248 */
check53b ("1.0111001111010111010111111000010011010001110001111011e-21",
"1.0111001111010111010111111000010011010001101001110001e-21",
MPFR_RNDU);
check53b ("1.1011101111111010000001010111000010000111100100101101",
"1.1111100100101100001111100000110011110011010001010101e-1",
MPFR_RNDU);
mpfr_init2 (x, 2);
mpfr_set_str (x, "0.5", 10, MPFR_RNDN);
test_sin (x, x, MPFR_RNDD);
if (mpfr_cmp_ui_2exp (x, 3, -3)) /* x != 0.375 = 3/8 */
{
printf ("mpfr_sin(0.5, MPFR_RNDD) failed with precision=2\n");
exit (1);
}
/* bug found by Kevin Ryde */
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_ui (x, x, 3L, MPFR_RNDN);
mpfr_div_ui (x, x, 2L, MPFR_RNDN);
test_sin (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) >= 0)
{
printf ("Error: wrong sign for sin(3*Pi/2)\n");
exit (1);
}
/* Can fail on an assert */
mpfr_set_prec (x, 53);
mpfr_set_str (x, "77291789194529019661184401408", 10, MPFR_RNDN);
mpfr_init2 (c, 4); mpfr_init2 (s, 42);
mpfr_init2 (c2, 4); mpfr_init2 (s2, 42);
test_sin (s, x, MPFR_RNDN);
mpfr_cos (c, x, MPFR_RNDN);
mpfr_sin_cos (s2, c2, x, MPFR_RNDN);
if (mpfr_cmp (c2, c))
{
printf("cos differs for x=77291789194529019661184401408");
exit (1);
}
if (mpfr_cmp (s2, s))
{
printf("sin differs for x=77291789194529019661184401408");
exit (1);
}
mpfr_set_str_binary (x, "1.1001001000011111101101010100010001000010110100010011");
test_sin (x, x, MPFR_RNDZ);
if (mpfr_cmp_str (x, "1.1111111111111111111111111111111111111111111111111111e-1", 2, MPFR_RNDN))
{
printf ("Error for x= 1.1001001000011111101101010100010001000010110100010011\nGot ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (s, 9);
mpfr_set_prec (x, 190);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_sin (s, x, MPFR_RNDZ);
if (mpfr_cmp_str (s, "0.100000101e-196", 2, MPFR_RNDN))
{
printf ("Error for x ~= pi\n");
mpfr_dump (s);
exit (1);
}
mpfr_clear (s2);
mpfr_clear (c2);
mpfr_clear (s);
mpfr_clear (c);
mpfr_clear (x);
test_generic (2, 100, 15);
test_generic (MPFR_SINCOS_THRESHOLD-1, MPFR_SINCOS_THRESHOLD+1, 2);
test_sign ();
check_tiny ();
data_check ("data/sin", mpfr_sin, "mpfr_sin");
bad_cases (mpfr_sin, mpfr_asin, "mpfr_sin", 256, -40, 0, 4, 128, 800, 50);
tests_end_mpfr ();
return 0;
}
/* 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;
}
int
mpfr_erf (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xf;
mp_limb_t xf_limb[(53 - 1) / GMP_NUMB_BITS + 1];
int inex, large;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inex));
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)) /* erf(+inf) = +1, erf(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (x), MPFR_RNDN);
else /* erf(+0) = +0, erf(-0) = -0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set (y, x, MPFR_RNDN); /* should keep the sign of x */
}
}
/* now x is neither NaN, Inf nor 0 */
/* first try expansion at x=0 when x is small, or asymptotic expansion
where x is large */
MPFR_SAVE_EXPO_MARK (expo);
/* around x=0, we have erf(x) = 2x/sqrt(Pi) (1 - x^2/3 + ...),
with 1 - x^2/3 <= sqrt(Pi)*erf(x)/2/x <= 1 for x >= 0. This means that
if x^2/3 < 2^(-PREC(y)-1) we can decide of the correct rounding,
unless we have a worst-case for 2x/sqrt(Pi). */
if (MPFR_EXP(x) < - (mpfr_exp_t) (MPFR_PREC(y) / 2))
{
/* we use 2x/sqrt(Pi) (1 - x^2/3) <= erf(x) <= 2x/sqrt(Pi) for x > 0
and 2x/sqrt(Pi) <= erf(x) <= 2x/sqrt(Pi) (1 - x^2/3) for x < 0.
In both cases |2x/sqrt(Pi) (1 - x^2/3)| <= |erf(x)| <= |2x/sqrt(Pi)|.
We will compute l and h such that l <= |2x/sqrt(Pi) (1 - x^2/3)|
and |2x/sqrt(Pi)| <= h. If l and h round to the same value to
precision PREC(y) and rounding rnd_mode, then we are done. */
mpfr_t l, h; /* lower and upper bounds for erf(x) */
int ok, inex2;
mpfr_init2 (l, MPFR_PREC(y) + 17);
mpfr_init2 (h, MPFR_PREC(y) + 17);
/* first compute l */
mpfr_mul (l, x, x, MPFR_RNDU);
mpfr_div_ui (l, l, 3, MPFR_RNDU); /* upper bound on x^2/3 */
mpfr_ui_sub (l, 1, l, MPFR_RNDZ); /* lower bound on 1 - x^2/3 */
mpfr_const_pi (h, MPFR_RNDU); /* upper bound of Pi */
mpfr_sqrt (h, h, MPFR_RNDU); /* upper bound on sqrt(Pi) */
mpfr_div (l, l, h, MPFR_RNDZ); /* lower bound on 1/sqrt(Pi) (1 - x^2/3) */
mpfr_mul_2ui (l, l, 1, MPFR_RNDZ); /* 2/sqrt(Pi) (1 - x^2/3) */
mpfr_mul (l, l, x, MPFR_RNDZ); /* |l| is a lower bound on
|2x/sqrt(Pi) (1 - x^2/3)| */
/* now compute h */
mpfr_const_pi (h, MPFR_RNDD); /* lower bound on Pi */
mpfr_sqrt (h, h, MPFR_RNDD); /* lower bound on sqrt(Pi) */
mpfr_div_2ui (h, h, 1, MPFR_RNDD); /* lower bound on sqrt(Pi)/2 */
/* since sqrt(Pi)/2 < 1, the following should not underflow */
mpfr_div (h, x, h, MPFR_IS_POS(x) ? MPFR_RNDU : MPFR_RNDD);
/* round l and h to precision PREC(y) */
inex = mpfr_prec_round (l, MPFR_PREC(y), rnd_mode);
inex2 = mpfr_prec_round (h, MPFR_PREC(y), rnd_mode);
/* Caution: we also need inex=inex2 (inex might be 0). */
ok = SAME_SIGN (inex, inex2) && mpfr_cmp (l, h) == 0;
if (ok)
mpfr_set (y, h, rnd_mode);
mpfr_clear (l);
mpfr_clear (h);
if (ok)
goto end;
/* this test can still fail for small precision, for example
for x=-0.100E-2 with a target precision of 3 bits, since
the error term x^2/3 is not that small. */
}
MPFR_TMP_INIT1(xf_limb, xf, 53);
mpfr_div (xf, x, __gmpfr_const_log2_RNDU, MPFR_RNDZ); /* round to zero
ensures we get a lower bound of |x/log(2)| */
mpfr_mul (xf, xf, x, MPFR_RNDZ);
large = mpfr_cmp_ui (xf, MPFR_PREC (y) + 1) > 0;
/* when x goes to infinity, we have erf(x) = 1 - 1/sqrt(Pi)/exp(x^2)/x + ...
and |erf(x) - 1| <= exp(-x^2) is true for any x >= 0, thus if
exp(-x^2) < 2^(-PREC(y)-1) the result is 1 or 1-epsilon.
This rewrites as x^2/log(2) > p+1. */
if (MPFR_UNLIKELY (large))
/* |erf x| = 1 or 1- */
{
mpfr_rnd_t rnd2 = MPFR_IS_POS (x) ? rnd_mode : MPFR_INVERT_RND(rnd_mode);
if (rnd2 == MPFR_RNDN || rnd2 == MPFR_RNDU || rnd2 == MPFR_RNDA)
{
inex = MPFR_INT_SIGN (x);
mpfr_set_si (y, inex, rnd2);
}
else /* round to zero */
{
inex = -MPFR_INT_SIGN (x);
mpfr_setmax (y, 0); /* warning: setmax keeps the old sign of y */
MPFR_SET_SAME_SIGN (y, x);
}
}
else /* use Taylor */
{
double xf2;
/* FIXME: get rid of doubles/mpfr_get_d here */
xf2 = mpfr_get_d (x, MPFR_RNDN);
xf2 = xf2 * xf2; /* xf2 ~ x^2 */
inex = mpfr_erf_0 (y, x, xf2, rnd_mode);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd_mode);
}
static void
check_1minuseps (void)
{
static mpfr_prec_t prec_a[] = {
MPFR_PREC_MIN, 30, 31, 32, 33, 62, 63, 64, 65, 126, 127, 128, 129
};
static int supp_b[] = {
0, 1, 2, 3, 4, 29, 30, 31, 32, 33, 34, 35, 61, 62, 63, 64, 65, 66, 67
};
mpfr_t a, b, c;
unsigned int ia, ib, ic;
mpfr_init2 (c, MPFR_PREC_MIN);
for (ia = 0; ia < numberof (prec_a); ia++)
for (ib = 0; ib < numberof(supp_b); ib++)
{
mpfr_prec_t prec_b;
int rnd_mode;
prec_b = prec_a[ia] + supp_b[ib];
mpfr_init2 (a, prec_a[ia]);
mpfr_init2 (b, prec_b);
mpfr_set_ui (c, 1, MPFR_RNDN);
mpfr_div_ui (b, c, prec_a[ia], MPFR_RNDN);
mpfr_sub (b, c, b, MPFR_RNDN); /* b = 1 - 2^(-prec_a) */
for (ic = 0; ic < numberof(supp_b); ic++)
for (rnd_mode = 0; rnd_mode < MPFR_RND_MAX; rnd_mode++)
{
mpfr_t s;
int inex_a, inex_s;
mpfr_set_ui (c, 1, MPFR_RNDN);
mpfr_div_ui (c, c, prec_a[ia] + supp_b[ic], MPFR_RNDN);
inex_a = test_add (a, b, c, (mpfr_rnd_t) rnd_mode);
mpfr_init2 (s, 256);
inex_s = test_add (s, b, c, MPFR_RNDN); /* exact */
if (inex_s)
{
printf ("check_1minuseps: result should have been exact "
"(ia = %u, ib = %u, ic = %u)\n", ia, ib, ic);
exit (1);
}
inex_s = mpfr_prec_round (s, prec_a[ia], (mpfr_rnd_t) rnd_mode);
if ((inex_a < 0 && inex_s >= 0) ||
(inex_a == 0 && inex_s != 0) ||
(inex_a > 0 && inex_s <= 0) ||
!mpfr_equal_p (a, s))
{
printf ("check_1minuseps: results are different.\n");
printf ("ia = %u, ib = %u, ic = %u\n", ia, ib, ic);
exit (1);
}
mpfr_clear (s);
}
mpfr_clear (a);
mpfr_clear (b);
}
mpfr_clear (c);
}
void
_arith_cos_minpoly(fmpz * coeffs, slong d, ulong n)
{
slong i, j;
fmpz * alpha;
fmpz_t half;
mpfr_t t, u;
mp_bitcnt_t prec;
slong exp;
if (n <= MAX_32BIT)
{
for (i = 0; i <= d; i++)
fmpz_set_si(coeffs + i, lookup_table[n - 1][i]);
return;
}
/* Direct formula for odd primes > 3 */
if (n_is_prime(n))
{
slong s = (n - 1) / 2;
switch (s % 4)
{
case 0:
fmpz_set_si(coeffs, WORD(1));
fmpz_set_si(coeffs + 1, -s);
break;
case 1:
fmpz_set_si(coeffs, WORD(1));
fmpz_set_si(coeffs + 1, s + 1);
break;
case 2:
fmpz_set_si(coeffs, WORD(-1));
fmpz_set_si(coeffs + 1, s);
break;
case 3:
fmpz_set_si(coeffs, WORD(-1));
fmpz_set_si(coeffs + 1, -s - 1);
break;
}
for (i = 2; i <= s; i++)
{
slong b = (s - i) % 2;
fmpz_mul2_uiui(coeffs + i, coeffs + i - 2, s+i-b, s+2-b-i);
fmpz_divexact2_uiui(coeffs + i, coeffs + i, i, i-1);
fmpz_neg(coeffs + i, coeffs + i);
}
return;
}
prec = magnitude_bound(d) + 5 + FLINT_BIT_COUNT(d);
alpha = _fmpz_vec_init(d);
fmpz_init(half);
mpfr_init2(t, prec);
mpfr_init2(u, prec);
fmpz_one(half);
fmpz_mul_2exp(half, half, prec - 1);
mpfr_const_pi(t, prec);
mpfr_div_ui(t, t, n, MPFR_RNDN);
for (i = j = 0; j < d; i++)
{
if (n_gcd(n, i) == 1)
{
mpfr_mul_ui(u, t, 2 * i, MPFR_RNDN);
mpfr_cos(u, u, MPFR_RNDN);
mpfr_neg(u, u, MPFR_RNDN);
exp = mpfr_get_z_2exp(_fmpz_promote(alpha + j), u);
_fmpz_demote_val(alpha + j);
fmpz_mul_or_div_2exp(alpha + j, alpha + j, exp + prec);
j++;
}
}
balanced_product(coeffs, alpha, d, prec);
/* Scale and round */
for (i = 0; i < d + 1; i++)
{
slong r = d;
if ((n & (n - 1)) == 0)
r--;
fmpz_mul_2exp(coeffs + i, coeffs + i, r);
fmpz_add(coeffs + i, coeffs + i, half);
fmpz_fdiv_q_2exp(coeffs + i, coeffs + i, prec);
}
fmpz_clear(half);
mpfr_clear(t);
mpfr_clear(u);
_fmpz_vec_clear(alpha, d);
}
int
main (void)
{
mpfr_t x;
mpfr_init (x);
/* check +infinity gives non-zero for mpfr_inf_p only */
mpfr_set_ui (x, 1L, GMP_RNDZ);
mpfr_div_ui (x, x, 0L, GMP_RNDZ);
if (mpfr_nan_p (x)) {
fprintf (stderr, "Error: mpfr_nan_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0) {
fprintf (stderr, "Error: mpfr_inf_p(+Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x)) {
fprintf (stderr, "Error: mpfr_number_p(+Inf) gives non-zero\n");
exit (1);
}
/* same for -Inf */
mpfr_neg (x, x, GMP_RNDN);
if (mpfr_nan_p (x)) {
fprintf (stderr, "Error: mpfr_nan_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0) {
fprintf (stderr, "Error: mpfr_inf_p(-Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x)) {
fprintf (stderr, "Error: mpfr_number_p(-Inf) gives non-zero\n");
exit (1);
}
/* same for NaN */
mpfr_sub (x, x, x, GMP_RNDN);
if (mpfr_nan_p (x) == 0) {
fprintf (stderr, "Error: mpfr_nan_p(NaN) gives zero\n");
exit (1);
}
if (mpfr_inf_p (x)) {
fprintf (stderr, "Error: mpfr_inf_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x)) {
fprintf (stderr, "Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
/* same for an ordinary number */
mpfr_set_ui (x, 1, GMP_RNDN);
if (mpfr_nan_p (x)) {
fprintf (stderr, "Error: mpfr_nan_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x)) {
fprintf (stderr, "Error: mpfr_inf_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0) {
fprintf (stderr, "Error: mpfr_number_p(1) gives zero\n");
exit (1);
}
mpfr_clear (x);
return 0;
}
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity),
and return e such that the absolute error is bound by 2^e ulp(y) */
static mp_exp_t
mpfr_eint_aux (mpfr_t y, mpfr_srcptr x)
{
mpfr_t eps; /* dynamic (absolute) error bound on t */
mpfr_t erru, errs;
mpz_t m, s, t, u;
mp_exp_t e, sizeinbase;
mp_prec_t w = MPFR_PREC(y);
unsigned long k;
MPFR_GROUP_DECL (group);
/* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x)
where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2
thus |R(x)/x| <= |x|/2
thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */
if (MPFR_GET_EXP(x) <= - (mp_exp_t) w)
{
mpfr_set (y, x, GMP_RNDN);
return 0;
}
mpz_init (s); /* initializes to 0 */
mpz_init (t);
mpz_init (u);
mpz_init (m);
MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs);
e = mpfr_get_z_exp (m, x); /* x = m * 2^e */
MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x));
if (MPFR_PREC (x) > w)
{
e += MPFR_PREC (x) - w;
mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w);
}
/* remove trailing zeroes from m: this will speed up much cases where
x is a small integer divided by a power of 2 */
k = mpz_scan1 (m, 0);
mpz_tdiv_q_2exp (m, m, k);
e += k;
/* initialize t to 2^w */
mpz_set_ui (t, 1);
mpz_mul_2exp (t, t, w);
mpfr_set_ui (eps, 0, GMP_RNDN); /* eps[0] = 0 */
mpfr_set_ui (errs, 0, GMP_RNDN);
for (k = 1;; k++)
{
/* let eps[k] be the absolute error on t[k]:
since t[k] = trunc(t[k-1]*m*2^e/k), we have
eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k
= 1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k
= 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */
mpfr_mul_2ui (eps, eps, w - 1, GMP_RNDU);
mpfr_add_z (eps, eps, t, GMP_RNDU);
MPFR_MPZ_SIZEINBASE2 (sizeinbase, m);
mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_add_ui (eps, eps, 1, GMP_RNDU);
mpz_mul (t, t, m);
if (e < 0)
mpz_tdiv_q_2exp (t, t, -e);
else
mpz_mul_2exp (t, t, e);
mpz_tdiv_q_ui (t, t, k);
mpz_tdiv_q_ui (u, t, k);
mpz_add (s, s, u);
/* the absolute error on u is <= 1 + eps[k]/k */
mpfr_div_ui (erru, eps, k, GMP_RNDU);
mpfr_add_ui (erru, erru, 1, GMP_RNDU);
/* and that on s is the sum of all errors on u */
mpfr_add (errs, errs, erru, GMP_RNDU);
/* we are done when t is smaller than errs */
if (mpz_sgn (t) == 0)
sizeinbase = 0;
else
MPFR_MPZ_SIZEINBASE2 (sizeinbase, t);
if (sizeinbase < MPFR_GET_EXP (errs))
break;
}
/* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...)
<= (|t|+eps)/k*|x|/(k-|x|) */
mpz_abs (t, t);
mpfr_add_z (eps, eps, t, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_abs (erru, x, GMP_RNDU); /* |x| */
mpfr_mul (eps, eps, erru, GMP_RNDU);
mpfr_ui_sub (erru, k, erru, GMP_RNDD);
if (MPFR_IS_NEG (erru))
{
/* the truncated series does not converge, return fail */
e = w;
}
else
{
mpfr_div (eps, eps, erru, GMP_RNDU);
mpfr_add (errs, errs, eps, GMP_RNDU);
mpfr_set_z (y, s, GMP_RNDN);
mpfr_div_2ui (y, y, w, GMP_RNDN);
/* errs was an absolute error bound on s. We must convert it to an error
in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must
divide the error by 2^(EXP(y)-PREC(y)), but since we divided also
y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */
e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y);
}
MPFR_GROUP_CLEAR (group);
mpz_clear (s);
mpz_clear (t);
mpz_clear (u);
mpz_clear (m);
return e;
}
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;
tests_start_mpfr ();
mpfr_init (x);
/* check +infinity gives non-zero for mpfr_inf_p only */
mpfr_set_ui (x, 1L, MPFR_RNDZ);
mpfr_div_ui (x, x, 0L, MPFR_RNDZ);
if (mpfr_nan_p (x) || (mpfr_nan_p) (x) )
{
printf ("Error: mpfr_nan_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(+Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+Inf) gives non-zero\n");
exit (1);
}
/* same for -Inf */
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p(x)))
{
printf ("Error: mpfr_nan_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(-Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p)(x) )
{
printf ("Error: mpfr_number_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_zero_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-Inf) gives non-zero\n");
exit (1);
}
/* same for NaN */
mpfr_sub (x, x, x, MPFR_RNDN);
if (mpfr_nan_p (x) == 0)
{
printf ("Error: mpfr_nan_p(NaN) gives zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(NaN) gives non-zero\n");
exit (1);
}
/* same for a regular number */
mpfr_set_ui (x, 1, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(1) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) == 0 || (mpfr_regular_p) (x) == 0)
{
printf ("Error: mpfr_regular_p(1) gives zero\n");
exit (1);
}
/* Same for +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(+0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(+0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+0) gives non-zero\n");
exit (1);
}
/* Same for -0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(-0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(-0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-0) gives non-zero\n");
exit (1);
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x;
unsigned int i;
unsigned int prec[10] = {14, 15, 19, 22, 23, 24, 25, 40, 41, 52};
unsigned int prec2[10] = {4, 5, 6, 19, 70, 95, 100, 106, 107, 108};
tests_start_mpfr ();
check_nans ();
mpfr_init (x);
mpfr_set_prec (x, 2);
mpfr_set_str (x, "0.5", 10, MPFR_RNDN);
mpfr_tan (x, x, MPFR_RNDD);
if (mpfr_cmp_ui_2exp(x, 1, -1))
{
printf ("mpfr_tan(0.5, MPFR_RNDD) failed\n"
"expected 0.5, got");
mpfr_print_binary(x);
putchar('\n');
exit (1);
}
/* check that tan(3*Pi/4) ~ -1 */
for (i=0; i<10; i++)
{
mpfr_set_prec (x, prec[i]);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_ui (x, x, 3, MPFR_RNDN);
mpfr_div_ui (x, x, 4, MPFR_RNDN);
mpfr_tan (x, x, MPFR_RNDN);
if (mpfr_cmp_si (x, -1))
{
printf ("tan(3*Pi/4) fails for prec=%u\n", prec[i]);
exit (1);
}
}
/* check that tan(7*Pi/4) ~ -1 */
for (i=0; i<10; i++)
{
mpfr_set_prec (x, prec2[i]);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_ui (x, x, 7, MPFR_RNDN);
mpfr_div_ui (x, x, 4, MPFR_RNDN);
mpfr_tan (x, x, MPFR_RNDN);
if (mpfr_cmp_si (x, -1))
{
printf ("tan(3*Pi/4) fails for prec=%u\n", prec2[i]);
exit (1);
}
}
mpfr_clear (x);
test_generic (2, 100, 10);
data_check ("data/tan", mpfr_tan, "mpfr_tan");
bad_cases (mpfr_tan, mpfr_atan, "mpfr_tan", 256, -256, 255, 4, 128, 800, 40);
tests_end_mpfr ();
return 0;
}
static void
special (void)
{
mpfr_t x, y;
unsigned xprec, yprec;
mpfr_init (x);
mpfr_init (y);
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_ui (y, x, 3, MPFR_RNDN);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 100);
mpfr_urandomb (x, RANDS);
mpfr_div_ui (y, x, 123456, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_div_ui (y, x, 123456789, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0))
{
printf ("mpfr_div_ui gives non-zero for 0/ui\n");
exit (1);
}
/* bug found by Norbert Mueller, 21 Aug 2001 */
mpfr_set_prec (x, 110);
mpfr_set_prec (y, 60);
mpfr_set_str_binary (x, "0.110101110011111110011111001110011001110111000000111110001000111011000011E-44");
mpfr_div_ui (y, x, 17, MPFR_RNDN);
mpfr_set_str_binary (x, "0.11001010100101100011101110000001100001010110101001010011011E-48");
if (mpfr_cmp (x, y))
{
printf ("Error in x/17 for x=1/16!\n");
printf ("Expected ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\nGot ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* corner case */
mpfr_set_prec (x, 2 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_ui (x, 4, MPFR_RNDN);
mpfr_nextabove (x);
mpfr_div_ui (y, x, 2, MPFR_RNDN); /* exactly in the middle */
MPFR_ASSERTN(mpfr_cmp_ui (y, 2) == 0);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_nextabove (x);
mpfr_div_ui (y, x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_si (x, -4, MPFR_RNDN);
mpfr_nextbelow (x);
mpfr_div_ui (y, x, 2, MPFR_RNDD);
MPFR_ASSERTN(mpfr_cmp_si (y, -3) == 0);
for (xprec = 53; xprec <= 128; xprec++)
{
mpfr_set_prec (x, xprec);
mpfr_set_str_binary (x, "0.1100100100001111110011111000000011011100001100110111E2");
for (yprec = 53; yprec <= 128; yprec++)
{
mpfr_set_prec (y, yprec);
mpfr_div_ui (y, x, 1, MPFR_RNDN);
if (mpfr_cmp(x,y))
{
printf ("division by 1.0 fails for xprec=%u, yprec=%u\n", xprec, yprec);
printf ("expected "); mpfr_print_binary (x); puts ("");
printf ("got "); mpfr_print_binary (y); puts ("");
exit (1);
}
}
}
/* Bug reported by Mark Dickinson, 6 Nov 2007 */
mpfr_set_si (x, 0, MPFR_RNDN);
mpfr_set_si (y, -1, MPFR_RNDN);
mpfr_div_ui (y, x, 4, MPFR_RNDN);
MPFR_ASSERTN(MPFR_IS_ZERO(y) && MPFR_IS_POS(y));
mpfr_clear (x);
mpfr_clear (y);
}
int main (int argc, char *argv[]){
mpfr_t *lambda, *kappa;
char f_out_name[BUFSIZ];
int d,iters,n, k, nk,nf,na,nb;
double *lambdas, *kappas, *f,*a,*b;
param_file_type param[Nparam] =
{{"d:" , "%d", &d, NULL, sizeof(int)},
{"iter:" , "%d", &iters, NULL, sizeof(int)},
{"lambda:", "DATA_FILE", &lambdas, &n , sizeof(double)},
{"kappa:", "DATA_FILE", &kappas, &nk , sizeof(double)}, /*psi*/
{"h:", "DATA_FILE", &f, &nf , sizeof(double)}, /*odf*/
{"a:", "DATA_FILE", &a, &na , sizeof(double)}, /*pdf a*/
{"bc:", "DATA_FILE", &b, &nb , sizeof(double)}, /*pdf sqrt(b^2 + c^2)*/
{"res1:","%s ", &f_out_name,NULL, 0}};
FILE *f_param;
FILE *f_out;
if (argc<2) {
printf("Error! Missing parameter - parameter_file.\n");
printf("%s\n",argv[0]);
abort();
}
/* read parameter file */
f_param = check_fopen(argv[1],"r");
if (read_param_file(f_param,param,Nparam,argc==2)<Nparam){
/*printf("Some parameters not found!");*/
/*abort();*/
}
fclose(f_param);
/* precission & delta */
init_prec(d);
long int prec = d;
if (nk>0) { /* kappas given*/
mpfr_t C;
kappa = (mpfr_t*) malloc (nk*sizeof(mpfr_t));
for(k=0;k<nk;k++){
mpfr_init2(kappa[k],prec);
mpfr_init_set_d(kappa[k], kappas[k],prec);
}
mhyper(C, kappa, nk);
/* gmp_printf("C: %.*Fe \n ", 20, C); */
if (nf>0) /* eval odf values*/
{
eval_exp_Ah(C,f,nf);
f_out = check_fopen(f_out_name,"wb");
fwrite(f,sizeof(double),nf,f_out);
fclose(f_out);
}
if ( na > 0) {/* eval pdf values*/
/* testing BesselI[0,a]
mpfr_t in, out;
for(k=0;k<na;k++){
mpfr_init2(in, prec);
mpfr_set_d(in, a[k],prec);
mpfr_init2(out, prec);
mpfr_i0(out, in, prec);
mpfr_printf ("%.1028RNf\ndd", out);
a[k] = mpfr_get_d(out,prec);
}
f_out = check_fopen(f_out_name,"wb");
fwrite(a,sizeof(double),na,f_out);
fclose(f_out);
*/
eval_exp_besseli(a,b,C,na);
f_out = check_fopen(f_out_name,"wb");
fwrite(a,sizeof(double),na,f_out);
fclose(f_out);
}
if (nf == 0 && na == 0) { /* only return constant */
double CC = mpfr_get_d(C,prec);
f_out = check_fopen(f_out_name,"wb");
fwrite(&CC,sizeof(double),1,f_out);
fclose(f_out);
}
} else { /* solve kappas */
/* copy input variables */
lambda = (mpfr_t*) malloc (n*sizeof(mpfr_t));
kappa = (mpfr_t*) malloc (n*sizeof(mpfr_t));
for(k=0;k<n;k++){
mpfr_init_set_ui(kappa[k],0,prec);
mpfr_init_set_d(lambda[k],lambdas[k],prec);
}
if(iters>0){
/* check input */
mpfr_t tmp;
mpfr_init(tmp);
mpfr_set_d(tmp,0,prec);
for(k=0;k<n;k++){
mpfr_add(tmp,tmp,lambda[k],prec);
}
mpfr_ui_sub(tmp,1,tmp,prec);
mpfr_div_ui(tmp,tmp,n,prec);
for(k=0;k<n;k++){
mpfr_add(lambda[k],lambda[k],tmp,prec);
}
mpfr_init2(tmp,prec);
for(k=0;k<n;k++){
mpfr_add(tmp,tmp,lambda[k],prec);
}
mpfr_init2(tmp,prec);
if( mpfr_cmp(lambda[min_N(lambda,n)],tmp) < 0 ){
printf("not well formed! sum should be exactly 1 and no lambda negativ");
exit(0);
}
/* solve the problem */
newton(iters,kappa, lambda, n);
} else {
guessinitial(kappa, lambda, n);
}
for(k=0;k<n;k++){
lambdas[k] = mpfr_get_d(kappa[k],GMP_RNDN); /* something wents wront in matlab for 473.66316276431799;*/
/* % bug: lambda= [0.97 0.01 0.001];*/
}
f_out = check_fopen(f_out_name,"wb");
fwrite(lambdas,sizeof(double),n,f_out);
fclose(f_out);
free_N(lambda,n);
free_N(kappa,n);
}
return EXIT_SUCCESS;
}
int main(int argc, char **argv) {
mpfr_t tmp1;
mpfr_t tmp2;
mpfr_t tmp3;
mpfr_t s1;
mpfr_t s2;
mpfr_t r;
mpfr_t a1;
mpfr_t a2;
time_t start_time;
time_t end_time;
// Parse command line opts
int hide_pi = 0;
if(argc == 2) {
if(strcmp(argv[1], "--hide-pi") == 0) {
hide_pi = 1;
} else if((precision = atoi(argv[1])) == 0) {
fprintf(stderr, "Invalid precision specified. Aborting.\n");
return 1;
}
} else if(argc == 3) {
if(strcmp(argv[1], "--hide-pi") == 0) {
hide_pi = 1;
}
if((precision = atoi(argv[2])) == 0) {
fprintf(stderr, "Invalid precision specified. Aborting.\n");
return 1;
}
}
// If the precision was not specified, default it
if(precision == 0) {
precision = DEFAULT_PRECISION;
}
// Actual number of correct digits is roughly 3.35 times the requested precision
precision *= 3.35;
mpfr_set_default_prec(precision);
mpfr_inits(tmp1, tmp2, tmp3, s1, s2, r, a1, a2, NULL);
start_time = time(NULL);
// a0 = 1/3
mpfr_set_ui(a1, 1, MPFR_RNDN);
mpfr_div_ui(a1, a1, 3, MPFR_RNDN);
// s0 = (3^.5 - 1) / 2
mpfr_sqrt_ui(s1, 3, MPFR_RNDN);
mpfr_sub_ui(s1, s1, 1, MPFR_RNDN);
mpfr_div_ui(s1, s1, 2, MPFR_RNDN);
unsigned long i = 0;
while(i < MAX_ITERS) {
// r = 3 / (1 + 2(1-s^3)^(1/3))
mpfr_pow_ui(tmp1, s1, 3, MPFR_RNDN);
mpfr_ui_sub(r, 1, tmp1, MPFR_RNDN);
mpfr_root(r, r, 3, MPFR_RNDN);
mpfr_mul_ui(r, r, 2, MPFR_RNDN);
mpfr_add_ui(r, r, 1, MPFR_RNDN);
mpfr_ui_div(r, 3, r, MPFR_RNDN);
// s = (r - 1) / 2
mpfr_sub_ui(s2, r, 1, MPFR_RNDN);
mpfr_div_ui(s2, s2, 2, MPFR_RNDN);
// a = r^2 * a - 3^i(r^2-1)
mpfr_pow_ui(tmp1, r, 2, MPFR_RNDN);
mpfr_mul(a2, tmp1, a1, MPFR_RNDN);
mpfr_sub_ui(tmp1, tmp1, 1, MPFR_RNDN);
mpfr_ui_pow_ui(tmp2, 3UL, i, MPFR_RNDN);
mpfr_mul(tmp1, tmp1, tmp2, MPFR_RNDN);
mpfr_sub(a2, a2, tmp1, MPFR_RNDN);
// s1 = s2
mpfr_set(s1, s2, MPFR_RNDN);
// a1 = a2
mpfr_set(a1, a2, MPFR_RNDN);
i++;
}
// pi = 1/a
mpfr_ui_div(a2, 1, a2, MPFR_RNDN);
end_time = time(NULL);
mpfr_clears(tmp1, tmp2, tmp3, s1, s2, r, a1, NULL);
// Write the digits to a string for accuracy comparison
char *pi = malloc(precision + 100);
if(pi == NULL) {
fprintf(stderr, "Failed to allocated memory for output string.\n");
return 1;
}
mpfr_sprintf(pi, "%.*R*f", precision, MPFR_RNDN, a2);
// Check out accurate we are
unsigned long accuracy = check_digits(pi);
// Print the results (only print the digits that are accurate)
if(!hide_pi) {
// Plus two for the "3." at the beginning
for(unsigned long i=0; i<(unsigned long)(precision/3.35)+2; i++) {
printf("%c", pi[i]);
}
printf("\n");
} // Send the time and accuracy to stderr so pi can be redirected to a file if necessary
fprintf(stderr, "Time: %d seconds\nAccuracy: %lu digits\n", (int)(end_time - start_time), accuracy);
mpfr_clear(a2);
free(pi);
pi = NULL;
return 0;
}
static int
mpfr_all_div (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t r)
{
mpfr_t a2;
unsigned int oldflags, newflags;
int inex, inex2;
oldflags = __gmpfr_flags;
inex = mpfr_div (a, b, c, r);
if (a == b || a == c)
return inex;
newflags = __gmpfr_flags;
mpfr_init2 (a2, MPFR_PREC (a));
if (mpfr_integer_p (b) && ! (MPFR_IS_ZERO (b) && MPFR_IS_NEG (b)))
{
/* b is an integer, but not -0 (-0 is rejected as
it becomes +0 when converted to an integer). */
if (mpfr_fits_ulong_p (b, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_ui_div (a2, mpfr_get_ui (b, MPFR_RNDN), c, r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_ui_div", b, c, r);
}
if (mpfr_fits_slong_p (b, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_si_div (a2, mpfr_get_si (b, MPFR_RNDN), c, r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_si_div", b, c, r);
}
}
if (mpfr_integer_p (c) && ! (MPFR_IS_ZERO (c) && MPFR_IS_NEG (c)))
{
/* c is an integer, but not -0 (-0 is rejected as
it becomes +0 when converted to an integer). */
if (mpfr_fits_ulong_p (c, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_div_ui (a2, b, mpfr_get_ui (c, MPFR_RNDN), r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_div_ui", b, c, r);
}
if (mpfr_fits_slong_p (c, MPFR_RNDA))
{
__gmpfr_flags = oldflags;
inex2 = mpfr_div_si (a2, b, mpfr_get_si (c, MPFR_RNDN), r);
MPFR_ASSERTN (SAME_SIGN (inex2, inex));
MPFR_ASSERTN (__gmpfr_flags == newflags);
check_equal (a, a2, "mpfr_div_si", b, c, r);
}
}
mpfr_clear (a2);
return inex;
}
/* Put in s an approximation of digamma(x).
Assumes x >= 2.
Assumes s does not overlap with x.
Returns an integer e such that the error is bounded by 2^e ulps
of the result s.
*/
static mpfr_exp_t
mpfr_digamma_approx (mpfr_ptr s, mpfr_srcptr x)
{
mpfr_prec_t p = MPFR_PREC (s);
mpfr_t t, u, invxx;
mpfr_exp_t e, exps, f, expu;
mpz_t *INITIALIZED(B); /* variable B declared as initialized */
unsigned long n0, n; /* number of allocated B[] */
MPFR_ASSERTN(MPFR_IS_POS(x) && (MPFR_EXP(x) >= 2));
mpfr_init2 (t, p);
mpfr_init2 (u, p);
mpfr_init2 (invxx, p);
mpfr_log (s, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_ui_div (t, 1, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_div_2exp (t, t, 1, MPFR_RNDN); /* exact */
mpfr_sub (s, s, t, MPFR_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(olds)-EXP(s)) + 1/2*2^(EXP(t)-EXP(s)).
For x >= 2, log(x) >= 2*(1/(2x)), thus olds >= 2t, and olds - t >= olds/2,
thus 0 <= EXP(olds)-EXP(s) <= 1, and EXP(t)-EXP(s) <= 0, thus
error <= 1/2 + 1/2*2 + 1/2 <= 2 ulps. */
e = 2; /* initial error */
mpfr_mul (invxx, x, x, MPFR_RNDZ); /* invxx = x^2 * (1 + theta)
for |theta| <= 2^(-p) */
mpfr_ui_div (invxx, 1, invxx, MPFR_RNDU); /* invxx = 1/x^2 * (1 + theta)^2 */
/* in the following we note err=xxx when the ratio between the approximation
and the exact result can be written (1 + theta)^xxx for |theta| <= 2^(-p),
following Higham's method */
B = mpfr_bernoulli_internal ((mpz_t *) 0, 0);
mpfr_set_ui (t, 1, MPFR_RNDN); /* err = 0 */
for (n = 1;; n++)
{
/* compute next Bernoulli number */
B = mpfr_bernoulli_internal (B, n);
/* The main term is Bernoulli[2n]/(2n)/x^(2n) = B[n]/(2n+1)!(2n)/x^(2n)
= B[n]*t[n]/(2n) where t[n]/t[n-1] = 1/(2n)/(2n+1)/x^2. */
mpfr_mul (t, t, invxx, MPFR_RNDU); /* err = err + 3 */
mpfr_div_ui (t, t, 2 * n, MPFR_RNDU); /* err = err + 1 */
mpfr_div_ui (t, t, 2 * n + 1, MPFR_RNDU); /* err = err + 1 */
/* we thus have err = 5n here */
mpfr_div_ui (u, t, 2 * n, MPFR_RNDU); /* err = 5n+1 */
mpfr_mul_z (u, u, B[n], MPFR_RNDU); /* err = 5n+2, and the
absolute error is bounded
by 10n+4 ulp(u) [Rule 11] */
/* if the terms 'u' are decreasing by a factor two at least,
then the error coming from those is bounded by
sum((10n+4)/2^n, n=1..infinity) = 24 */
exps = mpfr_get_exp (s);
expu = mpfr_get_exp (u);
if (expu < exps - (mpfr_exp_t) p)
break;
mpfr_sub (s, s, u, MPFR_RNDN); /* error <= 24 + n/2 */
if (mpfr_get_exp (s) < exps)
e <<= exps - mpfr_get_exp (s);
e ++; /* error in mpfr_sub */
f = 10 * n + 4;
while (expu < exps)
{
f = (1 + f) / 2;
expu ++;
}
e += f; /* total rouding error coming from 'u' term */
}
n0 = ++n;
while (n--)
mpz_clear (B[n]);
(*__gmp_free_func) (B, n0 * sizeof (mpz_t));
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (invxx);
f = 0;
while (e > 1)
{
f++;
e = (e + 1) / 2;
/* Invariant: 2^f * e does not decrease */
}
return f;
}
/* compute in s an approximation of
S3 = c*sum((h(k)+h(n+k))*y^k/k!/(n+k)!,k=0..infinity)
where h(k) = 1 + 1/2 + ... + 1/k
k=0: h(n)
k=1: 1+h(n+1)
k=2: 3/2+h(n+2)
Returns e such that the error is bounded by 2^e ulp(s).
*/
static mpfr_exp_t
mpfr_yn_s3 (mpfr_ptr s, mpfr_srcptr y, mpfr_srcptr c, unsigned long n)
{
unsigned long k, zz;
mpfr_t t, u;
mpz_t p, q; /* p/q will store h(k)+h(n+k) */
mpfr_exp_t exps, expU;
zz = mpfr_get_ui (y, MPFR_RNDU); /* y = z^2/4 */
MPFR_ASSERTN (zz < ULONG_MAX - 2);
zz += 2; /* z^2 <= 2^zz */
mpz_init_set_ui (p, 0);
mpz_init_set_ui (q, 1);
/* initialize p/q to h(n) */
for (k = 1; k <= n; k++)
{
/* p/q + 1/k = (k*p+q)/(q*k) */
mpz_mul_ui (p, p, k);
mpz_add (p, p, q);
mpz_mul_ui (q, q, k);
}
mpfr_init2 (t, MPFR_PREC(s));
mpfr_init2 (u, MPFR_PREC(s));
mpfr_fac_ui (t, n, MPFR_RNDN);
mpfr_div (t, c, t, MPFR_RNDN); /* c/n! */
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (s, u, q, MPFR_RNDN);
exps = MPFR_EXP (s);
expU = exps;
for (k = 1; ;k ++)
{
/* update t */
mpfr_mul (t, t, y, MPFR_RNDN);
mpfr_div_ui (t, t, k, MPFR_RNDN);
mpfr_div_ui (t, t, n + k, MPFR_RNDN);
/* update p/q:
p/q + 1/k + 1/(n+k) = [p*k*(n+k) + q*(n+k) + q*k]/(q*k*(n+k)) */
mpz_mul_ui (p, p, k);
mpz_mul_ui (p, p, n + k);
mpz_addmul_ui (p, q, n + 2 * k);
mpz_mul_ui (q, q, k);
mpz_mul_ui (q, q, n + k);
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (u, u, q, MPFR_RNDN);
exps = MPFR_EXP (u);
if (exps > expU)
expU = exps;
mpfr_add (s, s, u, MPFR_RNDN);
exps = MPFR_EXP (s);
if (exps > expU)
expU = exps;
if (MPFR_EXP (u) + (mpfr_exp_t) MPFR_PREC (u) < MPFR_EXP (s) &&
zz / (2 * k) < k + n)
break;
}
mpfr_clear (t);
mpfr_clear (u);
mpz_clear (p);
mpz_clear (q);
exps = expU - MPFR_EXP (s);
/* the error is bounded by (6k^2+33/2k+11) 2^exps ulps
<= 8*(k+2)^2 2^exps ulps */
return 3 + 2 * MPFR_INT_CEIL_LOG2(k + 2) + exps;
}
int
main (void)
{
mpfr_prec_t prec;
mpfr_t x, y;
intmax_t s;
uintmax_t u;
tests_start_mpfr ();
for (u = MPFR_UINTMAX_MAX, prec = 0; u != 0; u /= 2, prec++)
{ }
mpfr_init2 (x, prec + 4);
mpfr_init2 (y, prec + 4);
mpfr_set_ui (x, 0, MPFR_RNDN);
check_sj (0, x);
check_uj (0, x);
mpfr_set_ui (x, 1, MPFR_RNDN);
check_sj (1, x);
check_uj (1, x);
mpfr_neg (x, x, MPFR_RNDN);
check_sj (-1, x);
mpfr_set_si_2exp (x, 1, prec, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN); /* UINTMAX_MAX */
mpfr_div_ui (y, x, 2, MPFR_RNDZ);
mpfr_trunc (y, y); /* INTMAX_MAX */
for (s = MPFR_INTMAX_MAX; s != 0; s /= 17)
{
check_sj (s, y);
mpfr_div_ui (y, y, 17, MPFR_RNDZ);
mpfr_trunc (y, y);
}
mpfr_div_ui (y, x, 2, MPFR_RNDZ);
mpfr_trunc (y, y); /* INTMAX_MAX */
mpfr_neg (y, y, MPFR_RNDN);
if (MPFR_INTMAX_MIN + MPFR_INTMAX_MAX != 0)
mpfr_sub_ui (y, y, 1, MPFR_RNDN); /* INTMAX_MIN */
for (s = MPFR_INTMAX_MIN; s != 0; s /= 17)
{
check_sj (s, y);
mpfr_div_ui (y, y, 17, MPFR_RNDZ);
mpfr_trunc (y, y);
}
for (u = MPFR_UINTMAX_MAX; u != 0; u /= 17)
{
check_uj (u, x);
mpfr_div_ui (x, x, 17, MPFR_RNDZ);
mpfr_trunc (x, x);
}
mpfr_clear (x);
mpfr_clear (y);
check_erange ();
tests_end_mpfr ();
return 0;
}
static void
test_grandom (long nbtests, mpfr_prec_t prec, mpfr_rnd_t rnd,
int verbose)
{
mpfr_t *t;
mpfr_t av, va, tmp;
int i, inexact;
nbtests = (nbtests & 1) ? (nbtests + 1) : nbtests;
t = (mpfr_t *) malloc (nbtests * sizeof (mpfr_t));
if (t == NULL)
{
fprintf (stderr, "tgrandom: can't allocate memory in test_grandom\n");
exit (1);
}
for (i = 0; i < nbtests; ++i)
mpfr_init2 (t[i], prec);
for (i = 0; i < nbtests; i += 2)
{
inexact = mpfr_grandom (t[i], t[i + 1], RANDS, MPFR_RNDN);
if ((inexact & 3) == 0 || (inexact & (3 << 2)) == 0)
{
/* one call in the loop pretended to return an exact number! */
printf ("Error: mpfr_grandom() returns a zero ternary value.\n");
exit (1);
}
}
#ifdef HAVE_STDARG
if (verbose)
{
mpfr_init2 (av, prec);
mpfr_init2 (va, prec);
mpfr_init2 (tmp, prec);
mpfr_set_ui (av, 0, MPFR_RNDN);
mpfr_set_ui (va, 0, MPFR_RNDN);
for (i = 0; i < nbtests; ++i)
{
mpfr_add (av, av, t[i], MPFR_RNDN);
mpfr_sqr (tmp, t[i], MPFR_RNDN);
mpfr_add (va, va, tmp, MPFR_RNDN);
}
mpfr_div_ui (av, av, nbtests, MPFR_RNDN);
mpfr_div_ui (va, va, nbtests, MPFR_RNDN);
mpfr_sqr (tmp, av, MPFR_RNDN);
mpfr_sub (va, va, av, MPFR_RNDN);
mpfr_printf ("Average = %.5Rf\nVariance = %.5Rf\n", av, va);
mpfr_clear (av);
mpfr_clear (va);
mpfr_clear (tmp);
}
#endif /* HAVE_STDARG */
for (i = 0; i < nbtests; ++i)
mpfr_clear (t[i]);
free (t);
return;
}
