static void
check_nans (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
/* 1 - nan == nan */
mpfr_set_nan (x);
mpfr_ui_sub (y, 1L, x, GMP_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y));
/* 1 - +inf == -inf */
mpfr_set_inf (x, 1);
mpfr_ui_sub (y, 1L, x, GMP_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
/* 1 - -inf == +inf */
mpfr_set_inf (x, -1);
mpfr_ui_sub (y, 1L, x, GMP_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) > 0);
mpfr_clear (x);
mpfr_clear (y);
}
void Compute(gmp_randstate_t r) const {
// The algorithm is sample x and z from the exponential distribution; if
// (x-1)^2 < 2*z, return (random sign)*x; otherwise repeat. Probability
// of acceptance is sqrt(pi/2) * exp(-1/2) = 0.7602.
while (true) {
_edist(_x, r);
_edist(_z, r);
for (mp_size_t k = 1; ; ++k) {
_x.ExpandTo(r, k - 1);
_z.ExpandTo(r, k - 1);
mpfr_prec_t prec = std::max(mpfr_prec_t(MPFR_PREC_MIN), k * bits);
mpfr_set_prec(_xf, prec);
mpfr_set_prec(_zf, prec);
// Try for acceptance first; so compute upper limit on (y-1)^2 and
// lower limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDD);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDU);
} else {
_x(_xf, MPFR_RNDU);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDU);
}
mpfr_sqr(_xf, _xf, MPFR_RNDU);
_z(_zf, MPFR_RNDD);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDD);
if (mpfr_cmp(_xf, _zf) < 0) { // (y-1)^2 < 2*z, so accept
if (_x.Boolean(r)) _x.Negate(); // include a random sign
return;
}
// Try for rejection; so compute lower limit on (y-1)^2 and upper
// limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDU);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDD);
} else {
_x(_xf, MPFR_RNDD);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDD);
}
mpfr_sqr(_xf, _xf, MPFR_RNDD);
_z(_zf, MPFR_RNDU);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDU);
if (mpfr_cmp(_xf, _zf) > 0) // (y-1)^2 > 2*z, so reject
break;
// Otherwise repeat with more precision
}
// Reject and start over with a new y and z
}
}
int
main (int argc, char *argv[])
{
int i;
mpfr_t x;
tests_start_mpfr ();
check_nans ();
/* check against values given by sinh(x), cosh(x) */
mpfr_init2 (x, 53);
mpfr_set_str (x, "FEDCBA987654321p-48", 16, MPFR_RNDN);
for (i = 0; i < 10; ++i)
{
/* x = i - x / 2 : boggle sign and bits */
mpfr_ui_sub (x, i, x, MPFR_RNDD);
mpfr_div_2ui (x, x, 2, MPFR_RNDD);
check (x, MPFR_RNDN);
check (x, MPFR_RNDU);
check (x, MPFR_RNDD);
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
/* Function to calculate the probability of joint
occurance of input class sx and output class sy */
void scjoint(mpfr_t *distptr, int mu, int gamma, int psiz, int conns, int phi, mpfr_t *bcs,mpfr_t *binpdf,mpfr_t *pp,mpfr_prec_t prec)
{
int dini=conns;
int dmax=conns;
mpfr_t poff;
mpfr_init2(poff,prec);
mpfr_t bcf;
mpfr_init2(bcf,prec);
mpfr_t f1;
mpfr_init2(f1,prec);
mpfr_t f2;
mpfr_init2(f2,prec);
mpfr_t f3;
mpfr_init2(f3,prec);
unsigned int i;
unsigned int d;
// unsigned int phi;
unsigned int sy;
unsigned int sx;
unsigned int pdex;
int done=gamma+1;
int dist_dex=0;
int ppdex=0;
int bdex;
for(pdex=0;pdex<=psiz-1;pdex++)
{
for(d=dini;d<=dmax;d++)
{
// for(phi=1;phi<=d;phi++)
// {
for(sx=0;sx<=mu;sx++)
{
mpfr_ui_sub(poff,(unsigned long int)1,*(pp+ppdex),MPFR_RNDN);
bdex=pdex*(mu+1)+sx;
for(sy=0;sy<=gamma;sy++)
{
mpfr_mul(f1,*(binpdf+bdex),*(bcs+sy),MPFR_RNDN);
mpfr_pow_ui(f2,*(pp+ppdex),(unsigned long int)sy,MPFR_RNDN);
mpfr_pow_ui(f3,poff,(unsigned long int)(gamma-sy),MPFR_RNDN);
mpfr_mul(f1,f1,f2,MPFR_RNDN);
mpfr_mul(*(distptr+dist_dex),f1,f3,MPFR_RNDN);
dist_dex++;
}
ppdex++;
}
// }
}
ppdex=0;
}
mpfr_clear(poff);
mpfr_clear(bcf);
mpfr_clear(f1);
mpfr_clear(f2);
mpfr_clear(f3);
}
/* Check mpfr_ui_sub with u = 0 (unsigned). */
static void check_neg (void)
{
mpfr_t x, yneg, ysub;
int i, s;
int r;
mpfr_init2 (x, 64);
mpfr_init2 (yneg, 32);
mpfr_init2 (ysub, 32);
for (i = 0; i <= 25; i++)
{
mpfr_sqrt_ui (x, i, MPFR_RNDN);
for (s = 0; s <= 1; s++)
{
RND_LOOP (r)
{
int tneg, tsub;
tneg = mpfr_neg (yneg, x, (mpfr_rnd_t) r);
tsub = mpfr_ui_sub (ysub, 0, x, (mpfr_rnd_t) r);
MPFR_ASSERTN (mpfr_equal_p (yneg, ysub));
MPFR_ASSERTN (!(MPFR_IS_POS (yneg) ^ MPFR_IS_POS (ysub)));
MPFR_ASSERTN (tneg == tsub);
}
mpfr_neg (x, x, MPFR_RNDN);
}
}
mpfr_clear (x);
mpfr_clear (yneg);
mpfr_clear (ysub);
}
void mpfr_taylor_nat_log(mpfr_t R, mpfr_t x, mpz_t n)
{
assert(mpz_cmp_ui(n, 0) > 0);
assert(mpfr_cmp_ui(x, 0) > 0);
mpfr_t a, t, tt;
mpfr_exp_t b;
mpz_t k;
unsigned int f = 1000, F = 1000;
mpfr_init(a);
mpfr_frexp(&b, a, x, MPFR_RNDN);
mpfr_ui_sub(a, 1, a, MPFR_RNDN);
mpfr_init_set(t, a, MPFR_RNDN);
mpfr_init(tt);
mpfr_set(R, a, MPFR_RNDN);
for(mpz_init_set_ui(k, 2); mpz_cmp(k, n) < 0; mpz_add_ui(k, k, 1))
{
mpfr_mul(t, t, a, MPFR_RNDN);
mpfr_div_z(tt, t, k, MPFR_RNDN);
mpfr_add(R, R, tt, MPFR_RNDN);
}
mpfr_mul_si(a, MPFR_NAT_LOG_2, b, MPFR_RNDN);
mpfr_sub(R, a, R, MPFR_RNDN);
}
int
mpfr_si_sub (mpfr_ptr y, long int u, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
if (u >= 0)
return mpfr_ui_sub (y, u, x, rnd_mode);
else
{
int res = -mpfr_add_ui (y, x, -u, MPFR_INVERT_RND (rnd_mode));
MPFR_CHANGE_SIGN (y);
return res;
}
}
/* 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);
}
int
mpfi_ui_sub (mpfi_ptr a, const unsigned long b, mpfi_srcptr c)
{
int inexact_left, inexact_right, inexact=0;
mpfr_t tmp;
if (MPFI_IS_ZERO (c)) {
return (mpfi_set_ui (a, b));
}
else if (b == 0) {
return (mpfi_neg (a, c));
}
else {
mpfr_init2 (tmp, mpfr_get_prec (&(a->left)));
inexact_left = mpfr_ui_sub (tmp, b, &(c->right), MPFI_RNDD);
inexact_right = mpfr_ui_sub (&(a->right), b, &(c->left), MPFI_RNDU);
mpfr_set (&(a->left), tmp, MPFI_RNDD); /* exact */
mpfr_clear (tmp);
/* do not allow -0 as lower bound */
if (mpfr_zero_p (&(a->left)) && mpfr_signbit (&(a->left))) {
mpfr_neg (&(a->left), &(a->left), MPFI_RNDU);
}
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(a->right)) && !mpfr_signbit (&(a->right))) {
mpfr_neg (&(a->right), &(a->right), MPFI_RNDD);
}
if (MPFI_NAN_P (a))
MPFR_RET_NAN;
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
return inexact;
}
}
/* basic constructor for cb_context */
cb_context context_construct(long n_Max, mpfr_prec_t prec, int lambda){
cb_context result;
result.n_Max = n_Max;
result.prec = prec;
result.rnd = MPFR_RNDN;
result.rho_to_z_matrix = compute_rho_to_z_matrix(lambda,prec);
result.lambda = lambda;
mpfr_init2(result.rho, prec);
mpfr_set_ui(result.rho,8, MPFR_RNDN);
mpfr_sqrt(result.rho,result.rho,MPFR_RNDN);
mpfr_ui_sub(result.rho,3,result.rho,MPFR_RNDN);
return result;
}
/* checks that (y-x) gives the right results with 53 bits of precision */
static void
check (unsigned long y, const char *xs, mp_rnd_t rnd_mode, const char *zs)
{
mpfr_t xx, zz;
mpfr_inits2 (53, xx, zz, NULL);
mpfr_set_str1 (xx, xs);
mpfr_ui_sub (zz, y, xx, rnd_mode);
if (mpfr_cmp_str1 (zz, zs) )
{
printf ("expected difference is %s, got\n",zs);
mpfr_out_str(stdout, 10, 0, zz, GMP_RNDN);
printf ("mpfr_ui_sub failed for y=%lu x=%s with rnd_mode=%s\n",
y, xs, mpfr_print_rnd_mode (rnd_mode));
exit (1);
}
mpfr_clears (xx, zz, NULL);
}
/* return add = 1 + floor(log(c^3*(13+m1))/log(2))
where c = (1+eps)*(1+eps*max(8,m1)),
m1 = 1 + max(1/eps,2*sd)*(1+eps),
eps = 2^(-precz-14)
sd = abs(s-1)
*/
static long
compute_add (mpfr_srcptr s, mpfr_prec_t precz)
{
mpfr_t t, u, m1;
long add;
mpfr_inits2 (64, t, u, m1, (mpfr_ptr) 0);
if (mpfr_cmp_ui (s, 1) >= 0)
mpfr_sub_ui (t, s, 1, MPFR_RNDU);
else
mpfr_ui_sub (t, 1, s, MPFR_RNDU);
/* now t = sd = abs(s-1), rounded up */
mpfr_set_ui_2exp (u, 1, - precz - 14, MPFR_RNDU);
/* u = eps */
/* since 1/eps = 2^(precz+14), if EXP(sd) >= precz+14, then
sd >= 1/2*2^(precz+14) thus 2*sd >= 2^(precz+14) >= 1/eps */
if (mpfr_get_exp (t) >= precz + 14)
mpfr_mul_2exp (t, t, 1, MPFR_RNDU);
else
mpfr_set_ui_2exp (t, 1, precz + 14, MPFR_RNDU);
/* now t = max(1/eps,2*sd) */
mpfr_add_ui (u, u, 1, MPFR_RNDU); /* u = 1+eps, rounded up */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = max(1/eps,2*sd)*(1+eps) */
mpfr_add_ui (m1, t, 1, MPFR_RNDU);
if (mpfr_get_exp (m1) <= 3)
mpfr_set_ui (t, 8, MPFR_RNDU);
else
mpfr_set (t, m1, MPFR_RNDU);
/* now t = max(8,m1) */
mpfr_div_2exp (t, t, precz + 14, MPFR_RNDU); /* eps*max(8,m1) */
mpfr_add_ui (t, t, 1, MPFR_RNDU); /* 1+eps*max(8,m1) */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = c */
mpfr_add_ui (u, m1, 13, MPFR_RNDU); /* 13+m1 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c*(13+m1) */
mpfr_sqr (t, t, MPFR_RNDU); /* c^2 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c^3*(13+m1) */
add = mpfr_get_exp (u);
mpfr_clears (t, u, m1, (mpfr_ptr) 0);
return add;
}
/* if u = o(x-y), v = o(u-x), w = o(v+y), then x-y = u-w */
static void
check_two_sum (mp_prec_t p)
{
unsigned int x;
mpfr_t y, u, v, w;
mp_rnd_t rnd;
int inexact;
mpfr_inits2 (p, y, u, v, w, NULL);
do
{
x = randlimb ();
}
while (x < 1);
mpfr_random (y);
rnd = GMP_RNDN;
inexact = mpfr_ui_sub (u, x, y, rnd);
mpfr_sub_ui (v, u, x, rnd);
mpfr_add (w, v, y, rnd);
/* as u = (x-y) + w, we should have inexact and w of same sign */
if (((inexact == 0) && mpfr_cmp_ui (w, 0)) ||
((inexact > 0) && (mpfr_cmp_ui (w, 0) <= 0)) ||
((inexact < 0) && (mpfr_cmp_ui (w, 0) >= 0)))
{
printf ("Wrong inexact flag for prec=%u, rnd=%s\n",
(unsigned int) p, mpfr_print_rnd_mode (rnd));
printf ("x=%u\n", x);
printf ("y="); mpfr_print_binary(y); puts ("");
printf ("u="); mpfr_print_binary(u); puts ("");
printf ("v="); mpfr_print_binary(v); puts ("");
printf ("w="); mpfr_print_binary(w); puts ("");
printf ("inexact = %d\n", inexact);
exit (1);
}
mpfr_clears (y, u, v, w, NULL);
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact
ie, iff x = 0 */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mp_prec_t prec, m;
int neg, reduce;
mpfr_t c, xr;
mpfr_srcptr xx;
mp_exp_t err, expx;
MPFR_ZIV_DECL (loop);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN (y);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
/* y = 0, thus exact, but z is inexact in case of underflow
or overflow */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("sin[%#R]=%R cos[%#R]=%R", y, y, z, z));
prec = MAX (MPFR_PREC (y), MPFR_PREC (z));
m = prec + MPFR_INT_CEIL_LOG2 (prec) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* the following is copied from sin.c */
if (expx >= 2) /* reduce the argument */
{
reduce = 1;
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN);
mpfr_remainder (xr, x, c, GMP_RNDN);
mpfr_div_2ui (c, c, 1, GMP_RNDN);
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, GMP_RNDZ);
else
mpfr_add (c, c, xr, GMP_RNDZ);
if (MPFR_IS_ZERO(xr) || MPFR_EXP(xr) < (mp_exp_t) 3 - (mp_exp_t) m
|| MPFR_EXP(c) < (mp_exp_t) 3 - (mp_exp_t) m)
goto next_step;
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
neg = MPFR_IS_NEG (xx); /* gives sign of sin(x) */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, GMP_RNDZ);
/* If no argument reduction was performed, the error is at most ulp(c),
otherwise it is at most ulp(c) + 2^(2-m). Since |c| < 1, we have
ulp(c) <= 2^(-m), thus the error is bounded by 2^(3-m) in that later
case. */
if (reduce == 0)
err = m;
else
err = MPFR_GET_EXP (c) + (mp_exp_t) (m - 3);
if (!mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (z) + (rnd_mode == GMP_RNDN)))
goto next_step;
mpfr_set (z, c, rnd_mode);
mpfr_sqr (c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
err = 2 + (- MPFR_GET_EXP (c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
MPFR_CHANGE_SIGN (c);
/* the absolute error on c is at most 2^(err-m), which we must put
in the form 2^(EXP(c)-err). If there was an argument reduction,
we need to add 2^(2-m); since err >= 2, the error is bounded by
2^(err+1-m) in that case. */
err = MPFR_GET_EXP (c) + (mp_exp_t) m - (err + reduce);
if (mpfr_can_round (c, err, GMP_RNDN, rnd_mode,
MPFR_PREC (y) + (rnd_mode == GMP_RNDN)))
break;
/* check for huge cancellation */
if (err < (mp_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1
&& MPFR_MANT (c)[MPFR_LIMB_SIZE (c)-1] == MPFR_LIMB_HIGHBIT)
m += m;
next_step:
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (c, m);
}
MPFR_ZIV_FREE (loop);
mpfr_set (y, c, rnd_mode);
mpfr_clear (c);
mpfr_clear (xr);
MPFR_RET (1); /* Always inexact */
}
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);
}
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp;
int compared, inexact;
mpfr_prec_t prec;
mpfr_exp_t xp_exp;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (
("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("asin[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (asin), mpfr_log_prec, asin,
inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (asin);
MPFR_RET_NAN;
}
else /* x = 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (asin);
MPFR_SET_SAME_SIGN (asin, x);
MPFR_RET (0); /* exact result */
}
}
/* asin(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (asin, x, -2 * MPFR_GET_EXP (x), 2, 1,
rnd_mode, {});
/* Set x_p=|x| (x is a normal number) */
mpfr_init2 (xp, MPFR_PREC (x));
inexact = mpfr_abs (xp, x, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
compared = mpfr_cmp_ui (xp, 1);
MPFR_SAVE_EXPO_MARK (expo);
if (MPFR_UNLIKELY (compared >= 0))
{
mpfr_clear (xp);
if (compared > 0) /* asin(x) = NaN for |x| > 1 */
{
MPFR_SAVE_EXPO_FREE (expo);
MPFR_SET_NAN (asin);
MPFR_RET_NAN;
}
else /* x = 1 or x = -1 */
{
if (MPFR_IS_POS (x)) /* asin(+1) = Pi/2 */
inexact = mpfr_const_pi (asin, rnd_mode);
else /* asin(-1) = -Pi/2 */
{
inexact = -mpfr_const_pi (asin, MPFR_INVERT_RND(rnd_mode));
MPFR_CHANGE_SIGN (asin);
}
mpfr_div_2ui (asin, asin, 1, rnd_mode);
}
}
else
{
/* Compute exponent of 1 - ABS(x) */
mpfr_ui_sub (xp, 1, xp, MPFR_RNDD);
MPFR_ASSERTD (MPFR_GET_EXP (xp) <= 0);
MPFR_ASSERTD (MPFR_GET_EXP (x) <= 0);
xp_exp = 2 - MPFR_GET_EXP (xp);
/* Set up initial prec */
prec = MPFR_PREC (asin) + 10 + xp_exp;
/* use asin(x) = atan(x/sqrt(1-x^2)) */
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (xp, prec);
mpfr_sqr (xp, x, MPFR_RNDN);
mpfr_ui_sub (xp, 1, xp, MPFR_RNDN);
mpfr_sqrt (xp, xp, MPFR_RNDN);
mpfr_div (xp, x, xp, MPFR_RNDN);
mpfr_atan (xp, xp, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (xp, prec - xp_exp,
MPFR_PREC (asin), rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (asin, xp, rnd_mode);
mpfr_clear (xp);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (asin, inexact, rnd_mode);
}
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mp_rnd_t rnd_mode)
{
int inexact = 0;
mpfr_t x;
mp_prec_t Nx = MPFR_PREC(xt); /* Precision of input variable */
/* Special cases */
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(xt) ))
{
/* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
between -1 and 1 */
if (MPFR_IS_NAN(xt) || MPFR_IS_INF(xt))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else /* necessarily xt is 0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(xt));
MPFR_SET_ZERO(y); /* atanh(0) = 0 */
MPFR_SET_SAME_SIGN(y,xt);
MPFR_RET(0);
}
}
/* Useless due to final mpfr_set
MPFR_CLEAR_FLAGS(y);*/
/* atanh(x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
if (MPFR_EXP(xt) > 0)
{
if (MPFR_EXP(xt) == 1 && mpfr_powerof2_raw (xt))
{
MPFR_SET_INF(y);
MPFR_SET_SAME_SIGN(y, xt);
MPFR_RET(0);
}
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
mpfr_init2 (x, Nx);
mpfr_abs (x, xt, GMP_RNDN);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te,ti;
/* Declaration of the size variable */
mp_prec_t Nx = MPFR_PREC(x); /* Precision of input variable */
mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
/* compute the precision of intermediary variable */
Nt=MAX(Nx,Ny);
/* the optimal number of bits : see algorithms.ps */
Nt=Nt+4+__gmpfr_ceil_log2(Nt);
/* initialise of intermediary variable */
mpfr_init(t);
mpfr_init(te);
mpfr_init(ti);
/* First computation of cosh */
do
{
/* reactualisation of the precision */
mpfr_set_prec(t,Nt);
mpfr_set_prec(te,Nt);
mpfr_set_prec(ti,Nt);
/* compute atanh */
mpfr_ui_sub(te,1,x,GMP_RNDU); /* (1-xt)*/
mpfr_add_ui(ti,x,1,GMP_RNDD); /* (xt+1)*/
mpfr_div(te,ti,te,GMP_RNDN); /* (1+xt)/(1-xt)*/
mpfr_log(te,te,GMP_RNDN); /* ln((1+xt)/(1-xt))*/
mpfr_div_2ui(t,te,1,GMP_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/
/* error estimate see- algorithms.ps*/
/* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
/* actualisation of the precision */
Nt += 10;
}
while ((err < 0) || (!mpfr_can_round (t, err, GMP_RNDN, GMP_RNDZ,
Ny + (rnd_mode == GMP_RNDN))
|| MPFR_IS_ZERO(t)));
if (MPFR_IS_NEG(xt))
MPFR_CHANGE_SIGN(t);
inexact = mpfr_set (y, t, rnd_mode);
mpfr_clear(t);
mpfr_clear(ti);
mpfr_clear(te);
}
mpfr_clear(x);
return inexact;
}
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;
}
/* Use the reflection formula Digamma(1-x) = Digamma(x) + Pi * cot(Pi*x),
i.e., Digamma(x) = Digamma(1-x) - Pi * cot(Pi*x).
Assume x < 1/2. */
static int
mpfr_digamma_reflection (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t p = MPFR_PREC(y) + 10, q;
mpfr_t t, u, v;
mpfr_exp_t e1, expv;
int inex;
MPFR_ZIV_DECL (loop);
/* we want that 1-x is exact with precision q: if 0 < x < 1/2, then
q = PREC(x)-EXP(x) is ok, otherwise if -1 <= x < 0, q = PREC(x)-EXP(x)
is ok, otherwise for x < -1, PREC(x) is ok if EXP(x) <= PREC(x),
otherwise we need EXP(x) */
if (MPFR_EXP(x) < 0)
q = MPFR_PREC(x) + 1 - MPFR_EXP(x);
else if (MPFR_EXP(x) <= MPFR_PREC(x))
q = MPFR_PREC(x) + 1;
else
q = MPFR_EXP(x);
mpfr_init2 (u, q);
MPFR_DBGRES(inex = mpfr_ui_sub (u, 1, x, MPFR_RNDN));
MPFR_ASSERTN(inex == 0);
/* if x is half an integer, cot(Pi*x) = 0, thus Digamma(x) = Digamma(1-x) */
mpfr_mul_2exp (u, u, 1, MPFR_RNDN);
inex = mpfr_integer_p (u);
mpfr_div_2exp (u, u, 1, MPFR_RNDN);
if (inex)
{
inex = mpfr_digamma (y, u, rnd_mode);
goto end;
}
mpfr_init2 (t, p);
mpfr_init2 (v, p);
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mpfr_const_pi (v, MPFR_RNDN); /* v = Pi*(1+theta) for |theta|<=2^(-p) */
mpfr_mul (t, v, x, MPFR_RNDN); /* (1+theta)^2 */
e1 = MPFR_EXP(t) - (mpfr_exp_t) p + 1; /* bound for t: err(t) <= 2^e1 */
mpfr_cot (t, t, MPFR_RNDN);
/* cot(t * (1+h)) = cot(t) - theta * (1 + cot(t)^2) with |theta|<=t*h */
if (MPFR_EXP(t) > 0)
e1 = e1 + 2 * MPFR_EXP(t) + 1;
else
e1 = e1 + 1;
/* now theta * (1 + cot(t)^2) <= 2^e1 */
e1 += (mpfr_exp_t) p - MPFR_EXP(t); /* error is now 2^e1 ulps */
mpfr_mul (t, t, v, MPFR_RNDN);
e1 ++;
mpfr_digamma (v, u, MPFR_RNDN); /* error <= 1/2 ulp */
expv = MPFR_EXP(v);
mpfr_sub (v, v, t, MPFR_RNDN);
if (MPFR_EXP(v) < MPFR_EXP(t))
e1 += MPFR_EXP(t) - MPFR_EXP(v); /* scale error for t wrt new v */
/* now take into account the 1/2 ulp error for v */
if (expv - MPFR_EXP(v) - 1 > e1)
e1 = expv - MPFR_EXP(v) - 1;
else
e1 ++;
e1 ++; /* rounding error for mpfr_sub */
if (MPFR_CAN_ROUND (v, p - e1, MPFR_PREC(y), rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (t, p);
mpfr_set_prec (v, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (y, v, rnd_mode);
mpfr_clear (t);
mpfr_clear (v);
end:
mpfr_clear (u);
return inex;
}
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t x, t, te;
mpfr_prec_t Nx, Ny, Nt;
mpfr_exp_t err;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
/* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
between -1 and 1 */
if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else /* necessarily xt is 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* atanh(0) = 0 */
MPFR_SET_SAME_SIGN (y,xt);
MPFR_RET (0);
}
}
/* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0))
{
if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
mpfr_set_divby0 ();
MPFR_RET (0);
}
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
Nx = MPFR_PREC (xt);
MPFR_TMP_INIT_ABS (x, xt);
Ny = MPFR_PREC (y);
Nt = MAX (Nx, Ny);
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
mpfr_init2 (te, Nt);
/* First computation of cosh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute atanh */
mpfr_ui_sub (te, 1, x, MPFR_RNDU); /* (1-xt)*/
mpfr_add_ui (t, x, 1, MPFR_RNDD); /* (xt+1)*/
mpfr_div (t, t, te, MPFR_RNDN); /* (1+xt)/(1-xt)*/
mpfr_log (t, t, MPFR_RNDN); /* ln((1+xt)/(1-xt))*/
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/
/* error estimate: see algorithms.tex */
/* FIXME: this does not correspond to the value in algorithms.tex!!! */
/* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
if (MPFR_LIKELY (MPFR_IS_ZERO (t)
|| MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* reactualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
mpfr_set_prec (te, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
mpfr_clear(t);
mpfr_clear(te);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int s_re;
int s_im;
int inex_re;
int inex_im;
int inex;
inex_re = 0;
inex_im = 0;
s_re = mpfr_signbit (mpc_realref (op));
s_im = mpfr_signbit (mpc_imagref (op));
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_nan_p (mpc_realref (op)))
{
mpfr_set_nan (mpc_realref (rop));
if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
mpfr_set_nan (mpc_imagref (rop));
}
else
{
if (mpfr_inf_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int cmp_1;
if (s_im)
cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
else
cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);
if (cmp_1 < 0)
{
/* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s_re)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else if (cmp_1 == 0)
{
/* atan(+/-0+i) = NaN +i*inf
atan(+/-0-i) = NaN -i*inf */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
}
else
{
/* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
mpfr_rnd_t rnd_im, rnd_away;
mpfr_t y;
mpfr_prec_t p, p_im;
int ok;
rnd_im = MPC_RND_IM (rnd);
mpfr_init (y);
p_im = mpfr_get_prec (mpc_imagref (rop));
p = p_im;
/* a = o(1/y) with error(a) < 1 ulp(a)
b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)
As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
2 bits of precision are lost.
We round atanh(1/y) away from 0.
*/
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (y, p);
rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
/* FIXME: should we consider the case with unreasonably huge
precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
representable while 1/Im(op) underflows ?
This corresponds to |y| = 0.5*2^emin, in which case the
result may be wrong. */
/* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
inex_im |= mpfr_atanh (y, y, rnd_away);
ok = inex_im == 0
|| mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN));
} while (ok == 0);
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
mpfr_clear (y);
}
return MPC_INEX (inex_re, inex_im);
}
/* regular number argument */
{
mpfr_t a, b, x, y;
mpfr_prec_t prec, p;
mpfr_exp_t err, expo;
int ok = 0;
mpfr_t minus_op_re;
mpfr_exp_t op_re_exp, op_im_exp;
mpfr_rnd_t rnd1, rnd2;
mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);
/* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
op_re_exp = mpfr_get_exp (mpc_realref (op));
op_im_exp = mpfr_get_exp (mpc_imagref (op));
prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */
/* a = o(1-y) error(a) < 1 ulp(a)
b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
= kb ulp(b)
c = o(1+y) error(c) < 1 ulp(c)
d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
= kd ulp(d)
e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
+ kd*2^{Exp(d)-Exp(e)}] ulp(e)
error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
+ 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
because |atan(u)| < |u|
< [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
-Exp(e)}] ulp(e)
f = e/2 exact
*/
/* p: working precision */
p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
: (prec - op_im_exp);
rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (x, p);
/* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
x positive, and an upper bound on 1-y for x negative */
mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
expo will be 1 or 2 below */
{
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
/* check for intermediate underflow */
err = 2; /* ensures err will be expo below */
}
else
err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);
/* b = lower bound for atan (-x/(1+y)): for x negative, we need a
lower bound on -x/(1+y), i.e., an upper bound on 1+y */
mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
/* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
and we can simply ignore the terms involving Exp(a) in the error */
if (mpfr_sgn (a) == 0)
{
MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
/* check for intermediate underflow */
expo = err; /* will leave err unchanged below */
}
else
expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);
err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
mpfr_sub (x, x, b, GMP_RNDU);
err = 5 + op_re_exp - err - mpfr_get_exp (x);
/* error is bounded by [1 + 2^err] ulp(e) */
err = err < 0 ? 1 : err + 1;
mpfr_div_2ui (x, x, 1, GMP_RNDU);
/* Note: using RND2=RNDD guarantees that if x is exactly representable
on prec + ... bits, mpfr_can_round will return 0 */
ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
/* Imaginary part
Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */
/* a = o(1+y) error(a) < 1 ulp(a)
b = o(a^2) error(b) < 5 ulp(b)
c = o(x^2) error(c) < 1 ulp(c)
d = o(b+c) error(d) < 7 ulp(d)
e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
f = o(1-y) error(f) < 1 ulp(f)
g = o(f^2) error(g) < 5 ulp(g)
h = o(c+f) error(h) < 7 ulp(h)
i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
+ ki*2^{Exp(i)-Exp(j)}] ulp(j)
error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
+ 7*2^{3-Exp(j)}] ulp(j)
< [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
+ 7*2^{3-Exp(j)}] ulp(j)
k = j/4 exact
*/
err = 2;
p = prec; /* working precision */
do
{
p += mpc_ceil_log2 (p) + err;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (y, p);
/* a = upper bound for log(x^2 + (1+y)^2) */
ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
mpfr_sqr (a, a, GMP_RNDU);
mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
mpfr_add (a, a, y, GMP_RNDU);
mpfr_log (a, a, GMP_RNDU);
/* b = lower bound for log(x^2 + (1-y)^2) */
mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
mpfr_sqr (b, b, GMP_RNDZ);
/* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
more efficient to reuse the value of y (x^2) above and subtract
one ulp */
mpfr_nextbelow (y);
mpfr_add (b, b, y, GMP_RNDZ);
mpfr_log (b, b, GMP_RNDZ);
mpfr_sub (y, a, b, GMP_RNDU);
if (mpfr_zero_p (y))
/* FIXME: happens when x and y have very different magnitudes;
could be handled more efficiently */
ok = 0;
else
{
expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
expo = expo - mpfr_get_exp (y) + 1;
err = 3 - mpfr_get_exp (y);
/* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
err = (err < 0) ? 1 : err + 2;
else
err = (expo < 0) ? 1 : expo + 2;
mpfr_div_2ui (y, y, 2, GMP_RNDN);
MPC_ASSERT (!mpfr_zero_p (y));
/* FIXME: underflow. Since the main term of the Taylor series
in y=0 is 1/(x^2+1) * y, this means that y is very small
and/or x very large; but then the mpfr_zero_p (y) above
should be true. This needs a proof, or better yet,
special code. */
ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_IM (rnd) == GMP_RNDN));
}
} while (ok == 0);
inex = mpc_set_fr_fr (rop, x, y, rnd);
mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
return inex;
}
}
/* 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;
}
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;
}
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t xp;
mpfr_t arcs;
int signe, suplement;
mpfr_t tmp;
int Prec;
int prec_asin;
int good = 0;
int realprec;
int estimated_delta;
int compared;
/* Trivial cases */
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(asin);
MPFR_RET_NAN;
}
/* Set x_p=|x| */
signe = MPFR_SIGN(x);
mpfr_init2 (xp, MPFR_PREC(x));
mpfr_set (xp, x, rnd_mode);
if (signe == -1)
MPFR_CHANGE_SIGN(xp);
compared = mpfr_cmp_ui (xp, 1);
if (compared > 0) /* asin(x) = NaN for |x| > 1 */
{
MPFR_SET_NAN(asin);
mpfr_clear (xp);
MPFR_RET_NAN;
}
if (compared == 0) /* x = 1 or x = -1 */
{
if (signe > 0) /* asin(+1) = Pi/2 */
mpfr_const_pi (asin, rnd_mode);
else /* asin(-1) = -Pi/2 */
{
if (rnd_mode == GMP_RNDU)
rnd_mode = GMP_RNDD;
else if (rnd_mode == GMP_RNDD)
rnd_mode = GMP_RNDU;
mpfr_const_pi (asin, rnd_mode);
mpfr_neg (asin, asin, rnd_mode);
}
MPFR_EXP(asin)--;
mpfr_clear (xp);
return 1; /* inexact */
}
if (MPFR_IS_ZERO(x)) /* x = 0 */
{
mpfr_set_ui (asin, 0, GMP_RNDN);
mpfr_clear(xp);
return 0; /* exact result */
}
prec_asin = MPFR_PREC(asin);
mpfr_ui_sub (xp, 1, xp, GMP_RNDD);
suplement = 2 - MPFR_EXP(xp);
#ifdef DEBUG
printf("suplement=%d\n", suplement);
#endif
realprec = prec_asin + 10;
while (!good)
{
estimated_delta = 1 + suplement;
Prec = realprec+estimated_delta;
/* Initialisation */
mpfr_init2 (tmp, Prec);
mpfr_init2 (arcs, Prec);
#ifdef DEBUG
printf("Prec=%d\n", Prec);
printf(" x=");
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
#endif
mpfr_mul (tmp, x, x, GMP_RNDN);
#ifdef DEBUG
printf(" x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_ui_sub (tmp, 1, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" 1-x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: 1-x^2=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_sqrt (tmp, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: sqrt(1-x^2)=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_div (tmp, x, tmp, GMP_RNDN);
#ifdef DEBUG
printf("x/sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_atan (arcs, tmp, GMP_RNDN);
#ifdef DEBUG
printf("atan(x/..x^2)=");
mpfr_out_str (stdout, 2, 0, arcs, GMP_RNDN);
printf ("\n");
#endif
if (mpfr_can_round (arcs, realprec, GMP_RNDN, rnd_mode, MPFR_PREC(asin)))
{
mpfr_set (asin, arcs, rnd_mode);
#ifdef DEBUG
printf("asin =");
mpfr_out_str (stdout, 2, prec_asin, asin, GMP_RNDN);
printf ("\n");
#endif
good = 1;
}
else
{
realprec += _mpfr_ceil_log2 ((double) realprec);
#ifdef DEBUG
printf("RETRY\n");
#endif
}
mpfr_clear (tmp);
mpfr_clear (arcs);
}
mpfr_clear (xp);
return 1; /* inexact result */
}
static void
special (void)
{
mpfr_t x, y, res;
int inexact;
mpfr_init (x);
mpfr_init (y);
mpfr_init (res);
mpfr_set_prec (x, 24);
mpfr_set_prec (y, 24);
mpfr_set_str_binary (y, "0.111100110001011010111");
inexact = mpfr_ui_sub (x, 1, y, GMP_RNDN);
if (inexact)
{
printf ("Wrong inexact flag: got %d, expected 0\n", inexact);
exit (1);
}
mpfr_set_prec (x, 24);
mpfr_set_prec (y, 24);
mpfr_set_str_binary (y, "0.111100110001011010111");
if ((inexact = mpfr_ui_sub (x, 38181761, y, GMP_RNDN)) >= 0)
{
printf ("Wrong inexact flag: got %d, expected -1\n", inexact);
exit (1);
}
mpfr_set_prec (x, 63);
mpfr_set_prec (y, 63);
mpfr_set_str_binary (y, "0.111110010010100100110101101010001001100101110001000101110111111E-1");
if ((inexact = mpfr_ui_sub (x, 1541116494, y, GMP_RNDN)) <= 0)
{
printf ("Wrong inexact flag: got %d, expected +1\n", inexact);
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (y, "0.11011000110111010001011100011100E-1");
if ((inexact = mpfr_ui_sub (x, 2000375416, y, GMP_RNDN)) >= 0)
{
printf ("Wrong inexact flag: got %d, expected -1\n", inexact);
exit (1);
}
mpfr_set_prec (x, 24);
mpfr_set_prec (y, 24);
mpfr_set_str_binary (y, "0.110011011001010011110111E-2");
if ((inexact = mpfr_ui_sub (x, 927694848, y, GMP_RNDN)) <= 0)
{
printf ("Wrong inexact flag: got %d, expected +1\n", inexact);
exit (1);
}
/* bug found by Mathieu Dutour, 12 Apr 2001 */
mpfr_set_prec (x, 5);
mpfr_set_prec (y, 5);
mpfr_set_prec (res, 5);
mpfr_set_str_binary (x, "1e-12");
mpfr_ui_sub (y, 1, x, GMP_RNDD);
mpfr_set_str_binary (res, "0.11111");
if (mpfr_cmp (y, res))
{
printf ("Error in mpfr_ui_sub (y, 1, x, GMP_RNDD) for x=2^(-12)\nexpected 1.1111e-1, got ");
mpfr_out_str (stdout, 2, 0, y, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_ui_sub (y, 1, x, GMP_RNDU);
mpfr_set_str_binary (res, "1.0");
if (mpfr_cmp (y, res))
{
printf ("Error in mpfr_ui_sub (y, 1, x, GMP_RNDU) for x=2^(-12)\n"
"expected 1.0, got ");
mpfr_out_str (stdout, 2, 0, y, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_ui_sub (y, 1, x, GMP_RNDN);
mpfr_set_str_binary (res, "1.0");
if (mpfr_cmp (y, res))
{
printf ("Error in mpfr_ui_sub (y, 1, x, GMP_RNDN) for x=2^(-12)\n"
"expected 1.0, got ");
mpfr_out_str (stdout, 2, 0, y, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 10);
mpfr_set_prec (y, 10);
mpfr_random (x);
mpfr_ui_sub (y, 0, x, GMP_RNDN);
if (MPFR_IS_ZERO(x))
MPFR_ASSERTN(MPFR_IS_ZERO(y));
else
MPFR_ASSERTN(mpfr_cmpabs (x, y) == 0 && mpfr_sgn (x) != mpfr_sgn (y));
mpfr_set_prec (x, 73);
mpfr_set_str_binary (x, "0.1101111010101011011011100011010000000101110001011111001011011000101111101E-99");
mpfr_ui_sub (x, 1, x, GMP_RNDZ);
mpfr_nextabove (x);
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (res);
}
int
mpfr_sin (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t c, xr;
mpfr_srcptr xx;
mpfr_exp_t expx, err;
mpfr_prec_t precy, m;
int inexact, sign, reduce;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0);
}
}
/* sin(x) = x - x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 2, 0,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
return mpfr_sin_fast (y, x, rnd_mode);
m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* first perform argument reduction modulo 2*Pi (if needed),
also helps to determine the sign of sin(x) */
if (expx >= 2) /* If Pi < x < 4, we need to reduce too, to determine
the sign of sin(x). For 2 <= |x| < Pi, we could avoid
the reduction. */
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_set_prec call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN);
mpfr_remainder (xr, x, c, MPFR_RNDN);
/* The analysis is similar to that of cos.c:
|xr - x - 2kPi| <= 2^(2-m). Thus we can decide the sign
of sin(x) if xr is at distance at least 2^(2-m) of both
0 and +/-Pi. */
mpfr_div_2ui (c, c, 1, MPFR_RNDN);
/* Since c approximates Pi with an error <= 2^(2-expx-m) <= 2^(-m),
it suffices to check that c - |xr| >= 2^(2-m). */
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, MPFR_RNDZ);
else
mpfr_add (c, c, xr, MPFR_RNDZ);
if (MPFR_IS_ZERO(xr)
|| MPFR_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m
|| MPFR_EXP(c) < (mpfr_exp_t) 3 - (mpfr_exp_t) m)
goto ziv_next;
/* |xr - x - 2kPi| <= 2^(2-m), thus |sin(xr) - sin(x)| <= 2^(2-m) */
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
sign = MPFR_SIGN(xx);
/* now that the argument is reduced, precision m is enough */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, MPFR_RNDZ); /* can't be exact */
mpfr_nexttoinf (c); /* now c = cos(x) rounded away */
mpfr_mul (c, c, c, MPFR_RNDU); /* away */
mpfr_ui_sub (c, 1, c, MPFR_RNDZ);
mpfr_sqrt (c, c, MPFR_RNDZ);
if (MPFR_IS_NEG_SIGN(sign))
MPFR_CHANGE_SIGN(c);
/* Warning: c may be 0! */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (c)))
{
/* Huge cancellation: increase prec a lot! */
m = MAX (m, MPFR_PREC (x));
m = 2 * m;
}
else
{
/* the absolute error on c is at most 2^(3-m-EXP(c)),
plus 2^(2-m) if there was an argument reduction.
Since EXP(c) <= 1, 3-m-EXP(c) >= 2-m, thus the error
is at most 2^(3-m-EXP(c)) in case of argument reduction. */
err = 2 * MPFR_GET_EXP (c) + (mpfr_exp_t) m - 3 - (reduce != 0);
if (MPFR_CAN_ROUND (c, err, precy, rnd_mode))
break;
/* check for huge cancellation (Near 0) */
if (err < (mpfr_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1)
m += m;
}
ziv_next:
/* Else generic increase */
MPFR_ZIV_NEXT (loop, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, c, rnd_mode);
/* inexact cannot be 0, since this would mean that c was representable
within the target precision, but in that case mpfr_can_round will fail */
mpfr_clear (c);
mpfr_clear (xr);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpc_asin (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_prec_t p, p_re, p_im, incr_p = 0;
mpfr_rnd_t rnd_re, rnd_im;
mpc_t z1;
int inex;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? -1 : +1);
}
else if (mpfr_zero_p (mpc_realref (op)))
{
mpfr_set (mpc_realref (rop), mpc_realref (op), GMP_RNDN);
mpfr_set_nan (mpc_imagref (rop));
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
return 0;
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
int inex_re;
if (mpfr_inf_p (mpc_realref (op)))
{
int inf_im = mpfr_inf_p (mpc_imagref (op));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
if (inf_im)
mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
}
else
{
mpfr_set_zero (mpc_realref (rop), (mpfr_signbit (mpc_realref (op)) ? -1 : 1));
inex_re = 0;
mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
}
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
int inex_re;
int inex_im;
int s_im;
s_im = mpfr_signbit (mpc_imagref (op));
if (mpfr_cmp_ui (mpc_realref (op), 1) > 0)
{
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else if (mpfr_cmp_si (mpc_realref (op), -1) < 0)
{
mpfr_t minus_op_re;
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
if (s_im)
inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
INV_RND (MPC_RND_IM (rnd)));
else
inex_im = mpfr_acosh (mpc_imagref (rop), minus_op_re,
MPC_RND_IM (rnd));
inex_re = set_pi_over_2 (mpc_realref (rop),
(mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
{
inex_im = mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
if (s_im)
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_re = mpfr_asin (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
}
return MPC_INEX (inex_re, inex_im);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int inex_im;
int s;
s = mpfr_signbit (mpc_realref (op));
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_asinh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
/* regular complex: asin(z) = -i*log(i*z+sqrt(1-z^2)) */
p_re = mpfr_get_prec (mpc_realref(rop));
p_im = mpfr_get_prec (mpc_imagref(rop));
rnd_re = MPC_RND_RE(rnd);
rnd_im = MPC_RND_IM(rnd);
p = p_re >= p_im ? p_re : p_im;
mpc_init2 (z1, p);
while (1)
{
mpfr_exp_t ex, ey, err;
p += mpc_ceil_log2 (p) + 3 + incr_p; /* incr_p is zero initially */
incr_p = p / 2;
mpfr_set_prec (mpc_realref(z1), p);
mpfr_set_prec (mpc_imagref(z1), p);
/* z1 <- z^2 */
mpc_sqr (z1, op, MPC_RNDNN);
/* err(x) <= 1/2 ulp(x), err(y) <= 1/2 ulp(y) */
/* z1 <- 1-z1 */
ex = mpfr_get_exp (mpc_realref(z1));
mpfr_ui_sub (mpc_realref(z1), 1, mpc_realref(z1), GMP_RNDN);
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
ex = ex - mpfr_get_exp (mpc_realref(z1));
ex = (ex <= 0) ? 0 : ex;
/* err(x) <= 2^ex * ulp(x) */
ex = ex + mpfr_get_exp (mpc_realref(z1)) - p;
/* err(x) <= 2^ex */
ey = mpfr_get_exp (mpc_imagref(z1)) - p - 1;
/* err(y) <= 2^ey */
ex = (ex >= ey) ? ex : ey; /* err(x), err(y) <= 2^ex, i.e., the norm
of the error is bounded by |h|<=2^(ex+1/2) */
/* z1 <- sqrt(z1): if z1 = z + h, then sqrt(z1) = sqrt(z) + h/2/sqrt(t) */
ey = mpfr_get_exp (mpc_realref(z1)) >= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
/* we have |z1| >= 2^(ey-1) thus 1/|z1| <= 2^(1-ey) */
mpc_sqrt (z1, z1, MPC_RNDNN);
ex = (2 * ex + 1) - 2 - (ey - 1); /* |h^2/4/|t| <= 2^ex */
ex = (ex + 1) / 2; /* ceil(ex/2) */
/* express ex in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
ex = ex - ey + p;
/* take into account the rounding error in the mpc_sqrt call */
err = (ex <= 0) ? 1 : ex + 1;
/* err(x) <= 2^err * ulp(x), err(y) <= 2^err * ulp(y) */
/* z1 <- i*z + z1 */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
mpfr_sub (mpc_realref(z1), mpc_realref(z1), mpc_imagref(op), GMP_RNDN);
mpfr_add (mpc_imagref(z1), mpc_imagref(z1), mpc_realref(op), GMP_RNDN);
if (mpfr_cmp_ui (mpc_realref(z1), 0) == 0 || mpfr_cmp_ui (mpc_imagref(z1), 0) == 0)
continue;
ex -= mpfr_get_exp (mpc_realref(z1)); /* cancellation in x */
ey -= mpfr_get_exp (mpc_imagref(z1)); /* cancellation in y */
ex = (ex >= ey) ? ex : ey; /* maximum cancellation */
err += ex;
err = (err <= 0) ? 1 : err + 1; /* rounding error in sub/add */
/* z1 <- log(z1): if z1 = z + h, then log(z1) = log(z) + h/t with
|t| >= min(|z1|,|z|) */
ex = mpfr_get_exp (mpc_realref(z1));
ey = mpfr_get_exp (mpc_imagref(z1));
ex = (ex >= ey) ? ex : ey;
err += ex - p; /* revert to absolute error <= 2^err */
mpc_log (z1, z1, GMP_RNDN);
err -= ex - 1; /* 1/|t| <= 1/|z| <= 2^(1-ex) */
/* express err in terms of ulp(z1) */
ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
err = err - ey + p;
/* take into account the rounding error in the mpc_log call */
err = (err <= 0) ? 1 : err + 1;
/* z1 <- -i*z1 */
mpfr_swap (mpc_realref(z1), mpc_imagref(z1));
mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
if (mpfr_can_round (mpc_realref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_re + (rnd_re == GMP_RNDN)) &&
mpfr_can_round (mpc_imagref(z1), p - err, GMP_RNDN, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN)))
break;
}
inex = mpc_set (rop, z1, rnd);
mpc_clear (z1);
return inex;
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int prec, m, ok, e, inexact, neg;
mpfr_t c, k;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_SET_NAN(z);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
MPFR_CLEAR_FLAGS(y);
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y, x);
mpfr_set_ui (z, 1, GMP_RNDN);
MPFR_RET(0);
}
prec = MAX(MPFR_PREC(y), MPFR_PREC(z));
m = prec + _mpfr_ceil_log2 ((double) prec) + ABS(MPFR_EXP(x)) + 13;
mpfr_init2 (c, m);
mpfr_init2 (k, m);
/* first determine sign */
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN); /* 2*Pi */
mpfr_div (k, x, c, GMP_RNDN); /* x/(2*Pi) */
mpfr_floor (k, k); /* floor(x/(2*Pi)) */
mpfr_mul (c, k, c, GMP_RNDN);
mpfr_sub (k, x, c, GMP_RNDN); /* 0 <= k < 2*Pi */
mpfr_const_pi (c, GMP_RNDN); /* cached */
neg = mpfr_cmp (k, c) > 0;
mpfr_clear (k);
do
{
mpfr_cos (c, x, GMP_RNDZ);
if ((ok = mpfr_can_round (c, m, GMP_RNDZ, rnd_mode, MPFR_PREC(z))))
{
inexact = mpfr_set (z, c, rnd_mode);
mpfr_mul (c, c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
e = 2 + (-MPFR_EXP(c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
mpfr_neg (c, c, GMP_RNDN);
/* the absolute error on c is at most 2^(e-m) = 2^(EXP(c)-err) */
e = MPFR_EXP(c) + m - e;
ok = (e >= 0) && mpfr_can_round (c, e, GMP_RNDN, rnd_mode,
MPFR_PREC(y));
}
if (ok == 0)
{
m += _mpfr_ceil_log2 ((double) m);
mpfr_set_prec (c, m);
}
}
while (ok == 0);
inexact = mpfr_set (y, c, rnd_mode) || inexact;
mpfr_clear (c);
return inexact; /* inexact */
}
/* We use the reflection formula
Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t))
in order to treat the case x <= 1,
i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x)
*/
int
mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, GammaTrial, tmp, tmp2;
mpz_t fact;
mpfr_prec_t realprec;
int compared, is_integer;
int inex = 0; /* 0 means: result gamma not set yet */
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("gamma[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex));
/* Trivial cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
if (MPFR_IS_NEG (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF (gamma);
MPFR_SET_POS (gamma);
MPFR_RET (0); /* exact */
}
}
else /* x is zero */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
MPFR_SET_INF(gamma);
MPFR_SET_SAME_SIGN(gamma, x);
MPFR_SET_DIVBY0 ();
MPFR_RET (0); /* exact */
}
}
/* Check for tiny arguments, where gamma(x) ~ 1/x - euler + ....
We know from "Bound on Runs of Zeros and Ones for Algebraic Functions",
Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal
number of consecutive zeroes or ones after the round bit is n-1 for an
input of n bits. But we need a more precise lower bound. Assume x has
n bits, and 1/x is near a floating-point number y of n+1 bits. We can
write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits.
Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e).
Two cases can happen:
(i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y
are themselves powers of two, i.e., x is a power of two;
(ii) or X*Y is at distance at least one from 2^(f-e), thus
|xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n).
Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means
that the distance |y-1/x| >= 2^(-2n) ufp(y).
Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1,
if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y),
and round(1/x) with precision >= 2n+2 gives the correct result.
If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1).
A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)).
*/
if (MPFR_GET_EXP (x) + 2
<= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma)))
{
int sign = MPFR_SIGN (x); /* retrieve sign before possible override */
int special;
MPFR_BLOCK_DECL (flags);
MPFR_SAVE_EXPO_MARK (expo);
/* for overflow cases, see below; this needs to be done
before x possibly gets overridden. */
special =
MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX &&
MPFR_IS_POS_SIGN (sign) &&
MPFR_IS_LIKE_RNDD (rnd_mode, sign) &&
mpfr_powerof2_raw (x);
MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode));
if (inex == 0) /* x is a power of two */
{
/* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */
if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign))
inex = 1;
else
{
mpfr_nextbelow (gamma);
inex = -1;
}
}
else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* Overflow in the division 1/x. This is a real overflow, except
in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to
the "- euler", the rounded value in unbounded exponent range
is 0.111...11 * 2^emax (not an overflow). */
if (!special)
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags);
}
MPFR_SAVE_EXPO_FREE (expo);
/* Note: an overflow is possible with an infinite result;
in this case, the overflow flag will automatically be
restored by mpfr_check_range. */
return mpfr_check_range (gamma, inex, rnd_mode);
}
is_integer = mpfr_integer_p (x);
/* gamma(x) for x a negative integer gives NaN */
if (is_integer && MPFR_IS_NEG(x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
compared = mpfr_cmp_ui (x, 1);
if (compared == 0)
return mpfr_set_ui (gamma, 1, rnd_mode);
/* if x is an integer that fits into an unsigned long, use mpfr_fac_ui
if argument is not too large.
If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)),
so for u <= M(p), fac_ui should be faster.
We approximate here M(p) by p*log(p)^2, which is not a bad guess.
Warning: since the generic code does not handle exact cases,
we want all cases where gamma(x) is exact to be treated here.
*/
if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long int u;
mpfr_prec_t p = MPFR_PREC(gamma);
u = mpfr_get_ui (x, MPFR_RNDN);
if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN))
/* bits_fac: lower bound on the number of bits of m,
where gamma(x) = (u-1)! = m*2^e with m odd. */
return mpfr_fac_ui (gamma, u - 1, rnd_mode);
/* if bits_fac(...) > p (resp. p+1 for rounding to nearest),
then gamma(x) cannot be exact in precision p (resp. p+1).
FIXME: remove the test u < 44787929UL after changing bits_fac
to return a mpz_t or mpfr_t. */
}
MPFR_SAVE_EXPO_MARK (expo);
/* check for overflow: according to (6.1.37) in Abramowitz & Stegun,
gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi)
>= 2 * (x/e)^x / x for x >= 1 */
if (compared > 0)
{
mpfr_t yp;
mpfr_exp_t expxp;
MPFR_BLOCK_DECL (flags);
/* quick test for the default exponent range */
if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* 1/e rounded down to 53 bits */
#define EXPM1_STR "0.010111100010110101011000110110001011001110111100111"
mpfr_init2 (xp, 53);
mpfr_init2 (yp, 53);
mpfr_set_str_binary (xp, EXPM1_STR);
mpfr_mul (xp, x, xp, MPFR_RNDZ);
mpfr_sub_ui (yp, x, 2, MPFR_RNDZ);
mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */
mpfr_set_str_binary (yp, EXPM1_STR);
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */
mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */
MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ));
expxp = MPFR_GET_EXP (xp);
mpfr_clear (xp);
mpfr_clear (yp);
MPFR_SAVE_EXPO_FREE (expo);
return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ?
mpfr_overflow (gamma, rnd_mode, 1) :
mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* now compared < 0 */
/* check for underflow: for x < 1,
gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x).
Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have
|gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))|
<= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|.
To avoid an underflow in ((2-x)/e)^x, we compute the logarithm.
*/
if (MPFR_IS_NEG(x))
{
int underflow = 0, sgn, ck;
mpfr_prec_t w;
mpfr_init2 (xp, 53);
mpfr_init2 (tmp, 53);
mpfr_init2 (tmp2, 53);
/* we want an upper bound for x * [log(2-x)-1].
since x < 0, we need a lower bound on log(2-x) */
mpfr_ui_sub (xp, 2, x, MPFR_RNDD);
mpfr_log (xp, xp, MPFR_RNDD);
mpfr_sub_ui (xp, xp, 1, MPFR_RNDD);
mpfr_mul (xp, xp, x, MPFR_RNDU);
/* we need an upper bound on 1/|sin(Pi*(2-x))|,
thus a lower bound on |sin(Pi*(2-x))|.
If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p)
thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u,
assuming u <= 1, thus <= u + 3Pi(2-x)u */
w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */
w += 17; /* to get tmp2 small enough */
mpfr_set_prec (tmp, w);
mpfr_set_prec (tmp2, w);
MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN));
MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */
mpfr_const_pi (tmp2, MPFR_RNDN);
mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */
mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */
sgn = mpfr_sgn (tmp);
mpfr_abs (tmp, tmp, MPFR_RNDN);
mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */
mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */
mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU);
/* if tmp2<|tmp|, we get a lower bound */
if (mpfr_cmp (tmp2, tmp) < 0)
{
mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */
mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */
mpfr_log2 (tmp, tmp, MPFR_RNDU);
mpfr_add (xp, tmp, xp, MPFR_RNDU);
/* The assert below checks that expo.saved_emin - 2 always
fits in a long. FIXME if we want to allow mpfr_exp_t to
be a long long, for instance. */
MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN);
underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0;
}
mpfr_clear (xp);
mpfr_clear (tmp);
mpfr_clear (tmp2);
if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn);
}
}
realprec = MPFR_PREC (gamma);
/* we want both 1-x and 2-x to be exact */
{
mpfr_prec_t w;
w = mpfr_gamma_1_minus_x_exact (x);
if (realprec < w)
realprec = w;
w = mpfr_gamma_2_minus_x_exact (x);
if (realprec < w)
realprec = w;
}
realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20;
MPFR_ASSERTD(realprec >= 5);
MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20,
xp, tmp, tmp2, GammaTrial);
mpz_init (fact);
MPFR_ZIV_INIT (loop, realprec);
for (;;)
{
mpfr_exp_t err_g;
int ck;
MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial);
/* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */
ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */
mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */
mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */
err_g = MPFR_GET_EXP(GammaTrial);
mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */
/* If tmp is +Inf, we compute exp(lngamma(x)). */
if (mpfr_inf_p (tmp))
{
inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode);
if (inex)
goto end;
else
goto ziv_next;
}
err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial);
/* let g0 the true value of Pi*(2-x), g the computed value.
We have g = g0 + h with |h| <= |(1+u^2)-1|*g.
Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g.
The relative error is thus bounded by |(1+u^2)-1|*g/sin(g)
<= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4.
With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */
ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */
mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN);
/* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u
+ (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2.
For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <=
0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus
(0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4
<= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */
mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN);
/* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u].
For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2
<= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4.
(1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u)
= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3
+ (18+9*2^err_g)*u^4
<= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3
<= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2
<= 1 + (23 + 10*2^err_g)*u.
The final error is thus bounded by (23 + 10*2^err_g) ulps,
which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */
err_g = (err_g <= 2) ? 6 : err_g + 4;
if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g,
MPFR_PREC(gamma), rnd_mode)))
break;
ziv_next:
MPFR_ZIV_NEXT (loop, realprec);
}
end:
MPFR_ZIV_FREE (loop);
if (inex == 0)
inex = mpfr_set (gamma, GammaTrial, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (fact);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (gamma, inex, rnd_mode);
}
int
mpfr_acos (mpfr_ptr acos, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, arcc, tmp;
mpfr_exp_t supplement;
mpfr_prec_t prec;
int sign, compared, inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("acos[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec(acos), mpfr_log_prec, acos, inexact));
/* Singular cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (acos);
MPFR_RET_NAN;
}
else /* necessarily x=0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
/* acos(0)=Pi/2 */
MPFR_SAVE_EXPO_MARK (expo);
inexact = mpfr_const_pi (acos, rnd_mode);
mpfr_div_2ui (acos, acos, 1, rnd_mode); /* exact */
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (acos, inexact, rnd_mode);
}
}
/* Set x_p=|x| */
sign = MPFR_SIGN (x);
mpfr_init2 (xp, MPFR_PREC (x));
mpfr_abs (xp, x, MPFR_RNDN); /* Exact */
compared = mpfr_cmp_ui (xp, 1);
if (MPFR_UNLIKELY (compared >= 0))
{
mpfr_clear (xp);
if (compared > 0) /* acos(x) = NaN for x > 1 */
{
MPFR_SET_NAN(acos);
MPFR_RET_NAN;
}
else
{
if (MPFR_IS_POS_SIGN (sign)) /* acos(+1) = +0 */
return mpfr_set_ui (acos, 0, rnd_mode);
else /* acos(-1) = Pi */
return mpfr_const_pi (acos, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute the supplement */
mpfr_ui_sub (xp, 1, xp, MPFR_RNDD);
if (MPFR_IS_POS_SIGN (sign))
supplement = 2 - 2 * MPFR_GET_EXP (xp);
else
supplement = 2 - MPFR_GET_EXP (xp);
mpfr_clear (xp);
prec = MPFR_PREC (acos);
prec += MPFR_INT_CEIL_LOG2(prec) + 10 + supplement;
/* VL: The following change concerning prec comes from r3145
"Optimize mpfr_acos by choosing a better initial precision."
but it doesn't seem to be correct and leads to problems (assertion
failure or very important inefficiency) with tiny arguments.
Therefore, I've disabled it. */
/* If x ~ 2^-N, acos(x) ~ PI/2 - x - x^3/6
If Prec < 2*N, we can't round since x^3/6 won't be counted. */
#if 0
if (MPFR_PREC (acos) >= MPFR_PREC (x) && MPFR_GET_EXP (x) < 0)
{
mpfr_uexp_t pmin = (mpfr_uexp_t) (-2 * MPFR_GET_EXP (x)) + 5;
MPFR_ASSERTN (pmin <= MPFR_PREC_MAX);
if (prec < pmin)
prec = pmin;
}
#endif
mpfr_init2 (tmp, prec);
mpfr_init2 (arcc, prec);
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
/* acos(x) = Pi/2 - asin(x) = Pi/2 - atan(x/sqrt(1-x^2)) */
mpfr_sqr (tmp, x, MPFR_RNDN);
mpfr_ui_sub (tmp, 1, tmp, MPFR_RNDN);
mpfr_sqrt (tmp, tmp, MPFR_RNDN);
mpfr_div (tmp, x, tmp, MPFR_RNDN);
mpfr_atan (arcc, tmp, MPFR_RNDN);
mpfr_const_pi (tmp, MPFR_RNDN);
mpfr_div_2ui (tmp, tmp, 1, MPFR_RNDN);
mpfr_sub (arcc, tmp, arcc, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (arcc, prec - supplement,
MPFR_PREC (acos), rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (tmp, prec);
mpfr_set_prec (arcc, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (acos, arcc, rnd_mode);
mpfr_clear (tmp);
mpfr_clear (arcc);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (acos, inexact, rnd_mode);
}
