Beispiel #1
0
/* 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) */
}
Beispiel #2
0
/* 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. */
}
Beispiel #3
0
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);
}
Beispiel #4
0
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;
}
Beispiel #5
0
/* Don't need to save/restore exponent range: the cache does it */
int
mpfr_const_pi_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
  mpfr_t a, A, B, D, S;
  mpfr_prec_t px, p, cancel, k, kmax;
  MPFR_ZIV_DECL (loop);
  int inex;

  MPFR_LOG_FUNC
    (("rnd_mode=%d", rnd_mode),
     ("x[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(x), mpfr_log_prec, x, inex));

  px = MPFR_PREC (x);

  /* we need 9*2^kmax - 4 >= px+2*kmax+8 */
  for (kmax = 2; ((px + 2 * kmax + 12) / 9) >> kmax; kmax ++);

  p = px + 3 * kmax + 14; /* guarantees no recomputation for px <= 10000 */

  mpfr_init2 (a, p);
  mpfr_init2 (A, p);
  mpfr_init2 (B, p);
  mpfr_init2 (D, p);
  mpfr_init2 (S, p);

  MPFR_ZIV_INIT (loop, p);
  for (;;) {
    mpfr_set_ui (a, 1, MPFR_RNDN);          /* a = 1 */
    mpfr_set_ui (A, 1, MPFR_RNDN);          /* A = a^2 = 1 */
    mpfr_set_ui_2exp (B, 1, -1, MPFR_RNDN); /* B = b^2 = 1/2 */
    mpfr_set_ui_2exp (D, 1, -2, MPFR_RNDN); /* D = 1/4 */

#define b B
#define ap a
#define Ap A
#define Bp B
    for (k = 0; ; k++)
      {
        /* invariant: 1/2 <= B <= A <= a < 1 */
        mpfr_add (S, A, B, MPFR_RNDN); /* 1 <= S <= 2 */
        mpfr_div_2ui (S, S, 2, MPFR_RNDN); /* exact, 1/4 <= S <= 1/2 */
        mpfr_sqrt (b, B, MPFR_RNDN); /* 1/2 <= b <= 1 */
        mpfr_add (ap, a, b, MPFR_RNDN); /* 1 <= ap <= 2 */
        mpfr_div_2ui (ap, ap, 1, MPFR_RNDN); /* exact, 1/2 <= ap <= 1 */
        mpfr_mul (Ap, ap, ap, MPFR_RNDN); /* 1/4 <= Ap <= 1 */
        mpfr_sub (Bp, Ap, S, MPFR_RNDN); /* -1/4 <= Bp <= 3/4 */
        mpfr_mul_2ui (Bp, Bp, 1, MPFR_RNDN); /* -1/2 <= Bp <= 3/2 */
        mpfr_sub (S, Ap, Bp, MPFR_RNDN);
        MPFR_ASSERTN (mpfr_cmp_ui (S, 1) < 0);
        cancel = mpfr_cmp_ui (S, 0) ? (mpfr_uexp_t) -mpfr_get_exp(S) : p;
        /* MPFR_ASSERTN (cancel >= px || cancel >= 9 * (1 << k) - 4); */
        mpfr_mul_2ui (S, S, k, MPFR_RNDN);
        mpfr_sub (D, D, S, MPFR_RNDN);
        /* stop when |A_k - B_k| <= 2^(k-p) i.e. cancel >= p-k */
        if (cancel + k >= p)
          break;
      }
#undef b
#undef ap
#undef Ap
#undef Bp

      mpfr_div (A, B, D, MPFR_RNDN);

      /* MPFR_ASSERTN(p >= 2 * k + 8); */
      if (MPFR_LIKELY (MPFR_CAN_ROUND (A, p - 2 * k - 8, px, rnd_mode)))
        break;

      p += kmax;
      MPFR_ZIV_NEXT (loop, p);
      mpfr_set_prec (a, p);
      mpfr_set_prec (A, p);
      mpfr_set_prec (B, p);
      mpfr_set_prec (D, p);
      mpfr_set_prec (S, p);
  }
  MPFR_ZIV_FREE (loop);
  inex = mpfr_set (x, A, rnd_mode);

  mpfr_clear (a);
  mpfr_clear (A);
  mpfr_clear (B);
  mpfr_clear (D);
  mpfr_clear (S);

  return inex;
}
Beispiel #6
0
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);
}
Beispiel #7
0
/* (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 */
}
Beispiel #8
0
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;
}
Beispiel #9
0
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;
}
Beispiel #10
0
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;
            }
        }
