/* f <- 1 - r/2! + r^2/4! + ... + (-1)^l r^l/(2l)! + ...
Assumes |r| < 1/2, and f, r have the same precision.
Returns e such that the error on f is bounded by 2^e ulps.
*/
static int
mpfr_cos2_aux (mpfr_ptr f, mpfr_srcptr r)
{
mpz_t x, t, s;
mpfr_exp_t ex, l, m;
mpfr_prec_t p, q;
unsigned long i, maxi, imax;
MPFR_ASSERTD(mpfr_get_exp (r) <= -1);
/* compute minimal i such that i*(i+1) does not fit in an unsigned long,
assuming that there are no padding bits. */
maxi = 1UL << (CHAR_BIT * sizeof(unsigned long) / 2);
if (maxi * (maxi / 2) == 0) /* test checked at compile time */
{
/* can occur only when there are padding bits. */
/* maxi * (maxi-1) is representable iff maxi * (maxi / 2) != 0 */
do
maxi /= 2;
while (maxi * (maxi / 2) == 0);
}
mpz_init (x);
mpz_init (s);
mpz_init (t);
ex = mpfr_get_z_2exp (x, r); /* r = x*2^ex */
/* remove trailing zeroes */
l = mpz_scan1 (x, 0);
ex += l;
mpz_fdiv_q_2exp (x, x, l);
/* since |r| < 1, r = x*2^ex, and x is an integer, necessarily ex < 0 */
p = mpfr_get_prec (f); /* same than r */
/* bound for number of iterations */
imax = p / (-mpfr_get_exp (r));
imax += (imax == 0);
q = 2 * MPFR_INT_CEIL_LOG2(imax) + 4; /* bound for (3l)^2 */
mpz_set_ui (s, 1); /* initialize sum with 1 */
mpz_mul_2exp (s, s, p + q); /* scale all values by 2^(p+q) */
mpz_set (t, s); /* invariant: t is previous term */
for (i = 1; (m = mpz_sizeinbase (t, 2)) >= q; i += 2)
{
/* adjust precision of x to that of t */
l = mpz_sizeinbase (x, 2);
if (l > m)
{
l -= m;
mpz_fdiv_q_2exp (x, x, l);
ex += l;
}
/* multiply t by r */
mpz_mul (t, t, x);
mpz_fdiv_q_2exp (t, t, -ex);
/* divide t by i*(i+1) */
if (i < maxi)
mpz_fdiv_q_ui (t, t, i * (i + 1));
else
{
mpz_fdiv_q_ui (t, t, i);
mpz_fdiv_q_ui (t, t, i + 1);
}
/* if m is the (current) number of bits of t, we can consider that
all operations on t so far had precision >= m, so we can prove
by induction that the relative error on t is of the form
(1+u)^(3l)-1, where |u| <= 2^(-m), and l=(i+1)/2 is the # of loops.
Since |(1+x^2)^(1/x) - 1| <= 4x/3 for |x| <= 1/2,
for |u| <= 1/(3l)^2, the absolute error is bounded by
4/3*(3l)*2^(-m)*t <= 4*l since |t| < 2^m.
Therefore the error on s is bounded by 2*l*(l+1). */
/* add or subtract to s */
if (i % 4 == 1)
mpz_sub (s, s, t);
else
mpz_add (s, s, t);
}
mpfr_set_z (f, s, MPFR_RNDN);
mpfr_div_2ui (f, f, p + q, MPFR_RNDN);
mpz_clear (x);
mpz_clear (s);
mpz_clear (t);
l = (i - 1) / 2; /* number of iterations */
return 2 * MPFR_INT_CEIL_LOG2 (l + 1) + 1; /* bound is 2l(l+1) */
}
/* agm(x,y) is between x and y, so we don't need to save exponent range */
int
mpfr_agm (mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, mp_rnd_t rnd_mode)
{
int compare, inexact;
mp_size_t s;
mp_prec_t p, q;
mp_limb_t *up, *vp, *tmpp;
mpfr_t u, v, tmp;
unsigned long n; /* number of iterations */
unsigned long err = 0;
MPFR_ZIV_DECL (loop);
MPFR_TMP_DECL(marker);
MPFR_LOG_FUNC (("op2[%#R]=%R op1[%#R]=%R rnd=%d", op2,op2,op1,op1,rnd_mode),
("r[%#R]=%R inexact=%d", r, r, inexact));
/* Deal with special values */
if (MPFR_ARE_SINGULAR (op1, op2))
{
/* If a or b is NaN, the result is NaN */
if (MPFR_IS_NAN(op1) || MPFR_IS_NAN(op2))
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
/* now one of a or b is Inf or 0 */
/* If a and b is +Inf, the result is +Inf.
Otherwise if a or b is -Inf or 0, the result is NaN */
else if (MPFR_IS_INF(op1) || MPFR_IS_INF(op2))
{
if (MPFR_IS_STRICTPOS(op1) && MPFR_IS_STRICTPOS(op2))
{
MPFR_SET_INF(r);
MPFR_SET_SAME_SIGN(r, op1);
MPFR_RET(0); /* exact */
}
else
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
}
else /* a and b are neither NaN nor Inf, and one is zero */
{ /* If a or b is 0, the result is +0 since a sqrt is positive */
MPFR_ASSERTD (MPFR_IS_ZERO (op1) || MPFR_IS_ZERO (op2));
MPFR_SET_POS (r);
MPFR_SET_ZERO (r);
MPFR_RET (0); /* exact */
}
}
MPFR_CLEAR_FLAGS (r);
/* If a or b is negative (excluding -Infinity), the result is NaN */
if (MPFR_UNLIKELY(MPFR_IS_NEG(op1) || MPFR_IS_NEG(op2)))
{
MPFR_SET_NAN(r);
MPFR_RET_NAN;
}
/* Precision of the following calculus */
q = MPFR_PREC(r);
p = q + MPFR_INT_CEIL_LOG2(q) + 15;
MPFR_ASSERTD (p >= 7); /* see algorithms.tex */
s = (p - 1) / BITS_PER_MP_LIMB + 1;
/* b (op2) and a (op1) are the 2 operands but we want b >= a */
compare = mpfr_cmp (op1, op2);
if (MPFR_UNLIKELY( compare == 0 ))
{
mpfr_set (r, op1, rnd_mode);
MPFR_RET (0); /* exact */
}
else if (compare > 0)
{
mpfr_srcptr t = op1;
op1 = op2;
op2 = t;
}
/* Now b(=op2) >= a (=op1) */
MPFR_TMP_MARK(marker);
/* Main loop */
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mp_prec_t eq;
/* Init temporary vars */
MPFR_TMP_INIT (up, u, p, s);
MPFR_TMP_INIT (vp, v, p, s);
MPFR_TMP_INIT (tmpp, tmp, p, s);
/* Calculus of un and vn */
mpfr_mul (u, op1, op2, GMP_RNDN); /* Faster since PREC(op) < PREC(u) */
mpfr_sqrt (u, u, GMP_RNDN);
mpfr_add (v, op1, op2, GMP_RNDN); /* add with !=prec is still good*/
mpfr_div_2ui (v, v, 1, GMP_RNDN);
n = 1;
while (mpfr_cmp2 (u, v, &eq) != 0 && eq <= p - 2)
{
mpfr_add (tmp, u, v, GMP_RNDN);
mpfr_div_2ui (tmp, tmp, 1, GMP_RNDN);
/* See proof in algorithms.tex */
if (4*eq > p)
{
mpfr_t w;
/* tmp = U(k) */
mpfr_init2 (w, (p + 1) / 2);
mpfr_sub (w, v, u, GMP_RNDN); /* e = V(k-1)-U(k-1) */
mpfr_sqr (w, w, GMP_RNDN); /* e = e^2 */
mpfr_div_2ui (w, w, 4, GMP_RNDN); /* e*= (1/2)^2*1/4 */
mpfr_div (w, w, tmp, GMP_RNDN); /* 1/4*e^2/U(k) */
mpfr_sub (v, tmp, w, GMP_RNDN);
err = MPFR_GET_EXP (tmp) - MPFR_GET_EXP (v); /* 0 or 1 */
mpfr_clear (w);
break;
}
mpfr_mul (u, u, v, GMP_RNDN);
mpfr_sqrt (u, u, GMP_RNDN);
mpfr_swap (v, tmp);
n ++;
}
/* the error on v is bounded by (18n+51) ulps, or twice if there
was an exponent loss in the final subtraction */
err += MPFR_INT_CEIL_LOG2(18 * n + 51); /* 18n+51 should not overflow
since n is about log(p) */
/* we should have n+2 <= 2^(p/4) [see algorithms.tex] */
if (MPFR_LIKELY (MPFR_INT_CEIL_LOG2(n + 2) <= p / 4 &&
MPFR_CAN_ROUND (v, p - err, q, rnd_mode)))
break; /* Stop the loop */
/* Next iteration */
MPFR_ZIV_NEXT (loop, p);
s = (p - 1) / BITS_PER_MP_LIMB + 1;
}
MPFR_ZIV_FREE (loop);
/* Setting of the result */
inexact = mpfr_set (r, v, rnd_mode);
/* Let's clean */
MPFR_TMP_FREE(marker);
return inexact; /* agm(u,v) can be exact for u, v rational only for u=v.
Proof (due to Nicolas Brisebarre): it suffices to consider
u=1 and v<1. Then 1/AGM(1,v) = 2F1(1/2,1/2,1;1-v^2),
and a theorem due to G.V. Chudnovsky states that for x a
non-zero algebraic number with |x|<1, then
2F1(1/2,1/2,1;x) and 2F1(-1/2,1/2,1;x) are algebraically
independent over Q. */
}
int
mpfr_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 main()
{
slong i;
mpfr_t tabx, expx, y1, y2;
mpz_t tt;
flint_printf("exp_tab....");
fflush(stdout);
{
slong prec, bits, num;
prec = ARB_EXP_TAB1_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB1_BITS;
num = ARB_EXP_TAB1_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab1[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS;
num = ARB_EXP_TAB21_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab21[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS + ARB_EXP_TAB22_BITS;
num = ARB_EXP_TAB22_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab22[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
/* Don't need to save/restore exponent range: the cache does it */
int
mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t a, A, B, D, S;
mpfr_prec_t px, p, cancel, k, kmax;
MPFR_ZIV_DECL (loop);
int inex;
MPFR_LOG_FUNC
(("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex));
px = MPFR_PREC (x);
/* we need 9*2^kmax - 4 >= px+2*kmax+8 */
for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++);
p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */
mpfr_init2 (a, p);
mpfr_init2 (A, p);
mpfr_init2 (B, p);
mpfr_init2 (D, p);
mpfr_init2 (S, p);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_set_ui (a, 1, MPFR_RNDN); /* a = 1 */
mpfr_set_ui (A, 1, MPFR_RNDN); /* A = a^2 = 1 */
mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */
mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */
#define b B
#define ap a
#define Ap A
#define Bp B
for (k = 0; ; k++)
{
/* invariant: 1/2 <= B <= A <= a < 1 */
mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */
mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */
mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */
mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */
mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */
mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */
mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */
mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */
mpfr_sub (S, Ap, Bp, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0);
cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p;
/* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */
mpfr_mul_2ui (S, S, k, MPFR_RNDN);
mpfr_sub (D, D, S, MPFR_RNDN);
/* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */
if (cancel + k >= p)
break;
}
#undef b
#undef ap
#undef Ap
#undef Bp
mpfr_div (A, B, D, MPFR_RNDN);
/* MPFR_ASSERTN(p >= 2 * k + 8); */
if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode)))
break;
p += kmax;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (a, p);
mpfr_set_prec (A, p);
mpfr_set_prec (B, p);
mpfr_set_prec (D, p);
mpfr_set_prec (S, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (x, A, rnd_mode);
mpfr_clear (a);
mpfr_clear (A);
mpfr_clear (B);
mpfr_clear (D);
mpfr_clear (S);
return inex;
}
int
mpfr_grandom (mpfr_ptr rop1, mpfr_ptr rop2, gmp_randstate_t rstate,
mpfr_rnd_t rnd)
{
int inex1, inex2, s1, s2;
mpz_t x, y, xp, yp, t, a, b, s;
mpfr_t sfr, l, r1, r2;
mpfr_prec_t tprec, tprec0;
inex2 = inex1 = 0;
if (rop2 == NULL) /* only one output requested. */
{
tprec0 = MPFR_PREC (rop1);
}
else
{
tprec0 = MAX (MPFR_PREC (rop1), MPFR_PREC (rop2));
}
tprec0 += 11;
/* We use "Marsaglia polar method" here (cf.
George Marsaglia, Normal (Gaussian) random variables for supercomputers
The Journal of Supercomputing, Volume 5, Number 1, 49–55
DOI: 10.1007/BF00155857).
First we draw uniform x and y in [0,1] using mpz_urandomb (in
fixed precision), and scale them to [-1, 1].
*/
mpz_init (xp);
mpz_init (yp);
mpz_init (x);
mpz_init (y);
mpz_init (t);
mpz_init (s);
mpz_init (a);
mpz_init (b);
mpfr_init2 (sfr, MPFR_PREC_MIN);
mpfr_init2 (l, MPFR_PREC_MIN);
mpfr_init2 (r1, MPFR_PREC_MIN);
if (rop2 != NULL)
mpfr_init2 (r2, MPFR_PREC_MIN);
mpz_set_ui (xp, 0);
mpz_set_ui (yp, 0);
for (;;)
{
tprec = tprec0;
do
{
mpz_urandomb (xp, rstate, tprec);
mpz_urandomb (yp, rstate, tprec);
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
while (mpz_sizeinbase (s, 2) > tprec * 2); /* x^2 + y^2 <= 2^{2tprec} */
for (;;)
{
/* FIXME: compute s as s += 2x + 2y + 2 */
mpz_add_ui (a, xp, 1);
mpz_add_ui (b, yp, 1);
mpz_mul (a, a, a);
mpz_mul (b, b, b);
mpz_add (s, a, b);
if ((mpz_sizeinbase (s, 2) <= 2 * tprec) ||
((mpz_sizeinbase (s, 2) == 2 * tprec + 1) &&
(mpz_scan1 (s, 0) == 2 * tprec)))
goto yeepee;
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
if (mpz_sizeinbase (s, 2) > tprec * 2)
break;
}
}
yeepee:
/* FIXME: compute s with s -= 2x + 2y + 2 */
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
/* Compute the signs of the output */
mpz_urandomb (x, rstate, 2);
s1 = mpz_tstbit (x, 0);
s2 = mpz_tstbit (x, 1);
for (;;)
{
/* s = xp^2 + yp^2 (loop invariant) */
mpfr_set_prec (sfr, 2 * tprec);
mpfr_set_prec (l, tprec);
mpfr_set_z (sfr, s, MPFR_RNDN); /* exact */
mpfr_mul_2si (sfr, sfr, -2 * tprec, MPFR_RNDN); /* exact */
mpfr_log (l, sfr, MPFR_RNDN);
mpfr_neg (l, l, MPFR_RNDN);
mpfr_mul_2si (l, l, 1, MPFR_RNDN);
mpfr_div (l, l, sfr, MPFR_RNDN);
mpfr_sqrt (l, l, MPFR_RNDN);
mpfr_set_prec (r1, tprec);
mpfr_mul_z (r1, l, xp, MPFR_RNDN);
mpfr_div_2ui (r1, r1, tprec, MPFR_RNDN); /* exact */
if (s1)
mpfr_neg (r1, r1, MPFR_RNDN);
if (MPFR_CAN_ROUND (r1, tprec - 2, MPFR_PREC (rop1), rnd))
{
if (rop2 != NULL)
{
mpfr_set_prec (r2, tprec);
mpfr_mul_z (r2, l, yp, MPFR_RNDN);
mpfr_div_2ui (r2, r2, tprec, MPFR_RNDN); /* exact */
if (s2)
mpfr_neg (r2, r2, MPFR_RNDN);
if (MPFR_CAN_ROUND (r2, tprec - 2, MPFR_PREC (rop2), rnd))
break;
}
else
break;
}
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
inex1 = mpfr_set (rop1, r1, rnd);
if (rop2 != NULL)
{
inex2 = mpfr_set (rop2, r2, rnd);
inex2 = mpfr_check_range (rop2, inex2, rnd);
}
inex1 = mpfr_check_range (rop1, inex1, rnd);
if (rop2 != NULL)
mpfr_clear (r2);
mpfr_clear (r1);
mpfr_clear (l);
mpfr_clear (sfr);
mpz_clear (b);
mpz_clear (a);
mpz_clear (s);
mpz_clear (t);
mpz_clear (y);
mpz_clear (x);
mpz_clear (yp);
mpz_clear (xp);
return INEX (inex1, inex2);
}
/* (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
mpc_sqrt (mpc_ptr a, mpc_srcptr b, mpc_rnd_t rnd)
{
int ok_w, ok_t = 0;
mpfr_t w, t;
mp_rnd_t rnd_w, rnd_t;
mp_prec_t prec_w, prec_t;
/* the rounding mode and the precision required for w and t, which can */
/* be either the real or the imaginary part of a */
mp_prec_t prec;
int inex_w, inex_t = 1, inex, loops = 0;
/* comparison of the real/imaginary part of b with 0 */
const int re_cmp = mpfr_cmp_ui (MPC_RE (b), 0);
const int im_cmp = mpfr_cmp_ui (MPC_IM (b), 0);
/* we need to know the sign of Im(b) when it is +/-0 */
const int im_sgn = mpfr_signbit (MPC_IM (b)) == 0? 0 : -1;
/* special values */
/* sqrt(x +i*Inf) = +Inf +I*Inf, even if x = NaN */
/* sqrt(x -i*Inf) = +Inf -I*Inf, even if x = NaN */
if (mpfr_inf_p (MPC_IM (b)))
{
mpfr_set_inf (MPC_RE (a), +1);
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
if (mpfr_inf_p (MPC_RE (b)))
{
if (mpfr_signbit (MPC_RE (b)))
{
if (mpfr_number_p (MPC_IM (b)))
{
/* sqrt(-Inf +i*y) = +0 +i*Inf, when y positive */
/* sqrt(-Inf +i*y) = +0 -i*Inf, when y positive */
mpfr_set_ui (MPC_RE (a), 0, GMP_RNDN);
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
else
{
/* sqrt(-Inf +i*NaN) = NaN +/-i*Inf */
mpfr_set_nan (MPC_RE (a));
mpfr_set_inf (MPC_IM (a), im_sgn);
return MPC_INEX (0, 0);
}
}
else
{
if (mpfr_number_p (MPC_IM (b)))
{
/* sqrt(+Inf +i*y) = +Inf +i*0, when y positive */
/* sqrt(+Inf +i*y) = +Inf -i*0, when y positive */
mpfr_set_inf (MPC_RE (a), +1);
mpfr_set_ui (MPC_IM (a), 0, GMP_RNDN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (0, 0);
}
else
{
/* sqrt(+Inf -i*Inf) = +Inf -i*Inf */
/* sqrt(+Inf +i*Inf) = +Inf +i*Inf */
/* sqrt(+Inf +i*NaN) = +Inf +i*NaN */
return mpc_set (a, b, rnd);
}
}
}
/* sqrt(x +i*NaN) = NaN +i*NaN, if x is not infinite */
/* sqrt(NaN +i*y) = NaN +i*NaN, if y is not infinite */
if (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
{
mpfr_set_nan (MPC_RE (a));
mpfr_set_nan (MPC_IM (a));
return MPC_INEX (0, 0);
}
/* purely real */
if (im_cmp == 0)
{
if (re_cmp == 0)
{
mpc_set_ui_ui (a, 0, 0, MPC_RNDNN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (0, 0);
}
else if (re_cmp > 0)
{
inex_w = mpfr_sqrt (MPC_RE (a), MPC_RE (b), MPC_RND_RE (rnd));
mpfr_set_ui (MPC_IM (a), 0, GMP_RNDN);
if (im_sgn)
mpc_conj (a, a, MPC_RNDNN);
return MPC_INEX (inex_w, 0);
}
else
{
mpfr_init2 (w, MPFR_PREC (MPC_RE (b)));
mpfr_neg (w, MPC_RE (b), GMP_RNDN);
if (im_sgn)
{
inex_w = -mpfr_sqrt (MPC_IM (a), w, INV_RND (MPC_RND_IM (rnd)));
mpfr_neg (MPC_IM (a), MPC_IM (a), GMP_RNDN);
}
else
inex_w = mpfr_sqrt (MPC_IM (a), w, MPC_RND_IM (rnd));
mpfr_set_ui (MPC_RE (a), 0, GMP_RNDN);
mpfr_clear (w);
return MPC_INEX (0, inex_w);
}
}
/* purely imaginary */
if (re_cmp == 0)
{
mpfr_t y;
y[0] = MPC_IM (b)[0];
/* If y/2 underflows, so does sqrt(y/2) */
mpfr_div_2ui (y, y, 1, GMP_RNDN);
if (im_cmp > 0)
{
inex_w = mpfr_sqrt (MPC_RE (a), y, MPC_RND_RE (rnd));
inex_t = mpfr_sqrt (MPC_IM (a), y, MPC_RND_IM (rnd));
}
else
{
mpfr_neg (y, y, GMP_RNDN);
inex_w = mpfr_sqrt (MPC_RE (a), y, MPC_RND_RE (rnd));
inex_t = -mpfr_sqrt (MPC_IM (a), y, INV_RND (MPC_RND_IM (rnd)));
mpfr_neg (MPC_IM (a), MPC_IM (a), GMP_RNDN);
}
return MPC_INEX (inex_w, inex_t);
}
prec = MPC_MAX_PREC(a);
mpfr_init (w);
mpfr_init (t);
if (re_cmp >= 0)
{
rnd_w = MPC_RND_RE (rnd);
prec_w = MPFR_PREC (MPC_RE (a));
rnd_t = MPC_RND_IM(rnd);
prec_t = MPFR_PREC (MPC_IM (a));
}
else
{
rnd_w = MPC_RND_IM(rnd);
prec_w = MPFR_PREC (MPC_IM (a));
rnd_t = MPC_RND_RE(rnd);
prec_t = MPFR_PREC (MPC_RE (a));
if (im_cmp < 0)
{
rnd_w = INV_RND(rnd_w);
rnd_t = INV_RND(rnd_t);
}
}
do
{
loops ++;
prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
mpfr_set_prec (w, prec);
mpfr_set_prec (t, prec);
/* let b = x + iy */
/* w = sqrt ((|x| + sqrt (x^2 + y^2)) / 2), rounded down */
/* total error bounded by 3 ulps */
inex_w = mpc_abs (w, b, GMP_RNDD);
if (re_cmp < 0)
inex_w |= mpfr_sub (w, w, MPC_RE (b), GMP_RNDD);
else
inex_w |= mpfr_add (w, w, MPC_RE (b), GMP_RNDD);
inex_w |= mpfr_div_2ui (w, w, 1, GMP_RNDD);
inex_w |= mpfr_sqrt (w, w, GMP_RNDD);
ok_w = mpfr_can_round (w, (mp_exp_t) prec - 2, GMP_RNDD, GMP_RNDU,
prec_w + (rnd_w == GMP_RNDN));
if (!inex_w || ok_w)
{
/* t = y / 2w, rounded away */
/* total error bounded by 7 ulps */
const mp_rnd_t r = im_sgn ? GMP_RNDD : GMP_RNDU;
inex_t = mpfr_div (t, MPC_IM (b), w, r);
inex_t |= mpfr_div_2ui (t, t, 1, r);
ok_t = mpfr_can_round (t, (mp_exp_t) prec - 3, r, GMP_RNDZ,
prec_t + (rnd_t == GMP_RNDN));
/* As for w; since t was rounded away, we check whether rounding to 0
is possible. */
}
}
while ((inex_w && !ok_w) || (inex_t && !ok_t));
if (re_cmp > 0)
inex = MPC_INEX (mpfr_set (MPC_RE (a), w, MPC_RND_RE(rnd)),
mpfr_set (MPC_IM (a), t, MPC_RND_IM(rnd)));
else if (im_cmp > 0)
inex = MPC_INEX (mpfr_set (MPC_RE(a), t, MPC_RND_RE(rnd)),
mpfr_set (MPC_IM(a), w, MPC_RND_IM(rnd)));
else
inex = MPC_INEX (mpfr_neg (MPC_RE (a), t, MPC_RND_RE(rnd)),
mpfr_neg (MPC_IM (a), w, MPC_RND_IM(rnd)));
mpfr_clear (w);
mpfr_clear (t);
return inex;
}
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
mpfr_exp_3 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t t, x_copy, tmp;
mpz_t uk;
mp_exp_t ttt, shift_x;
unsigned long twopoweri;
mpz_t *P;
mp_prec_t *mult;
int i, k, loop;
int prec_x;
mp_prec_t realprec, Prec;
int iter;
int inexact = 0;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (ziv_loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
MPFR_SAVE_EXPO_MARK (expo);
/* decompose x */
/* we first write x = 1.xxxxxxxxxxxxx
----- k bits -- */
prec_x = MPFR_INT_CEIL_LOG2 (MPFR_PREC (x)) - MPFR_LOG2_BITS_PER_MP_LIMB;
if (prec_x < 0)
prec_x = 0;
ttt = MPFR_GET_EXP (x);
mpfr_init2 (x_copy, MPFR_PREC(x));
mpfr_set (x_copy, x, GMP_RNDD);
/* we shift to get a number less than 1 */
if (ttt > 0)
{
shift_x = ttt;
mpfr_div_2ui (x_copy, x, ttt, GMP_RNDN);
ttt = MPFR_GET_EXP (x_copy);
}
else
shift_x = 0;
MPFR_ASSERTD (ttt <= 0);
/* Init prec and vars */
realprec = MPFR_PREC (y) + MPFR_INT_CEIL_LOG2 (prec_x + MPFR_PREC (y));
Prec = realprec + shift + 2 + shift_x;
mpfr_init2 (t, Prec);
mpfr_init2 (tmp, Prec);
mpz_init (uk);
/* Main loop */
MPFR_ZIV_INIT (ziv_loop, realprec);
for (;;)
{
int scaled = 0;
MPFR_BLOCK_DECL (flags);
k = MPFR_INT_CEIL_LOG2 (Prec) - MPFR_LOG2_BITS_PER_MP_LIMB;
/* now we have to extract */
twopoweri = BITS_PER_MP_LIMB;
/* Allocate tables */
P = (mpz_t*) (*__gmp_allocate_func) (3*(k+2)*sizeof(mpz_t));
for (i = 0; i < 3*(k+2); i++)
mpz_init (P[i]);
mult = (mp_prec_t*) (*__gmp_allocate_func) (2*(k+2)*sizeof(mp_prec_t));
/* Particular case for i==0 */
mpfr_extract (uk, x_copy, 0);
MPFR_ASSERTD (mpz_cmp_ui (uk, 0) != 0);
mpfr_exp_rational (tmp, uk, shift + twopoweri - ttt, k + 1, P, mult);
for (loop = 0; loop < shift; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
twopoweri *= 2;
/* General case */
iter = (k <= prec_x) ? k : prec_x;
for (i = 1; i <= iter; i++)
{
mpfr_extract (uk, x_copy, i);
if (MPFR_LIKELY (mpz_cmp_ui (uk, 0) != 0))
{
mpfr_exp_rational (t, uk, twopoweri - ttt, k - i + 1, P, mult);
mpfr_mul (tmp, tmp, t, GMP_RNDD);
}
MPFR_ASSERTN (twopoweri <= LONG_MAX/2);
twopoweri *=2;
}
/* Clear tables */
for (i = 0; i < 3*(k+2); i++)
mpz_clear (P[i]);
(*__gmp_free_func) (P, 3*(k+2)*sizeof(mpz_t));
(*__gmp_free_func) (mult, 2*(k+2)*sizeof(mp_prec_t));
if (shift_x > 0)
{
MPFR_BLOCK (flags, {
for (loop = 0; loop < shift_x - 1; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
mpfr_sqr (t, tmp, GMP_RNDD);
} );
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* tmp <= exact result, so that it is a real overflow. */
inexact = mpfr_overflow (y, rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
{
/* This may be a spurious underflow. So, let's scale
the result. */
mpfr_mul_2ui (tmp, tmp, 1, GMP_RNDD); /* no overflow, exact */
mpfr_sqr (t, tmp, GMP_RNDD);
if (MPFR_IS_ZERO (t))
{
/* approximate result < 2^(emin - 3), thus
exact result < 2^(emin - 2). */
inexact = mpfr_underflow (y, (rnd_mode == GMP_RNDN) ?
GMP_RNDZ : rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
break;
}
scaled = 1;
}
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
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));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mpfr_exp_t d;
mpfr_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh */
MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */
/* t <- cosh(x/2): error(t) <= 1 ulp(t) */
MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
overflows too */
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
mpfr_sinh (ti, ti, MPFR_RNDD);
/* multiplication below, error(t) <= 5 ulp(t) */
MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* doubling below, exact */
MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* we have lost at most 3 bits of precision */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
err = Nt; /* double the precision */
}
else
{
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
static void
special (void)
{
mpfr_t x, y, z;
int i;
mpfr_init (x);
mpfr_init (y);
MPFR_SET_INF(x);
mpfr_set_ui (y, 0, GMP_RNDN);
mpfr_atanh (x, y, GMP_RNDN);
if (MPFR_IS_INF(x) || MPFR_IS_NAN(x) )
{
printf ("Inf flag not clears in atanh!\n");
exit (1);
}
MPFR_SET_NAN(x);
mpfr_atanh (x, y, GMP_RNDN);
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
printf ("NAN flag not clears in atanh!\n");
exit (1);
}
/* atanh(+/-x) = NaN if x > 1 */
for (i = 3; i <= 6; i++)
{
mpfr_set_si (x, i, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_atanh(%d/2) <> NaN\n", i);
exit (1);
}
mpfr_neg (x, x, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_atanh(-%d/2) <> NaN\n", i);
exit (1);
}
}
/* atanh(+0) = +0, atanh(-0) = -0 */
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error: mpfr_atanh(+0) <> +0\n");
exit (1);
}
mpfr_neg (x, x, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
{
printf ("Error: mpfr_atanh(-0) <> -0\n");
exit (1);
}
MPFR_SET_NAN(x);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_atanh(NaN) <> NaN\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_atanh(+Inf) <> NaN\n");
mpfr_print_binary (y); printf ("\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error: mpfr_atanh(-Inf) <> NaN\n");
exit (1);
}
mpfr_set_ui (x, 1, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error: mpfr_atanh(1) <> +Inf\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_atanh (y, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) > 0)
{
printf ("Error: mpfr_atanh(-1) <> -Inf\n");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.10001000001001011000100001E-6");
mpfr_atanh (x, x, GMP_RNDN);
mpfr_set_str_binary (y, "0.10001000001001100101010110100001E-6");
if (mpfr_cmp (x, y))
{
printf ("Error: mpfr_atanh (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "-0.1101011110111100111010011001011E-1");
mpfr_atanh (x, x, GMP_RNDN);
mpfr_set_str_binary (y, "-0.11100110000100001111101100010111E-1");
if (mpfr_cmp (x, y))
{
printf ("Error: mpfr_atanh (2)\n");
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 43);
mpfr_set_str_binary (x, "0.111001101100000110011001010000101");
mpfr_atanh (y, x, GMP_RNDZ);
mpfr_init2 (z, 43);
mpfr_set_str_binary (z, "1.01111010110001101001000000101101011110101");
if (mpfr_cmp (y, z))
{
printf ("Error: mpfr_atanh (3)\n");
mpfr_print_binary (y); printf ("\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
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);
}
int
mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact_sh, inexact_ch;
MPFR_ASSERTN (sh != ch);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg",
mpfr_get_prec (sh), mpfr_log_prec, sh,
mpfr_get_prec (ch), mpfr_log_prec, ch));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (ch);
MPFR_SET_NAN (sh);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (sh);
MPFR_SET_SAME_SIGN (sh, xt);
MPFR_SET_INF (ch);
MPFR_SET_POS (ch);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (sh); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (sh, xt);
inexact_sh = 0;
inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */
return INEX(inexact_sh,inexact_ch);
}
}
/* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure
that the code also works in case of overlap (see sin_cos.c) */
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t s, c, ti;
mpfr_exp_t d;
mpfr_prec_t N; /* Precision of the intermediary variables */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
N = MPFR_PREC (ch);
N = MAX (N, MPFR_PREC (sh));
/* the optimal number of bits : see algorithms.ps */
N = N + MPFR_INT_CEIL_LOG2 (N) + 4;
/* initialise of intermediary variables */
MPFR_GROUP_INIT_3 (group, N, s, c, ti);
/* First computation of sinh_cosh */
MPFR_ZIV_INIT (loop, N);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh_cosh */
MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* since cosh(x) >= exp(x), cosh(x) overflows too */
inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS);
/* sinh(x) may be representable */
inexact_sh = mpfr_sinh (sh, xt, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (s);
mpfr_ui_div (ti, 1, s, MPFR_RNDU); /* 1/exp(x) */
mpfr_add (c, s, ti, MPFR_RNDU); /* exp(x) + 1/exp(x) */
mpfr_sub (s, s, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* 1/2(exp(x) + 1/exp(x)) */
mpfr_div_2ui (s, s, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that s is zero (in fact, it can only occur when exp(x)=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (s))
err = N; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (s) + 2;
/* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = N - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh),
rnd_mode) && \
MPFR_CAN_ROUND (c, err, MPFR_PREC (ch),
rnd_mode)))
{
inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt));
inexact_ch = mpfr_set (ch, c, rnd_mode);
break;
}
}
/* actualisation of the precision */
N += err;
MPFR_ZIV_NEXT (loop, N);
MPFR_GROUP_REPREC_3 (group, N, s, c, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
/* now, let's raise the flags if needed */
inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode);
inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode);
return INEX(inexact_sh,inexact_ch);
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
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;
}
static void
check_1111 (void)
{
mpfr_t one;
long n;
mpfr_init2 (one, MPFR_PREC_MIN);
mpfr_set_ui (one, 1, MPFR_RNDN);
for (n = 0; n < NUM; n++)
{
mpfr_prec_t prec_a, prec_b, prec_c;
mpfr_exp_t tb=0, tc, diff;
mpfr_t a, b, c, s;
int m = 512;
int sb, sc;
int inex_a, inex_s;
mpfr_rnd_t rnd_mode;
prec_a = MPFR_PREC_MIN + (randlimb () % m);
prec_b = MPFR_PREC_MIN + (randlimb () % m);
prec_c = MPFR_PREC_MIN + (randlimb () % m);
mpfr_init2 (a, prec_a);
mpfr_init2 (b, prec_b);
mpfr_init2 (c, prec_c);
sb = randlimb () % 3;
if (sb != 0)
{
tb = 1 + (randlimb () % (prec_b - (sb != 2)));
mpfr_div_2ui (b, one, tb, MPFR_RNDN);
if (sb == 2)
mpfr_neg (b, b, MPFR_RNDN);
test_add (b, b, one, MPFR_RNDN);
}
else
mpfr_set (b, one, MPFR_RNDN);
tc = 1 + (randlimb () % (prec_c - 1));
mpfr_div_2ui (c, one, tc, MPFR_RNDN);
sc = randlimb () % 2;
if (sc)
mpfr_neg (c, c, MPFR_RNDN);
test_add (c, c, one, MPFR_RNDN);
diff = (randlimb () % (2*m)) - m;
mpfr_mul_2si (c, c, diff, MPFR_RNDN);
rnd_mode = RND_RAND ();
inex_a = test_add (a, b, c, rnd_mode);
mpfr_init2 (s, MPFR_PREC_MIN + 2*m);
inex_s = test_add (s, b, c, MPFR_RNDN); /* exact */
if (inex_s)
{
printf ("check_1111: result should have been exact.\n");
exit (1);
}
inex_s = mpfr_prec_round (s, prec_a, 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_1111: results are different.\n");
printf ("prec_a = %d, prec_b = %d, prec_c = %d\n",
(int) prec_a, (int) prec_b, (int) prec_c);
printf ("tb = %d, tc = %d, diff = %d, rnd = %s\n",
(int) tb, (int) tc, (int) diff,
mpfr_print_rnd_mode (rnd_mode));
printf ("sb = %d, sc = %d\n", sb, sc);
printf ("a = ");
mpfr_print_binary (a);
puts ("");
printf ("s = ");
mpfr_print_binary (s);
puts ("");
printf ("inex_a = %d, inex_s = %d\n", inex_a, inex_s);
exit (1);
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
mpfr_clear (s);
}
mpfr_clear (one);
}
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);
}
/* 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;
}
static void
large (mpfr_exp_t e)
{
mpfr_t x, y, z;
mpfr_exp_t emax;
int inex;
unsigned int flags;
emax = mpfr_get_emax ();
set_emax (e);
mpfr_init2 (x, 8);
mpfr_init2 (y, 8);
mpfr_init2 (z, 4);
mpfr_set_inf (x, 1);
mpfr_nextbelow (x);
mpfr_mul_2si (y, x, -1, MPFR_RNDU);
mpfr_prec_round (y, 4, MPFR_RNDU);
mpfr_clear_flags ();
inex = mpfr_mul_2si (z, x, -1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_mul_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2si (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2ui (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2ui\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
set_emax (emax);
}
int
mpfr_div_2exp (mpfr_ptr y, mpfr_srcptr x, unsigned long int n, mpfr_rnd_t rnd_mode)
{
return mpfr_div_2ui (y, x, n, rnd_mode);
}
int
main (int argc, char *argv[])
{
mpfr_t w,z;
unsigned long k;
int i;
tests_start_mpfr ();
mpfr_inits2 (53, w, z, (mpfr_ptr) 0);
for (i = 0; i < 3; i++)
{
mpfr_set_inf (w, 1);
test_mul (i, 0, w, w, 10, MPFR_RNDZ);
if (!MPFR_IS_INF(w))
{
printf ("Result is not Inf (i = %d)\n", i);
exit (1);
}
mpfr_set_nan (w);
test_mul (i, 0, w, w, 10, MPFR_RNDZ);
if (!MPFR_IS_NAN(w))
{
printf ("Result is not NaN (i = %d)\n", i);
exit (1);
}
for (k = 0 ; k < numberof(val) ; k+=3)
{
mpfr_set_str (w, val[k], 16, MPFR_RNDN);
test_mul (i, 0, z, w, 10, MPFR_RNDZ);
if (mpfr_cmp_str (z, val[k+1], 16, MPFR_RNDN))
{
printf ("ERROR for x * 2^n (i = %d) for %s\n", i, val[k]);
printf ("Expected: %s\n"
"Got : ", val[k+1]);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
putchar ('\n');
exit (1);
}
test_mul (i, 1, z, w, 10, MPFR_RNDZ);
if (mpfr_cmp_str (z, val[k+2], 16, MPFR_RNDN))
{
printf ("ERROR for x / 2^n (i = %d) for %s\n", i, val[k]);
printf ("Expected: %s\n"
"Got : ", val[k+2]);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
putchar ('\n');
exit (1);
}
}
mpfr_set_inf (w, 1);
mpfr_nextbelow (w);
test_mul (i, 0, w, w, 1, MPFR_RNDN);
if (!mpfr_inf_p (w))
{
printf ("Overflow error (i = %d)!\n", i);
exit (1);
}
mpfr_set_ui (w, 0, MPFR_RNDN);
mpfr_nextabove (w);
test_mul (i, 1, w, w, 1, MPFR_RNDN);
if (mpfr_cmp_ui (w, 0))
{
printf ("Underflow error (i = %d)!\n", i);
exit (1);
}
}
if (MPFR_EXP_MAX >= LONG_MAX/2 && MPFR_EXP_MIN <= LONG_MAX/2-LONG_MAX-1)
{
unsigned long lmp1 = (unsigned long) LONG_MAX + 1;
mpfr_set_ui (w, 1, MPFR_RNDN);
mpfr_mul_2ui (w, w, LONG_MAX/2, MPFR_RNDZ);
mpfr_div_2ui (w, w, lmp1, MPFR_RNDZ);
mpfr_mul_2ui (w, w, lmp1 - LONG_MAX/2, MPFR_RNDZ);
if (!mpfr_cmp_ui (w, 1))
{
printf ("Underflow LONG_MAX error!\n");
exit (1);
}
}
mpfr_clears (w, z, (mpfr_ptr) 0);
underflow0 ();
large0 ();
tests_end_mpfr ();
return 0;
}
/* hard test of rounding */
static void
check_rounding (void)
{
mpfr_t a, b, c, res;
mpfr_prec_t p;
long k, l;
int i;
#define MAXKL (2 * GMP_NUMB_BITS)
for (p = MPFR_PREC_MIN; p <= GMP_NUMB_BITS; p++)
{
mpfr_init2 (a, p);
mpfr_init2 (res, p);
mpfr_init2 (b, p + 1 + MAXKL);
mpfr_init2 (c, MPFR_PREC_MIN);
/* b = 2^p + 1 + 2^(-k), c = 2^(-l) */
for (k = 0; k <= MAXKL; k++)
for (l = 0; l <= MAXKL; l++)
{
mpfr_set_ui_2exp (b, 1, p, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_mul_2ui (b, b, k, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_div_2ui (b, b, k, MPFR_RNDN);
mpfr_set_ui_2exp (c, 1, -l, MPFR_RNDN);
i = mpfr_sub (a, b, c, MPFR_RNDN);
/* b - c = 2^p + 1 + 2^(-k) - 2^(-l), should be rounded to
2^p for l <= k, and 2^p+2 for l < k */
if (l <= k)
{
if (mpfr_cmp_ui_2exp (a, 1, p) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected 2^%lu\n", p);
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i >= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("a="); mpfr_print_binary (a); puts ("");
printf ("Expected < 0, got %d\n", i);
exit (1);
}
}
else /* l < k */
{
mpfr_set_ui_2exp (res, 1, p, MPFR_RNDN);
mpfr_add_ui (res, res, 2, MPFR_RNDN);
if (mpfr_cmp (a, res) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected "); mpfr_print_binary (res); puts ("");
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i <= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected > 0, got %d\n", i);
exit (1);
}
}
}
mpfr_clear (a);
mpfr_clear (res);
mpfr_clear (b);
mpfr_clear (c);
}
}
static void
underflow (mpfr_exp_t e)
{
mpfr_t x, y, z1, z2;
mpfr_exp_t emin;
int i, k;
int prec;
int rnd;
int div;
int inex1, inex2;
unsigned int flags1, flags2;
/* Test mul_2si(x, e - k), div_2si(x, k - e) and div_2ui(x, k - e)
* with emin = e, x = 1 + i/16, i in { -1, 0, 1 }, and k = 1 to 4,
* by comparing the result with the one of a simple division.
*/
emin = mpfr_get_emin ();
set_emin (e);
mpfr_inits2 (8, x, y, (mpfr_ptr) 0);
for (i = 15; i <= 17; i++)
{
inex1 = mpfr_set_ui_2exp (x, i, -4, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (prec = 6; prec >= 3; prec -= 3)
{
mpfr_inits2 (prec, z1, z2, (mpfr_ptr) 0);
RND_LOOP (rnd)
for (k = 1; k <= 4; k++)
{
/* The following one is assumed to be correct. */
inex1 = mpfr_mul_2si (y, x, e, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
inex1 = mpfr_set_ui (z1, 1 << k, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
mpfr_clear_flags ();
/* Do not use mpfr_div_ui to avoid the optimization
by mpfr_div_2si. */
inex1 = mpfr_div (z1, y, z1, (mpfr_rnd_t) rnd);
flags1 = __gmpfr_flags;
for (div = 0; div <= 2; div++)
{
mpfr_clear_flags ();
inex2 = div == 0 ?
mpfr_mul_2si (z2, x, e - k, (mpfr_rnd_t) rnd) : div == 1 ?
mpfr_div_2si (z2, x, k - e, (mpfr_rnd_t) rnd) :
mpfr_div_2ui (z2, x, k - e, (mpfr_rnd_t) rnd);
flags2 = __gmpfr_flags;
if (flags1 == flags2 && SAME_SIGN (inex1, inex2) &&
mpfr_equal_p (z1, z2))
continue;
printf ("Error in underflow(");
if (e == MPFR_EMIN_MIN)
printf ("MPFR_EMIN_MIN");
else if (e == emin)
printf ("default emin");
else
printf ("%ld", e);
printf (") with mpfr_%s,\nx = %d/16, prec = %d, k = %d, "
"%s\n", div == 0 ? "mul_2si" : div == 1 ?
"div_2si" : "div_2ui", i, prec, k,
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
printf ("Expected ");
mpfr_out_str (stdout, 16, 0, z1, MPFR_RNDN);
printf (", inex = %d, flags = %u\n", SIGN (inex1), flags1);
printf ("Got ");
mpfr_out_str (stdout, 16, 0, z2, MPFR_RNDN);
printf (", inex = %d, flags = %u\n", SIGN (inex2), flags2);
exit (1);
} /* div */
} /* k */
mpfr_clears (z1, z2, (mpfr_ptr) 0);
} /* prec */
} /* i */
mpfr_clears (x, y, (mpfr_ptr) 0);
set_emin (emin);
}
static void
special (void)
{
mpfr_t x, y;
int inex;
int sign;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lgamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != -1)
{
printf ("Error for lgamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, GMP_RNDN);
sign = -17;
mpfr_lgamma (x, &sign, y, GMP_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (120)\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("Got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
sign = -17;
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lgamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(0.1100E-66)\n");
printf ("Expected ");
mpfr_dump (x);
printf ("Got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_add_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != -1)
{
printf ("Error for lgamma(-2^199-0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("with sign %d instead of ", sign);
mpfr_dump (x);
printf ("with sign -1.\n");
exit (1);
}
mpfr_set_prec (x, 10);
mpfr_set_prec (y, 10);
mpfr_set_str_binary (x, "-0.1101111000E-3");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "10.01001011");
if (mpfr_equal_p (x, y) == 0 || sign != -1 || inex >= 0)
{
printf ("Error for lgamma(-0.1101111000E-3)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
printf ("with sign %d instead of -1 (inex=%d).\n", sign, inex);
exit (1);
}
mpfr_set_prec (x, 18);
mpfr_set_prec (y, 28);
mpfr_set_str_binary (x, "-1.10001101010001101e-196");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 28);
mpfr_set_str_binary (x, "0.100001110110101011011010011E8");
MPFR_ASSERTN (mpfr_equal_p (x, y) && inex < 0);
/* values reported by Kaveh Ghazi on 14 Jul 2007, where mpfr_lgamma()
takes forever */
#define VAL1 "-0.11100001001010110111001010001001001011110100110000110E-55"
#define OUT1 "100110.01000000010111001110110101110101001001100110111"
#define VAL2 "-0.11100001001010110111001010001001001011110011111111100E-55"
#define OUT2 "100110.0100000001011100111011010111010100100110011111"
#define VAL3 "-0.11100001001010110111001010001001001001110101101010100E-55"
#define OUT3 "100110.01000000010111001110110101110101001011110111011"
#define VAL4 "-0.10001111110110110100100100000000001111110001001001011E-57"
#define OUT4 "101000.0001010111110011101101000101111111010001100011"
#define VAL5 "-0.10001111110110110100100100000000001111011111100001000E-57"
#define OUT5 "101000.00010101111100111011010001011111110100111000001"
#define VAL6 "-0.10001111110110110100100100000000001111011101100011001E-57"
#define OUT6 "101000.0001010111110011101101000101111111010011101111"
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, VAL1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT1);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p(x, y));
mpfr_set_str_binary (x, VAL2);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT2);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL3);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT3);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL4);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT4);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL5);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT5);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL6);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT6);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* further test from Kaveh Ghazi */
mpfr_set_str_binary (x, "-0.10011010101001010010001110010111010111011101010111001E-53");
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "100101.00111101101010000000101010111010001111001101111");
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_clear (x);
mpfr_clear (y);
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", xt, xt, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mp_exp_t d;
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* compute sinh */
mpfr_clear_flags ();
mpfr_exp (t, x, GMP_RNDD); /* exp(x) */
/* exp(x) can overflow! */
/* BUG/TODO/FIXME: exp can overflow but sinh may be representable! */
if (MPFR_UNLIKELY (mpfr_overflow_p ())) {
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, GMP_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, GMP_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y), rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
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;
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, MPFR_RNDN);
mpfr_lngamma (x, y, MPFR_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (MPFR_IS_NAN (x) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (120)\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("Got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
inex = mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lngamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(0.1100E-66)\n");
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-2^199-0.5)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/* 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);
}
static int
mpfr_fsss (mpfr_ptr z, mpfr_srcptr a, mpfr_srcptr c, mpfr_rnd_t rnd)
{
/* Computes z = a^2 - c^2.
Assumes that a and c are finite and non-zero; so a squaring yielding
an infinity is an overflow, and a squaring yielding 0 is an underflow.
Assumes further that z is distinct from a and c. */
int inex;
mpfr_t u, v;
/* u=a^2, v=c^2 exactly */
mpfr_init2 (u, 2*mpfr_get_prec (a));
mpfr_init2 (v, 2*mpfr_get_prec (c));
mpfr_sqr (u, a, MPFR_RNDN);
mpfr_sqr (v, c, MPFR_RNDN);
/* tentatively compute z as u-v; here we need z to be distinct
from a and c to not lose the latter */
inex = mpfr_sub (z, u, v, rnd);
if (mpfr_inf_p (z)) {
/* replace by "correctly rounded overflow" */
mpfr_set_si (z, (mpfr_signbit (z) ? -1 : 1), MPFR_RNDN);
inex = mpfr_mul_2ui (z, z, mpfr_get_emax (), rnd);
}
else if (mpfr_zero_p (u) && !mpfr_zero_p (v)) {
/* exactly u underflowed, determine inexact flag */
inex = (mpfr_signbit (u) ? 1 : -1);
}
else if (mpfr_zero_p (v) && !mpfr_zero_p (u)) {
/* exactly v underflowed, determine inexact flag */
inex = (mpfr_signbit (v) ? -1 : 1);
}
else if (mpfr_nan_p (z) || (mpfr_zero_p (u) && mpfr_zero_p (v))) {
/* In the first case, u and v are +inf.
In the second case, u and v are zeroes; their difference may be 0
or the least representable number, with a sign to be determined.
Redo the computations with mpz_t exponents */
mpfr_exp_t ea, ec;
mpz_t eu, ev;
/* cheat to work around the const qualifiers */
/* Normalise the input by shifting and keep track of the shifts in
the exponents of u and v */
ea = mpfr_get_exp (a);
ec = mpfr_get_exp (c);
mpfr_set_exp ((mpfr_ptr) a, (mpfr_prec_t) 0);
mpfr_set_exp ((mpfr_ptr) c, (mpfr_prec_t) 0);
mpz_init (eu);
mpz_init (ev);
mpz_set_si (eu, (long int) ea);
mpz_mul_2exp (eu, eu, 1);
mpz_set_si (ev, (long int) ec);
mpz_mul_2exp (ev, ev, 1);
/* recompute u and v and move exponents to eu and ev */
mpfr_sqr (u, a, MPFR_RNDN);
/* exponent of u is non-positive */
mpz_sub_ui (eu, eu, (unsigned long int) (-mpfr_get_exp (u)));
mpfr_set_exp (u, (mpfr_prec_t) 0);
mpfr_sqr (v, c, MPFR_RNDN);
mpz_sub_ui (ev, ev, (unsigned long int) (-mpfr_get_exp (v)));
mpfr_set_exp (v, (mpfr_prec_t) 0);
if (mpfr_nan_p (z)) {
mpfr_exp_t emax = mpfr_get_emax ();
int overflow;
/* We have a = ma * 2^ea with 1/2 <= |ma| < 1 and ea <= emax.
So eu <= 2*emax, and eu > emax since we have
an overflow. The same holds for ev. Shift u and v by as much as
possible so that one of them has exponent emax and the
remaining exponents in eu and ev are the same. Then carry out
the addition. Shifting u and v prevents an underflow. */
if (mpz_cmp (eu, ev) >= 0) {
mpfr_set_exp (u, emax);
mpz_sub_ui (eu, eu, (long int) emax);
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_ui (ev));
/* remaining common exponent is now in eu */
}
else {
mpfr_set_exp (v, emax);
mpz_sub_ui (ev, ev, (long int) emax);
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_ui (eu));
mpz_set (eu, ev);
/* remaining common exponent is now also in eu */
}
inex = mpfr_sub (z, u, v, rnd);
/* Result is finite since u and v have the same sign. */
overflow = mpfr_mul_2ui (z, z, mpz_get_ui (eu), rnd);
if (overflow)
inex = overflow;
}
else {
int underflow;
/* Subtraction of two zeroes. We have a = ma * 2^ea
with 1/2 <= |ma| < 1 and ea >= emin and similarly for b.
So 2*emin < 2*emin+1 <= eu < emin < 0, and analogously for v. */
mpfr_exp_t emin = mpfr_get_emin ();
if (mpz_cmp (eu, ev) <= 0) {
mpfr_set_exp (u, emin);
mpz_add_ui (eu, eu, (unsigned long int) (-emin));
mpz_sub (ev, ev, eu);
mpfr_set_exp (v, (mpfr_exp_t) mpz_get_si (ev));
}
else {
mpfr_set_exp (v, emin);
mpz_add_ui (ev, ev, (unsigned long int) (-emin));
mpz_sub (eu, eu, ev);
mpfr_set_exp (u, (mpfr_exp_t) mpz_get_si (eu));
mpz_set (eu, ev);
}
inex = mpfr_sub (z, u, v, rnd);
mpz_neg (eu, eu);
underflow = mpfr_div_2ui (z, z, mpz_get_ui (eu), rnd);
if (underflow)
inex = underflow;
}
mpz_clear (eu);
mpz_clear (ev);
mpfr_set_exp ((mpfr_ptr) a, ea);
mpfr_set_exp ((mpfr_ptr) c, ec);
/* works also when a == c */
}
mpfr_clear (u);
mpfr_clear (v);
return inex;
}