Beispiel #11
0
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);
}
Beispiel #12
0
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);
}
Beispiel #13
0
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);
}
Beispiel #14
0
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);
}
Beispiel #15
0
/* 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;
}
Beispiel #16
0
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;
}
Beispiel #17
0
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);
}
Beispiel #18
0
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);
}
Beispiel #19
0
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
   from Abramowitz & Stegun).
   Assumes |z| > p log(2)/2, where p is the target precision
   (z can be negative only for jn).
   Return 0 if the expansion does not converge enough (the value 0 as inexact
   flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
  mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
  mpfr_prec_t w;
  long k;
  int inex, stop, diverge = 0;
  mpfr_exp_t err2, err;
  MPFR_ZIV_DECL (loop);

  mpfr_init (c);

  w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;

  MPFR_ZIV_INIT (loop, w);
  for (;;)
    {
      mpfr_set_prec (c, w);
      mpfr_init2 (s, w);
      mpfr_init2 (P, w);
      mpfr_init2 (Q, w);
      mpfr_init2 (t, w);
      mpfr_init2 (iz, w);
      mpfr_init2 (err_t, 31);
      mpfr_init2 (err_s, 31);
      mpfr_init2 (err_u, 31);

      /* Approximate sin(z) and cos(z). In the following, err <= k means that
         the approximate value y and the true value x are related by
         y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
      mpfr_sin_cos (s, c, z, MPFR_RNDN);
      if (MPFR_IS_NEG(z))
        mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
      /* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
      mpfr_add (t, s, c, MPFR_RNDN);
      mpfr_sub (c, s, c, MPFR_RNDN);
      mpfr_swap (s, t);
      /* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
         with total absolute error bounded by 2^(1-w). */

      /* precompute 1/(8|z|) */
      mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN);   /* err <= 1 */
      mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);

      /* compute P and Q */
      mpfr_set_ui (P, 1, MPFR_RNDN);
      mpfr_set_ui (Q, 0, MPFR_RNDN);
      mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
      mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
      mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
      for (k = 1, stop = 0; stop < 4; k++)
        {
          /* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
          mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
          mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
          mpfr_div_ui (t, t, k, MPFR_RNDN);               /* err <= err_k + 3 */
          mpfr_mul (t, t, iz, MPFR_RNDN);                 /* err <= err_k + 5 */
          /* the relative error on t is bounded by (1+u)^(5k)-1, which is
             bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
             for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
          mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
          mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
          /* the absolute error on t is bounded by err_t * 2^(-w) */
          mpfr_abs (err_u, t, MPFR_RNDU);
          mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
          mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
          if (stop >= 2)
            {
              /* take into account the neglected terms: t * 2^w */
              mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
              if (MPFR_IS_POS(t))
                mpfr_add (err_s, err_s, t, MPFR_RNDU);
              else
                mpfr_sub (err_s, err_s, t, MPFR_RNDU);
              mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
              stop ++;
            }
          /* if k is odd, add to Q, otherwise to P */
          else if (k & 1)
            {
              /* if k = 1 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (Q, Q, t, MPFR_RNDN);
              else
                mpfr_sub (Q, Q, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(Q): if EXP(err_u)
                 <= EXP(Q), since the current term is bounded by
                 err_u * 2^(-w), it is bounded by ulp(Q) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
                stop ++;
              else
                stop = 0;
            }
          else
            {
              /* if k = 0 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (P, P, t, MPFR_RNDN);
              else
                mpfr_sub (P, P, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(P) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(P))
                stop ++;
              else
                stop = 0;
            }
          mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
          /* the sum of the rounding errors on P and Q is bounded by
             err_s * 2^(-w) */

          /* stop when start to diverge */
          if (stop < 2 &&
              ((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
               (MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
            {
              /* if we have to stop the series because it diverges, then
                 increasing the precision will most probably fail, since
                 we will stop to the same point, and thus compute a very
                 similar approximation */
              diverge = 1;
              stop = 2; /* force stop */
            }
        }
      /* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */

      /* Now combine: the sum of the rounding errors on P and Q is bounded by
         err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
      if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
                                   Q * (sin + cos) + P (sin - cos) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_sub (s, s, c, MPFR_RNDN);
#else
          mpfr_add (s, s, c, MPFR_RNDN);
#endif
        }
      else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
                     Q * (sin - cos) - P (cos + sin) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_add (s, s, c, MPFR_RNDN);
#else
          mpfr_sub (s, c, s, MPFR_RNDN);
#endif
        }
      if ((n & 2) != 0)
        mpfr_neg (s, s, MPFR_RNDN);
      if (MPFR_EXP(s) > err)
        err = MPFR_EXP(s);
      /* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
         + err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
         <= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
         since |c|, |old_s| <= 2. */
      err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
      /* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
      err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
      /* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
      err2 = (err >= err2) ? err + 1 : err2 + 1;
      /* now the absolute error on s is bounded by 2^(err2 - w) */

      /* multiply by sqrt(1/(Pi*z)) */
      mpfr_const_pi (c, MPFR_RNDN);     /* Pi, err <= 1 */
      mpfr_mul (c, c, z, MPFR_RNDN);    /* err <= 2 */
      mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
      mpfr_sqrt (c, c, MPFR_RNDN);      /* err<=5/2, thus the absolute error is
                                          bounded by 3*u*|c| for |u| <= 0.25 */
      mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
      mpfr_abs (err_t, err_t, MPFR_RNDU);
      mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
      /* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
      err2 += MPFR_EXP(c);
      /* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
      mpfr_mul (c, c, s, MPFR_RNDN);    /* the absolute error on c is bounded by
                                          1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
                                          + |old_c| * 2^(err2 - w) */
      /* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
      err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
      /* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
      /* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
      err = (err >= err2) ? err + 1 : err2 + 1;
      /* the absolute error on c is bounded by 2^(err - w) */

      mpfr_clear (s);
      mpfr_clear (P);
      mpfr_clear (Q);
      mpfr_clear (t);
      mpfr_clear (iz);
      mpfr_clear (err_t);
      mpfr_clear (err_s);
      mpfr_clear (err_u);

      err -= MPFR_EXP(c);
      if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
        break;
      if (diverge != 0)
        {
          mpfr_set (c, z, r); /* will force inex=0 below, which means the
                               asymptotic expansion failed */
          break;
        }
      MPFR_ZIV_NEXT (loop, w);
    }
  MPFR_ZIV_FREE (loop);

  inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
    : mpfr_neg (res, c, r);
  mpfr_clear (c);

  return inex;
}
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);
}
Beispiel #21
0
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);
}
Beispiel #25
0
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);
}
Beispiel #26
0
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);
}
Beispiel #27
0
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;
}
Beispiel #28
0
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);
}
Beispiel #29
0
/* 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);
}
Beispiel #30
0
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;
}