예제 #1
0
/* the rounding mode is mpfr_rnd_t here since we return an mpfr number */
int
mpc_norm (mpfr_ptr a, mpc_srcptr b, mpfr_rnd_t rnd)
{
    mpfr_t u, v;
    mp_prec_t prec;
    int inexact, overflow;

    prec = MPFR_PREC(a);

    /* handling of special values; consistent with abs in that
       norm = abs^2; so norm (+-inf, nan) = norm (nan, +-inf) = +inf */
    if (   (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
            || (mpfr_inf_p (MPC_RE (b)) || mpfr_inf_p (MPC_IM (b))))
        return mpc_abs (a, b, rnd);

    mpfr_init (u);
    mpfr_init (v);

    if (!mpfr_zero_p(MPC_RE(b)) && !mpfr_zero_p(MPC_IM(b)) &&
            2 * SAFE_ABS (mp_exp_t, MPFR_EXP (MPC_RE (b)) - MPFR_EXP (MPC_IM (b)))
            > (mp_exp_t)prec)
        /* If real and imaginary part have very different magnitudes, then the */
        /* generic code increases the precision too much. Instead, compute the */
        /* squarings _exactly_.                                                */
    {
        mpfr_set_prec (u, 2 * MPFR_PREC (MPC_RE (b)));
        mpfr_set_prec (v, 2 * MPFR_PREC (MPC_IM (b)));
        mpfr_sqr (u, MPC_RE (b), GMP_RNDN);
        mpfr_sqr (v, MPC_IM (b), GMP_RNDN);
        inexact = mpfr_add (a, u, v, rnd);
    }
    else
    {
        do
        {
            prec += mpc_ceil_log2 (prec) + 3;

            mpfr_set_prec (u, prec);
            mpfr_set_prec (v, prec);

            inexact = mpfr_sqr (u, MPC_RE(b), GMP_RNDN);  /* err<=1/2ulp */
            inexact |= mpfr_sqr (v, MPC_IM(b), GMP_RNDN); /* err<=1/2ulp*/
            inexact |= mpfr_add (u, u, v, GMP_RNDN);      /* err <= 3/2 ulps */

            overflow = mpfr_inf_p (u);
        }
        while (!overflow && inexact &&
                mpfr_can_round (u, prec - 2, GMP_RNDN, rnd, MPFR_PREC(a)) == 0);

        inexact |= mpfr_set (a, u, rnd);
    }
    mpfr_clear (u);
    mpfr_clear (v);

    return inexact;
}
예제 #2
0
파일: asin.c 프로젝트: Gwenio/DragonFlyBSD
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;
}
예제 #3
0
파일: log10.c 프로젝트: BrianGladman/MPC
int
mpc_log10 (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
   int ok = 0, loops = 0, check_exact = 0, special_re, special_im,
       inex, inex_re, inex_im;
   mpfr_prec_t prec;
   mpfr_t log10;
   mpc_t log;

   mpfr_init2 (log10, 2);
   mpc_init2 (log, 2);
   prec = MPC_MAX_PREC (rop);
   /* compute log(op)/log(10) */
   while (ok == 0) {
      loops ++;
      prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
      mpfr_set_prec (log10, prec);
      mpc_set_prec (log, prec);

      inex = mpc_log (log, op, rnd); /* error <= 1 ulp */

      if (!mpfr_number_p (mpc_imagref (log))
         || mpfr_zero_p (mpc_imagref (log))) {
         /* no need to divide by log(10) */
         special_im = 1;
         ok = 1;
      }
      else {
         special_im = 0;
         mpfr_const_log10 (log10);
         mpfr_div (mpc_imagref (log), mpc_imagref (log), log10, MPFR_RNDN);

         ok = mpfr_can_round (mpc_imagref (log), prec - 2,
                  MPFR_RNDN, MPFR_RNDZ,
                  MPC_PREC_IM(rop) + (MPC_RND_IM (rnd) == MPFR_RNDN));
      }

      if (ok) {
         if (!mpfr_number_p (mpc_realref (log))
            || mpfr_zero_p (mpc_realref (log)))
            special_re = 1;
         else {
            special_re = 0;
            if (special_im)
               /* log10 not yet computed */
               mpfr_const_log10 (log10);
            mpfr_div (mpc_realref (log), mpc_realref (log), log10, MPFR_RNDN);
               /* error <= 24/7 ulp < 4 ulp for prec >= 4, see algorithms.tex */

            ok = mpfr_can_round (mpc_realref (log), prec - 2,
                     MPFR_RNDN, MPFR_RNDZ,
                     MPC_PREC_RE(rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
         }

         /* Special code to deal with cases where the real part of log10(x+i*y)
            is exact, like x=3 and y=1. Since Re(log10(x+i*y)) = log10(x^2+y^2)/2
            this happens whenever x^2+y^2 is a nonnegative power of 10.
            Indeed x^2+y^2 cannot equal 10^(a/2^b) for a, b integers, a odd, b>0,
            since x^2+y^2 is rational, and 10^(a/2^b) is irrational.
            Similarly, for b=0, x^2+y^2 cannot equal 10^a for a < 0 since x^2+y^2
            is a rational with denominator a power of 2.
            Now let x^2+y^2 = 10^s. Without loss of generality we can assume
            x = u/2^e and y = v/2^e with u, v, e integers: u^2+v^2 = 10^s*2^(2e)
            thus u^2+v^2 = 0 mod 2^(2e). By recurrence on e, necessarily
            u = v = 0 mod 2^e, thus x and y are necessarily integers.
         */
         if (!ok && !check_exact && mpfr_integer_p (mpc_realref (op)) &&
            mpfr_integer_p (mpc_imagref (op))) {
            mpz_t x, y;
            unsigned long s, v;

            check_exact = 1;
            mpz_init (x);
            mpz_init (y);
            mpfr_get_z (x, mpc_realref (op), MPFR_RNDN); /* exact */
            mpfr_get_z (y, mpc_imagref (op), MPFR_RNDN); /* exact */
            mpz_mul (x, x, x);
            mpz_mul (y, y, y);
            mpz_add (x, x, y); /* x^2+y^2 */
            v = mpz_scan1 (x, 0);
            /* if x = 10^s then necessarily s = v */
            s = mpz_sizeinbase (x, 10);
            /* since s is either the number of digits of x or one more,
               then x = 10^(s-1) or 10^(s-2) */
            if (s == v + 1 || s == v + 2) {
               mpz_div_2exp (x, x, v);
               mpz_ui_pow_ui (y, 5, v);
               if (mpz_cmp (y, x) == 0) {
                  /* Re(log10(x+i*y)) is exactly v/2
                     we reset the precision of Re(log) so that v can be
                     represented exactly */
                  mpfr_set_prec (mpc_realref (log),
                                 sizeof(unsigned long)*CHAR_BIT);
                  mpfr_set_ui_2exp (mpc_realref (log), v, -1, MPFR_RNDN);
                     /* exact */
                  ok = 1;
               }
            }
            mpz_clear (x);
            mpz_clear (y);
         }
      }
   }

   inex_re = mpfr_set (mpc_realref(rop), mpc_realref (log), MPC_RND_RE (rnd));
   if (special_re)
      inex_re = MPC_INEX_RE (inex);
      /* recover flag from call to mpc_log above */
   inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref (log), MPC_RND_IM (rnd));
   if (special_im)
      inex_im = MPC_INEX_IM (inex);
   mpfr_clear (log10);
   mpc_clear (log);

   return MPC_INEX(inex_re, inex_im);
}
예제 #4
0
파일: sqrt.c 프로젝트: 119/aircam-openwrt
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;
}
예제 #5
0
파일: sqr.c 프로젝트: BrianGladman/MPC
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
   int ok;
   mpfr_t u, v;
   mpfr_t x;
      /* temporary variable to hold the real part of op,
         needed in the case rop==op */
   mpfr_prec_t prec;
   int inex_re, inex_im, inexact;
   mpfr_exp_t emin;
   int saved_underflow;

   /* special values: NaN and infinities */
   if (!mpc_fin_p (op)) {
      if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
         mpfr_set_nan (mpc_realref (rop));
         mpfr_set_nan (mpc_imagref (rop));
      }
      else if (mpfr_inf_p (mpc_realref (op))) {
         if (mpfr_inf_p (mpc_imagref (op))) {
            mpfr_set_inf (mpc_imagref (rop),
                          MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
            mpfr_set_nan (mpc_realref (rop));
         }
         else {
            if (mpfr_zero_p (mpc_imagref (op)))
               mpfr_set_nan (mpc_imagref (rop));
            else
               mpfr_set_inf (mpc_imagref (rop),
                             MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
            mpfr_set_inf (mpc_realref (rop), +1);
         }
      }
      else /* IM(op) is infinity, RE(op) is not */ {
         if (mpfr_zero_p (mpc_realref (op)))
            mpfr_set_nan (mpc_imagref (rop));
         else
            mpfr_set_inf (mpc_imagref (rop),
                          MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
         mpfr_set_inf (mpc_realref (rop), -1);
      }
      return MPC_INEX (0, 0); /* exact */
   }

   prec = MPC_MAX_PREC(rop);

   /* Check for real resp. purely imaginary number */
   if (mpfr_zero_p (mpc_imagref(op))) {
      int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
      inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
      inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
      if (!same_sign)
        mpc_conj (rop, rop, MPC_RNDNN);
      return MPC_INEX(inex_re, inex_im);
   }
   if (mpfr_zero_p (mpc_realref(op))) {
      int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
      inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
      mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
      inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
      if (!same_sign)
        mpc_conj (rop, rop, MPC_RNDNN);
      return MPC_INEX(inex_re, inex_im);
   }

   if (rop == op)
   {
      mpfr_init2 (x, MPC_PREC_RE (op));
      mpfr_set (x, op->re, MPFR_RNDN);
   }
   else
      x [0] = op->re [0];
   /* From here on, use x instead of op->re and safely overwrite rop->re. */

   /* Compute real part of result. */
   if (SAFE_ABS (mpfr_exp_t,
                 mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
       > (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
      /* If the real and imaginary parts of the argument have very different
         exponents, it is not reasonable to use Karatsuba squaring; compute
         exactly with the standard formulae instead, even if this means an
         additional multiplication. Using the approach copied from mul, over-
         and underflows are also handled correctly. */

      inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
   }
   else {
      /* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
         imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
         naive algorithm, which computes x^2-y^2 and 2*y*y */
      mpfr_init (u);
      mpfr_init (v);

      emin = mpfr_get_emin ();

      do
      {
         prec += mpc_ceil_log2 (prec) + 5;

         mpfr_set_prec (u, prec);
         mpfr_set_prec (v, prec);

         /* Let op = x + iy. We need u = x+y and v = x-y, rounded away.      */
         /* The error is bounded above by 1 ulp.                             */
         /* We first let inexact be 1 if the real part is not computed       */
         /* exactly and determine the sign later.                            */
         inexact =   mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
                   | mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);

         /* compute the real part as u*v, rounded away                    */
         /* determine also the sign of inex_re                            */

         if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
            /* as we have rounded away, the result is exact */
            mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
            inex_re = 0;
            ok = 1;
         }
         else {
            inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
            if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
               /* under- or overflow */
               inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
               ok = 1;
            }
            else {
               ok = (!inexact) | mpfr_can_round (u, prec - 3,
                     MPFR_RNDA, MPFR_RNDZ,
                     MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
               if (ok) {
                  inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
                  if (inex_re == 0)
                     /* remember that u was already rounded */
                     inex_re = inexact;
               }
            }
         }
      }
      while (!ok);

      mpfr_clear (u);
      mpfr_clear (v);
   }

   saved_underflow = mpfr_underflow_p ();
   mpfr_clear_underflow ();
   inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
   if (!mpfr_underflow_p ())
      inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
      /* We must not multiply by 2 if rop->im has been set to the smallest
         representable number. */
   if (saved_underflow)
      mpfr_set_underflow ();

   if (rop == op)
      mpfr_clear (x);

   return MPC_INEX (inex_re, inex_im);
}
예제 #6
0
파일: div.c 프로젝트: BrianGladman/MPC
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
   int ok_re = 0, ok_im = 0;
   mpc_t res, c_conj;
   mpfr_t q;
   mpfr_prec_t prec;
   int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
   int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
   int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
   mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
   int saved_underflow, saved_overflow;
   int tmpsgn;
   mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
   mpc_t b_scaled, c_scaled;
   mpfr_t b_re, b_im, c_re, c_im;

   /* According to the C standard G.3, there are three types of numbers:   */
   /* finite (both parts are usual real numbers; contains 0), infinite     */
   /* (at least one part is a real infinity) and all others; the latter    */
   /* are numbers containing a nan, but no infinity, and could reasonably  */
   /* be called nan.                                                       */
   /* By G.5.1.4, infinite/finite=infinite; finite/infinite=0;             */
   /* all other divisions that are not finite/finite return nan+i*nan.     */
   /* Division by 0 could be handled by the following case of division by  */
   /* a real; we handle it separately instead.                             */
   if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
      return mpc_div_zero (a, b, c, rnd);
   else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
                                               and both Re(c) and Im(c) are ordinary */
         return mpc_div_inf_fin (a, b, c);
   else if (mpc_fin_p (b) && mpc_inf_p (c))
         return mpc_div_fin_inf (a, b, c);
   else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
      mpc_set_nan (a);
      return MPC_INEX (0, 0);
   }
   else if (mpfr_zero_p(mpc_imagref(c)))
      return mpc_div_real (a, b, c, rnd);
   else if (mpfr_zero_p(mpc_realref(c)))
      return mpc_div_imag (a, b, c, rnd);

   prec = MPC_MAX_PREC(a);

   mpc_init2 (res, 2);
   mpfr_init (q);

   /* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
      but one of Re(b) or Im(b) could be zero */

   e = mpfr_get_exp (mpc_realref (c));
   emin = emax = e;
   e = mpfr_get_exp (mpc_imagref (c));
   if (e > emax)
     emax = e;
   else if (e < emin)
     emin = e;
   if (!mpfr_zero_p (mpc_realref (b)))
     {
       e = mpfr_get_exp (mpc_realref (b));
       if (e > emax)
         emax = e;
       else if (e < emin)
         emin = e;
     }
   if (!mpfr_zero_p (mpc_imagref (b)))
     {
       e = mpfr_get_exp (mpc_imagref (b));
       if (e > emax)
         emax = e;
       else if (e < emin)
         emin = e;
     }

   /* all input exponents are in [emin, emax] */
   emid = emin / 2 + emax / 2;

   /* scale the inputs */
   b_re[0] = mpc_realref (b)[0];
   if (!mpfr_zero_p (mpc_realref (b)))
     MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
   b_im[0] = mpc_imagref (b)[0];
   if (!mpfr_zero_p (mpc_imagref (b)))
     MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
   c_re[0] = mpc_realref (c)[0];
   MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
   c_im[0] = mpc_imagref (c)[0];
   MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;

   /* create the scaled inputs without allocating new memory */
   mpc_realref (b_scaled)[0] = b_re[0];
   mpc_imagref (b_scaled)[0] = b_im[0];
   mpc_realref (c_scaled)[0] = c_re[0];
   mpc_imagref (c_scaled)[0] = c_im[0];

   /* create the conjugate of c in c_conj without allocating new memory */
   mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
   mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
   MPFR_CHANGE_SIGN (mpc_imagref (c_conj));

   /* save the underflow or overflow flags from MPFR */
   saved_underflow = mpfr_underflow_p ();
   saved_overflow = mpfr_overflow_p ();

   do {
      loops ++;
      prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;

      mpc_set_prec (res, prec);
      mpfr_set_prec (q, prec);

      /* first compute norm(c_scaled) */
      mpfr_clear_underflow ();
      mpfr_clear_overflow ();
      inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
      underflow_norm = mpfr_underflow_p ();
      overflow_norm = mpfr_overflow_p ();
      if (underflow_norm)
         mpfr_set_ui (q, 0ul, MPFR_RNDN);
         /* to obtain divisions by 0 later on */

      /* now compute b_scaled*conjugate(c_scaled) */
      mpfr_clear_underflow ();
      mpfr_clear_overflow ();
      inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
      inexact_re = MPC_INEX_RE (inexact_prod);
      inexact_im = MPC_INEX_IM (inexact_prod);
      underflow_prod = mpfr_underflow_p ();
      overflow_prod = mpfr_overflow_p ();
         /* unfortunately, does not distinguish between under-/overflow
            in real or imaginary parts
            hopefully, the side-effects of mpc_mul do indeed raise the
            mpfr exceptions */
      if (overflow_prod) {
        /* FIXME: in case overflow_norm is also true, the code below is wrong,
           since the after division by the norm, we might end up with finite
           real and/or imaginary parts. A workaround would be to scale the
           inputs (in case the exponents are within the same range). */
         int isinf = 0;
         /* determine if the real part of res is the maximum or the minimum
            representable number */
         tmpsgn = mpfr_sgn (mpc_realref(res));
         if (tmpsgn > 0)
           {
             mpfr_nextabove (mpc_realref(res));
             isinf = mpfr_inf_p (mpc_realref(res));
             mpfr_nextbelow (mpc_realref(res));
           }
         else if (tmpsgn < 0)
           {
             mpfr_nextbelow (mpc_realref(res));
             isinf = mpfr_inf_p (mpc_realref(res));
             mpfr_nextabove (mpc_realref(res));
           }
         if (isinf)
           {
             mpfr_set_inf (mpc_realref(res), tmpsgn);
             overflow_re = 1;
           }
         /* same for the imaginary part */
         tmpsgn = mpfr_sgn (mpc_imagref(res));
         isinf = 0;
         if (tmpsgn > 0)
           {
             mpfr_nextabove (mpc_imagref(res));
             isinf = mpfr_inf_p (mpc_imagref(res));
             mpfr_nextbelow (mpc_imagref(res));
           }
         else if (tmpsgn < 0)
           {
             mpfr_nextbelow (mpc_imagref(res));
             isinf = mpfr_inf_p (mpc_imagref(res));
             mpfr_nextabove (mpc_imagref(res));
           }
         if (isinf)
           {
             mpfr_set_inf (mpc_imagref(res), tmpsgn);
             overflow_im = 1;
           }
         mpc_set (a, res, rnd);
         goto end;
      }

      /* divide the product by the norm */
      if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
         /* The division has good chances to be exact in at least one part.  */
         /* Since this can cause problems when not rounding to the nearest,  */
         /* we use the division code of mpfr, which handles the situation.   */
         mpfr_clear_underflow ();
         mpfr_clear_overflow ();
         inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
         underflow_re = mpfr_underflow_p ();
         overflow_re = mpfr_overflow_p ();
         ok_re = !inexact_re || underflow_re || overflow_re
                 || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
                    MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));

         if (ok_re) /* compute imaginary part */ {
            mpfr_clear_underflow ();
            mpfr_clear_overflow ();
            inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
            underflow_im = mpfr_underflow_p ();
            overflow_im = mpfr_overflow_p ();
            ok_im = !inexact_im || underflow_im || overflow_im
                    || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
                       MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
         }
      }
      else {
         /* The division is inexact, so for efficiency reasons we invert q */
         /* only once and multiply by the inverse. */
         if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
             /* if 1/q is inexact, the approximations of the real and
                imaginary part below will be inexact, unless RE(res)
                or IM(res) is zero */
             inexact_re |= !mpfr_zero_p (mpc_realref (res));
             inexact_im |= !mpfr_zero_p (mpc_imagref (res));
         }
         mpfr_clear_underflow ();
         mpfr_clear_overflow ();
         inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
         underflow_re = mpfr_underflow_p ();
         overflow_re = mpfr_overflow_p ();
         ok_re = !inexact_re || underflow_re || overflow_re
                 || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
                    MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));

         if (ok_re) /* compute imaginary part */ {
            mpfr_clear_underflow ();
            mpfr_clear_overflow ();
            inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
            underflow_im = mpfr_underflow_p ();
            overflow_im = mpfr_overflow_p ();
            ok_im = !inexact_im || underflow_im || overflow_im
                    || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
                       MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
         }
      }
   } while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
                               && !underflow_prod && !overflow_prod);

   inex = mpc_set (a, res, rnd);
   inexact_re = MPC_INEX_RE (inex);
   inexact_im = MPC_INEX_IM (inex);

 end:
   /* fix values and inexact flags in case of overflow/underflow */
   /* FIXME: heuristic, certainly does not cover all cases */
   if (overflow_re || (underflow_norm && !underflow_prod)) {
      mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
      inexact_re = mpfr_sgn (mpc_realref (res));
   }
   else if (underflow_re || (overflow_norm && !overflow_prod)) {
      inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
      mpfr_set_zero (mpc_realref (a), -inexact_re);
   }
   if (overflow_im || (underflow_norm && !underflow_prod)) {
      mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
      inexact_im = mpfr_sgn (mpc_imagref (res));
   }
   else if (underflow_im || (overflow_norm && !overflow_prod)) {
      inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
      mpfr_set_zero (mpc_imagref (a), -inexact_im);
   }

   mpc_clear (res);
   mpfr_clear (q);

   /* restore underflow and overflow flags from MPFR */
   if (saved_underflow)
     mpfr_set_underflow ();
   if (saved_overflow)
     mpfr_set_overflow ();

   return MPC_INEX (inexact_re, inexact_im);
}
예제 #7
0
파일: log.c 프로젝트: Gwenio/DragonFlyBSD
int
mpc_log (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd){
   int ok, underflow = 0;
   mpfr_srcptr x, y;
   mpfr_t v, w;
   mpfr_prec_t prec;
   int loops;
   int re_cmp, im_cmp;
   int inex_re, inex_im;
   int err;
   mpfr_exp_t expw;
   int sgnw;

   /* special values: NaN and infinities */
   if (!mpc_fin_p (op)) {
      if (mpfr_nan_p (mpc_realref (op))) {
         if (mpfr_inf_p (mpc_imagref (op)))
            mpfr_set_inf (mpc_realref (rop), +1);
         else
            mpfr_set_nan (mpc_realref (rop));
         mpfr_set_nan (mpc_imagref (rop));
         inex_im = 0; /* Inf/NaN is exact */
      }
      else if (mpfr_nan_p (mpc_imagref (op))) {
         if (mpfr_inf_p (mpc_realref (op)))
            mpfr_set_inf (mpc_realref (rop), +1);
         else
            mpfr_set_nan (mpc_realref (rop));
         mpfr_set_nan (mpc_imagref (rop));
         inex_im = 0; /* Inf/NaN is exact */
      }
      else /* We have an infinity in at least one part. */ {
         inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
                               MPC_RND_IM (rnd));
         mpfr_set_inf (mpc_realref (rop), +1);
      }
      return MPC_INEX(0, inex_im);
   }

   /* special cases: real and purely imaginary numbers */
   re_cmp = mpfr_cmp_ui (mpc_realref (op), 0);
   im_cmp = mpfr_cmp_ui (mpc_imagref (op), 0);
   if (im_cmp == 0) {
      if (re_cmp == 0) {
         inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
                               MPC_RND_IM (rnd));
         mpfr_set_inf (mpc_realref (rop), -1);
         inex_re = 0; /* -Inf is exact */
      }
      else if (re_cmp > 0) {
         inex_re = mpfr_log (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
         inex_im = mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
      }
      else {
         /* op = x + 0*y; let w = -x = |x| */
         int negative_zero;
         mpfr_rnd_t rnd_im;

         negative_zero = mpfr_signbit (mpc_imagref (op));
         if (negative_zero)
            rnd_im = INV_RND (MPC_RND_IM (rnd));
         else
            rnd_im = MPC_RND_IM (rnd);
         w [0] = *mpc_realref (op);
         MPFR_CHANGE_SIGN (w);
         inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
         inex_im = mpfr_const_pi (mpc_imagref (rop), rnd_im);
         if (negative_zero) {
            mpc_conj (rop, rop, MPC_RNDNN);
            inex_im = -inex_im;
         }
      }
      return MPC_INEX(inex_re, inex_im);
   }
   else if (re_cmp == 0) {
      if (im_cmp > 0) {
         inex_re = mpfr_log (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE (rnd));
         inex_im = mpfr_const_pi (mpc_imagref (rop), MPC_RND_IM (rnd));
         /* division by 2 does not change the ternary flag */
         mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
      }
      else {
         w [0] = *mpc_imagref (op);
         MPFR_CHANGE_SIGN (w);
         inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
         inex_im = mpfr_const_pi (mpc_imagref (rop), INV_RND (MPC_RND_IM (rnd)));
         /* division by 2 does not change the ternary flag */
         mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
         mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
         inex_im = -inex_im; /* negate the ternary flag */
      }
      return MPC_INEX(inex_re, inex_im);
   }

   prec = MPC_PREC_RE(rop);
   mpfr_init2 (w, 2);
   /* let op = x + iy; log = 1/2 log (x^2 + y^2) + i atan2 (y, x)   */
   /* loop for the real part: 1/2 log (x^2 + y^2), fast, but unsafe */
   /* implementation                                                */
   ok = 0;
   for (loops = 1; !ok && loops <= 2; loops++) {
      prec += mpc_ceil_log2 (prec) + 4;
      mpfr_set_prec (w, prec);

      mpc_abs (w, op, GMP_RNDN);
         /* error 0.5 ulp */
      if (mpfr_inf_p (w))
         /* intermediate overflow; the logarithm may be representable.
            Intermediate underflow is impossible.                      */
         break;

      mpfr_log (w, w, GMP_RNDN);
         /* generic error of log: (2^(- exp(w)) + 0.5) ulp */

      if (mpfr_zero_p (w))
         /* impossible to round, switch to second algorithm */
         break;

      err = MPC_MAX (-mpfr_get_exp (w), 0) + 1;
         /* number of lost digits */
      ok = mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
         mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN));
   }

   if (!ok) {
      prec = MPC_PREC_RE(rop);
      mpfr_init2 (v, 2);
      /* compute 1/2 log (x^2 + y^2) = log |x| + 1/2 * log (1 + (y/x)^2)
            if |x| >= |y|; otherwise, exchange x and y                   */
      if (mpfr_cmpabs (mpc_realref (op), mpc_imagref (op)) >= 0) {
         x = mpc_realref (op);
         y = mpc_imagref (op);
      }
      else {
         x = mpc_imagref (op);
         y = mpc_realref (op);
      }

      do {
         prec += mpc_ceil_log2 (prec) + 4;
         mpfr_set_prec (v, prec);
         mpfr_set_prec (w, prec);

         mpfr_div (v, y, x, GMP_RNDD); /* error 1 ulp */
         mpfr_sqr (v, v, GMP_RNDD);
            /* generic error of multiplication:
               1 + 2*1*(2+1*2^(1-prec)) <= 5.0625 since prec >= 6 */
         mpfr_log1p (v, v, GMP_RNDD);
            /* error 1 + 4*5.0625 = 21.25 , see algorithms.tex */
         mpfr_div_2ui (v, v, 1, GMP_RNDD);
            /* If the result is 0, then there has been an underflow somewhere. */

         mpfr_abs (w, x, GMP_RNDN); /* exact */
         mpfr_log (w, w, GMP_RNDN); /* error 0.5 ulp */
         expw = mpfr_get_exp (w);
         sgnw = mpfr_signbit (w);

         mpfr_add (w, w, v, GMP_RNDN);
         if (!sgnw) /* v is positive, so no cancellation;
                       error 22.25 ulp; error counts lost bits */
            err = 5;
         else
            err =   MPC_MAX (5 + mpfr_get_exp (v),
                  /* 21.25 ulp (v) rewritten in ulp (result, now in w) */
                           -1 + expw             - mpfr_get_exp (w)
                  /* 0.5 ulp (previous w), rewritten in ulp (result) */
                  ) + 2;

         /* handle one special case: |x|=1, and (y/x)^2 underflows;
            then 1/2*log(x^2+y^2) \approx 1/2*y^2 also underflows.  */
         if (   (mpfr_cmp_si (x, -1) == 0 || mpfr_cmp_ui (x, 1) == 0)
             && mpfr_zero_p (w))
            underflow = 1;

      } while (!underflow &&
               !mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
               mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN)));
      mpfr_clear (v);
   }

   /* imaginary part */
   inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
                         MPC_RND_IM (rnd));

   /* set the real part; cannot be done before if rop==op */
   if (underflow)
      /* create underflow in result */
      inex_re = mpfr_set_ui_2exp (mpc_realref (rop), 1,
                                  mpfr_get_emin_min () - 2, MPC_RND_RE (rnd));
   else
      inex_re = mpfr_set (mpc_realref (rop), w, MPC_RND_RE (rnd));
   mpfr_clear (w);
   return MPC_INEX(inex_re, inex_im);
}
예제 #8
0
/* put in rop the value of exp(2*i*pi*k/n) rounded according to rnd */
int
mpc_rootofunity (mpc_ptr rop, unsigned long n, unsigned long k, mpc_rnd_t rnd)
{
   unsigned long g;
   mpq_t kn;
   mpfr_t t, s, c;
   mpfr_prec_t prec;
   int inex_re, inex_im;
   mpfr_rnd_t rnd_re, rnd_im;

   if (n == 0) {
      /* Compute exp (0 + i*inf). */
      mpfr_set_nan (mpc_realref (rop));
      mpfr_set_nan (mpc_imagref (rop));
      return MPC_INEX (0, 0);
   }

   /* Eliminate common denominator. */
   k %= n;
   g = gcd (k, n);
   k /= g;
   n /= g;

   /* Now 0 <= k < n and gcd(k,n)=1. */

   /* We assume that only n=1, 2, 3, 4, 6 and 12 may yield exact results
      and treat them separately; n=8 is also treated here for efficiency
      reasons. */
   if (n == 1)
     {
       /* necessarily k=0 thus we want exp(0)=1 */
       MPC_ASSERT (k == 0);
       return mpc_set_ui_ui (rop, 1, 0, rnd);
     }
   else if (n == 2)
     {
       /* since gcd(k,n)=1, necessarily k=1, thus we want exp(i*pi)=-1 */
       MPC_ASSERT (k == 1);
       return mpc_set_si_si (rop, -1, 0, rnd);
     }
   else if (n == 4)
     {
       /* since gcd(k,n)=1, necessarily k=1 or k=3, thus we want
          exp(2*i*pi/4)=i or exp(2*i*pi*3/4)=-i */
       MPC_ASSERT (k == 1 || k == 3);
       if (k == 1)
         return mpc_set_ui_ui (rop, 0, 1, rnd);
       else
         return mpc_set_si_si (rop, 0, -1, rnd);
     }
   else if (n == 3 || n == 6)
     {
       MPC_ASSERT ((n == 3 && (k == 1 || k == 2)) ||
                   (n == 6 && (k == 1 || k == 5)));
       /* for n=3, necessarily k=1 or k=2: -1/2+/-1/2*sqrt(3)*i;
          for n=6, necessarily k=1 or k=5: 1/2+/-1/2*sqrt(3)*i */
       inex_re = mpfr_set_si (mpc_realref (rop), (n == 3 ? -1 : 1),
                              MPC_RND_RE (rnd));
       /* inverse the rounding mode for -sqrt(3)/2 for zeta_3^2 and zeta_6^5 */
       rnd_im = MPC_RND_IM (rnd);
       if (k != 1)
         rnd_im = INV_RND (rnd_im);
       inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 3, rnd_im);
       mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
       if (k != 1)
         {
           mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
           inex_im = -inex_im;
         }
       return MPC_INEX (inex_re, inex_im);
     }
   else if (n == 12)
     {
       /* necessarily k=1, 5, 7, 11:
          k=1: 1/2*sqrt(3) + 1/2*I
          k=5: -1/2*sqrt(3) + 1/2*I
          k=7: -1/2*sqrt(3) - 1/2*I
          k=11: 1/2*sqrt(3) - 1/2*I */
       MPC_ASSERT (k == 1 || k == 5 || k == 7 || k == 11);
       /* inverse the rounding mode for -sqrt(3)/2 for zeta_12^5 and zeta_12^7 */
       rnd_re = MPC_RND_RE (rnd);
       if (k == 5 || k == 7)
         rnd_re = INV_RND (rnd_re);
       inex_re = mpfr_sqrt_ui (mpc_realref (rop), 3, rnd_re);
       inex_im = mpfr_set_si (mpc_imagref (rop), k < 6 ? 1 : -1,
                              MPC_RND_IM (rnd));
       mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
       if (k == 5 || k == 7)
         {
           mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
           inex_re = -inex_re;
         }
       return MPC_INEX (inex_re, inex_im);
     }
   else if (n == 8)
     {
       /* k=1, 3, 5 or 7:
          k=1: (1/2*I + 1/2)*sqrt(2)
          k=3: (1/2*I - 1/2)*sqrt(2)
          k=5: -(1/2*I + 1/2)*sqrt(2)
          k=7: -(1/2*I - 1/2)*sqrt(2) */
       MPC_ASSERT (k == 1 || k == 3 || k == 5 || k == 7);
       rnd_re = MPC_RND_RE (rnd);
       if (k == 3 || k == 5)
         rnd_re = INV_RND (rnd_re);
       rnd_im = MPC_RND_IM (rnd);
       if (k > 4)
         rnd_im = INV_RND (rnd_im);
       inex_re = mpfr_sqrt_ui (mpc_realref (rop), 2, rnd_re);
       inex_im = mpfr_sqrt_ui (mpc_imagref (rop), 2, rnd_im);
       mpc_div_2ui (rop, rop, 1, MPC_RNDNN);
       if (k == 3 || k == 5)
         {
           mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
           inex_re = -inex_re;
         }
       if (k > 4)
         {
           mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
           inex_im = -inex_im;
         }
       return MPC_INEX (inex_re, inex_im);
     }

   prec = MPC_MAX_PREC(rop);

   /* For the error analysis justifying the following algorithm,
      see algorithms.tex. */
   mpfr_init2 (t, 67);
   mpfr_init2 (s, 67);
   mpfr_init2 (c, 67);
   mpq_init (kn);
   mpq_set_ui (kn, k, n);
   mpq_mul_2exp (kn, kn, 1); /* kn=2*k/n < 2 */

   do {
      prec += mpc_ceil_log2 (prec) + 5; /* prec >= 6 */

      mpfr_set_prec (t, prec);
      mpfr_set_prec (s, prec);
      mpfr_set_prec (c, prec);

      mpfr_const_pi (t, MPFR_RNDN);
      mpfr_mul_q (t, t, kn, MPFR_RNDN);
      mpfr_sin_cos (s, c, t, MPFR_RNDN);
   }
   while (   !mpfr_can_round (c, prec - (4 - mpfr_get_exp (c)),
                 MPFR_RNDN, MPFR_RNDZ,
                 MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN))
          || !mpfr_can_round (s, prec - (4 - mpfr_get_exp (s)),
                 MPFR_RNDN, MPFR_RNDZ,
                 MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN)));

   inex_re = mpfr_set (mpc_realref(rop), c, MPC_RND_RE(rnd));
   inex_im = mpfr_set (mpc_imagref(rop), s, MPC_RND_IM(rnd));

   mpfr_clear (t);
   mpfr_clear (s);
   mpfr_clear (c);
   mpq_clear (kn);

   return MPC_INEX(inex_re, inex_im);
}
예제 #9
0
파일: tan.c 프로젝트: Distrotech/mpc
int
mpc_tan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
  mpc_t x, y;
  mpfr_prec_t prec;
  mpfr_exp_t err;
  int ok = 0;
  int inex;

  /* special values */
  if (!mpc_fin_p (op))
    {
      if (mpfr_nan_p (mpc_realref (op)))
        {
          if (mpfr_inf_p (mpc_imagref (op)))
            /* tan(NaN -i*Inf) = +/-0 -i */
            /* tan(NaN +i*Inf) = +/-0 +i */
            {
              /* exact unless 1 is not in exponent range */
              inex = mpc_set_si_si (rop, 0,
                                    (MPFR_SIGN (mpc_imagref (op)) < 0) ? -1 : +1,
                                    rnd);
            }
          else
            /* tan(NaN +i*y) = NaN +i*NaN, when y is finite */
            /* tan(NaN +i*NaN) = NaN +i*NaN */
            {
              mpfr_set_nan (mpc_realref (rop));
              mpfr_set_nan (mpc_imagref (rop));
              inex = MPC_INEX (0, 0); /* always exact */
            }
        }
      else if (mpfr_nan_p (mpc_imagref (op)))
        {
          if (mpfr_cmp_ui (mpc_realref (op), 0) == 0)
            /* tan(-0 +i*NaN) = -0 +i*NaN */
            /* tan(+0 +i*NaN) = +0 +i*NaN */
            {
              mpc_set (rop, op, rnd);
              inex = MPC_INEX (0, 0); /* always exact */
            }
          else
            /* tan(x +i*NaN) = NaN +i*NaN, when x != 0 */
            {
              mpfr_set_nan (mpc_realref (rop));
              mpfr_set_nan (mpc_imagref (rop));
              inex = MPC_INEX (0, 0); /* always exact */
            }
        }
      else if (mpfr_inf_p (mpc_realref (op)))
        {
          if (mpfr_inf_p (mpc_imagref (op)))
            /* tan(-Inf -i*Inf) = -/+0 -i */
            /* tan(-Inf +i*Inf) = -/+0 +i */
            /* tan(+Inf -i*Inf) = +/-0 -i */
            /* tan(+Inf +i*Inf) = +/-0 +i */
            {
              const int sign_re = mpfr_signbit (mpc_realref (op));
              int inex_im;

              mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
              mpfr_setsign (mpc_realref (rop), mpc_realref (rop), sign_re, MPFR_RNDN);

              /* exact, unless 1 is not in exponent range */
              inex_im = mpfr_set_si (mpc_imagref (rop),
                                     mpfr_signbit (mpc_imagref (op)) ? -1 : +1,
                                     MPC_RND_IM (rnd));
              inex = MPC_INEX (0, inex_im);
            }
          else
            /* tan(-Inf +i*y) = tan(+Inf +i*y) = NaN +i*NaN, when y is
               finite */
            {
              mpfr_set_nan (mpc_realref (rop));
              mpfr_set_nan (mpc_imagref (rop));
              inex = MPC_INEX (0, 0); /* always exact */
            }
        }
      else
        /* tan(x -i*Inf) = +0*sin(x)*cos(x) -i, when x is finite */
        /* tan(x +i*Inf) = +0*sin(x)*cos(x) +i, when x is finite */
        {
          mpfr_t c;
          mpfr_t s;
          int inex_im;

          mpfr_init (c);
          mpfr_init (s);

          mpfr_sin_cos (s, c, mpc_realref (op), MPFR_RNDN);
          mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
          mpfr_setsign (mpc_realref (rop), mpc_realref (rop),
                        mpfr_signbit (c) != mpfr_signbit (s), MPFR_RNDN);
          /* exact, unless 1 is not in exponent range */
          inex_im = mpfr_set_si (mpc_imagref (rop),
                                 (mpfr_signbit (mpc_imagref (op)) ? -1 : +1),
                                 MPC_RND_IM (rnd));
          inex = MPC_INEX (0, inex_im);

          mpfr_clear (s);
          mpfr_clear (c);
        }

      return inex;
    }

  if (mpfr_zero_p (mpc_realref (op)))
    /* tan(-0 -i*y) = -0 +i*tanh(y), when y is finite. */
    /* tan(+0 +i*y) = +0 +i*tanh(y), when y is finite. */
    {
      int inex_im;

      mpfr_set (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
      inex_im = mpfr_tanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));

      return MPC_INEX (0, inex_im);
    }

  if (mpfr_zero_p (mpc_imagref (op)))
    /* tan(x -i*0) = tan(x) -i*0, when x is finite. */
    /* tan(x +i*0) = tan(x) +i*0, when x is finite. */
    {
      int inex_re;

      inex_re = mpfr_tan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
      mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));

      return MPC_INEX (inex_re, 0);
    }

  /* ordinary (non-zero) numbers */

  /* tan(op) = sin(op) / cos(op).

     We use the following algorithm with rounding away from 0 for all
     operations, and working precision w:

     (1) x = A(sin(op))
     (2) y = A(cos(op))
     (3) z = A(x/y)

     the error on Im(z) is at most 81 ulp,
     the error on Re(z) is at most
     7 ulp if k < 2,
     8 ulp if k = 2,
     else 5+k ulp, where
     k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
     see proof in algorithms.tex.
  */

  prec = MPC_MAX_PREC(rop);

  mpc_init2 (x, 2);
  mpc_init2 (y, 2);

  err = 7;

  do
    {
      mpfr_exp_t k, exr, eyr, eyi, ezr;

      ok = 0;

      /* FIXME: prevent addition overflow */
      prec += mpc_ceil_log2 (prec) + err;
      mpc_set_prec (x, prec);
      mpc_set_prec (y, prec);

      /* rounding away from zero: except in the cases x=0 or y=0 (processed
         above), sin x and cos y are never exact, so rounding away from 0 is
         rounding towards 0 and adding one ulp to the absolute value */
      mpc_sin_cos (x, y, op, MPC_RNDZZ, MPC_RNDZZ);
      MPFR_ADD_ONE_ULP (mpc_realref (x));
      MPFR_ADD_ONE_ULP (mpc_imagref (x));
      MPFR_ADD_ONE_ULP (mpc_realref (y));
      MPFR_ADD_ONE_ULP (mpc_imagref (y));
      MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);

      if (   mpfr_inf_p (mpc_realref (x)) || mpfr_inf_p (mpc_imagref (x))
          || mpfr_inf_p (mpc_realref (y)) || mpfr_inf_p (mpc_imagref (y))) {
         /* If the real or imaginary part of x is infinite, it means that
            Im(op) was large, in which case the result is
            sign(tan(Re(op)))*0 + sign(Im(op))*I,
            where sign(tan(Re(op))) = sign(Re(x))*sign(Re(y)). */
          int inex_re, inex_im;
          mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
          if (mpfr_sgn (mpc_realref (x)) * mpfr_sgn (mpc_realref (y)) < 0)
            {
              mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
              inex_re = 1;
            }
          else
            inex_re = -1; /* +0 is rounded down */
          if (mpfr_sgn (mpc_imagref (op)) > 0)
            {
              mpfr_set_ui (mpc_imagref (rop), 1, MPFR_RNDN);
              inex_im = 1;
            }
          else
            {
              mpfr_set_si (mpc_imagref (rop), -1, MPFR_RNDN);
              inex_im = -1;
            }
          inex = MPC_INEX(inex_re, inex_im);
          goto end;
        }

      exr = mpfr_get_exp (mpc_realref (x));
      eyr = mpfr_get_exp (mpc_realref (y));
      eyi = mpfr_get_exp (mpc_imagref (y));

      /* some parts of the quotient may be exact */
      inex = mpc_div (x, x, y, MPC_RNDZZ);
      /* OP is no pure real nor pure imaginary, so in theory the real and
         imaginary parts of its tangent cannot be null. However due to
         rouding errors this might happen. Consider for example
         tan(1+14*I) = 1.26e-10 + 1.00*I. For small precision sin(op) and
         cos(op) differ only by a factor I, thus after mpc_div x = I and
         its real part is zero. */
      if (mpfr_zero_p (mpc_realref (x)) || mpfr_zero_p (mpc_imagref (x)))
        {
          err = prec; /* double precision */
          continue;
        }
      if (MPC_INEX_RE (inex))
         MPFR_ADD_ONE_ULP (mpc_realref (x));
      if (MPC_INEX_IM (inex))
         MPFR_ADD_ONE_ULP (mpc_imagref (x));
      MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
      ezr = mpfr_get_exp (mpc_realref (x));

      /* FIXME: compute
         k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
         avoiding overflow */
      k = exr - ezr + MPC_MAX(-eyr, eyr - 2 * eyi);
      err = k < 2 ? 7 : (k == 2 ? 8 : (5 + k));

      /* Can the real part be rounded? */
      ok = (!mpfr_number_p (mpc_realref (x)))
           || mpfr_can_round (mpc_realref(x), prec - err, MPFR_RNDN, MPFR_RNDZ,
                      MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN));

      if (ok)
        {
          /* Can the imaginary part be rounded? */
          ok = (!mpfr_number_p (mpc_imagref (x)))
               || mpfr_can_round (mpc_imagref(x), prec - 6, MPFR_RNDN, MPFR_RNDZ,
                      MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN));
        }
    }
  while (ok == 0);

  inex = mpc_set (rop, x, rnd);

 end:
  mpc_clear (x);
  mpc_clear (y);

  return inex;
}
예제 #10
0
파일: exp.c 프로젝트: Gwenio/DragonFlyBSD
int
mpc_exp (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
  mpfr_t x, y, z;
  mpfr_prec_t prec;
  int ok = 0;
  int inex_re, inex_im;
  int saved_underflow, saved_overflow;

  /* special values */
  if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
    /* NaNs
       exp(nan +i*y) = nan -i*0   if y = -0,
                       nan +i*0   if y = +0,
                       nan +i*nan otherwise
       exp(x+i*nan) =   +/-0 +/-i*0 if x=-inf,
                      +/-inf +i*nan if x=+inf,
                         nan +i*nan otherwise */
    {
      if (mpfr_zero_p (mpc_imagref (op)))
        return mpc_set (rop, op, MPC_RNDNN);

      if (mpfr_inf_p (mpc_realref (op)))
        {
          if (mpfr_signbit (mpc_realref (op)))
            return mpc_set_ui_ui (rop, 0, 0, MPC_RNDNN);
          else
            {
              mpfr_set_inf (mpc_realref (rop), +1);
              mpfr_set_nan (mpc_imagref (rop));
              return MPC_INEX(0, 0); /* Inf/NaN are exact */
            }
        }
      mpfr_set_nan (mpc_realref (rop));
      mpfr_set_nan (mpc_imagref (rop));
      return MPC_INEX(0, 0); /* NaN is exact */
    }


  if (mpfr_zero_p (mpc_imagref(op)))
    /* special case when the input is real
       exp(x-i*0) = exp(x) -i*0, even if x is NaN
       exp(x+i*0) = exp(x) +i*0, even if x is NaN */
    {
      inex_re = mpfr_exp (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
      inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref(op), MPC_RND_IM(rnd));
      return MPC_INEX(inex_re, inex_im);
    }

  if (mpfr_zero_p (mpc_realref (op)))
    /* special case when the input is imaginary  */
    {
      inex_re = mpfr_cos (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE(rnd));
      inex_im = mpfr_sin (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM(rnd));
      return MPC_INEX(inex_re, inex_im);
    }


  if (mpfr_inf_p (mpc_realref (op)))
    /* real part is an infinity,
       exp(-inf +i*y) = 0*(cos y +i*sin y)
       exp(+inf +i*y) = +/-inf +i*nan         if y = +/-inf
                        +inf*(cos y +i*sin y) if 0 < |y| < inf */
    {
      mpfr_t n;

      mpfr_init2 (n, 2);
      if (mpfr_signbit (mpc_realref (op)))
        mpfr_set_ui (n, 0, GMP_RNDN);
      else
        mpfr_set_inf (n, +1);

      if (mpfr_inf_p (mpc_imagref (op)))
        {
          inex_re = mpfr_set (mpc_realref (rop), n, GMP_RNDN);
          if (mpfr_signbit (mpc_realref (op)))
            inex_im = mpfr_set (mpc_imagref (rop), n, GMP_RNDN);
          else
            {
              mpfr_set_nan (mpc_imagref (rop));
              inex_im = 0; /* NaN is exact */
            }
        }
      else
        {
          mpfr_t c, s;
          mpfr_init2 (c, 2);
          mpfr_init2 (s, 2);

          mpfr_sin_cos (s, c, mpc_imagref (op), GMP_RNDN);
          inex_re = mpfr_copysign (mpc_realref (rop), n, c, GMP_RNDN);
          inex_im = mpfr_copysign (mpc_imagref (rop), n, s, GMP_RNDN);

          mpfr_clear (s);
          mpfr_clear (c);
        }

      mpfr_clear (n);
      return MPC_INEX(inex_re, inex_im);
    }

  if (mpfr_inf_p (mpc_imagref (op)))
    /* real part is finite non-zero number, imaginary part is an infinity */
    {
      mpfr_set_nan (mpc_realref (rop));
      mpfr_set_nan (mpc_imagref (rop));
      return MPC_INEX(0, 0); /* NaN is exact */
    }


  /* from now on, both parts of op are regular numbers */

  prec = MPC_MAX_PREC(rop)
         + MPC_MAX (MPC_MAX (-mpfr_get_exp (mpc_realref (op)), 0),
                   -mpfr_get_exp (mpc_imagref (op)));
    /* When op is close to 0, then exp is close to 1+Re(op), while
       cos is close to 1-Im(op); to decide on the ternary value of exp*cos,
       we need a high enough precision so that none of exp or cos is
       computed as 1. */
  mpfr_init2 (x, 2);
  mpfr_init2 (y, 2);
  mpfr_init2 (z, 2);

  /* save the underflow or overflow flags from MPFR */
  saved_underflow = mpfr_underflow_p ();
  saved_overflow = mpfr_overflow_p ();

  do
    {
      prec += mpc_ceil_log2 (prec) + 5;

      mpfr_set_prec (x, prec);
      mpfr_set_prec (y, prec);
      mpfr_set_prec (z, prec);

      /* FIXME: x may overflow so x.y does overflow too, while Re(exp(op))
         could be represented in the precision of rop. */
      mpfr_clear_overflow ();
      mpfr_clear_underflow ();
      mpfr_exp (x, mpc_realref(op), GMP_RNDN); /* error <= 0.5ulp */
      mpfr_sin_cos (z, y, mpc_imagref(op), GMP_RNDN); /* errors <= 0.5ulp */
      mpfr_mul (y, y, x, GMP_RNDN); /* error <= 2ulp */
      ok = mpfr_overflow_p () || mpfr_zero_p (x)
        || mpfr_can_round (y, prec - 2, GMP_RNDN, GMP_RNDZ,
                       MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == GMP_RNDN));
      if (ok) /* compute imaginary part */
        {
          mpfr_mul (z, z, x, GMP_RNDN);
          ok = mpfr_overflow_p () || mpfr_zero_p (x)
            || mpfr_can_round (z, prec - 2, GMP_RNDN, GMP_RNDZ,
                       MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == GMP_RNDN));
        }
    }
  while (ok == 0);

  inex_re = mpfr_set (mpc_realref(rop), y, MPC_RND_RE(rnd));
  inex_im = mpfr_set (mpc_imagref(rop), z, MPC_RND_IM(rnd));
  if (mpfr_overflow_p ()) {
    /* overflow in real exponential, inex is sign of infinite result */
    inex_re = mpfr_sgn (y);
    inex_im = mpfr_sgn (z);
  }
  else if (mpfr_underflow_p ()) {
    /* underflow in real exponential, inex is opposite of sign of 0 result */
    inex_re = (mpfr_signbit (y) ? +1 : -1);
    inex_im = (mpfr_signbit (z) ? +1 : -1);
  }

  mpfr_clear (x);
  mpfr_clear (y);
  mpfr_clear (z);

  /* restore underflow and overflow flags from MPFR */
  if (saved_underflow)
    mpfr_set_underflow ();
  if (saved_overflow)
    mpfr_set_overflow ();

  return MPC_INEX(inex_re, inex_im);
}
예제 #11
0
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
    int s_re;
    int s_im;
    int inex_re;
    int inex_im;
    int inex;

    inex_re = 0;
    inex_im = 0;
    s_re = mpfr_signbit (mpc_realref (op));
    s_im = mpfr_signbit (mpc_imagref (op));

    /* special values */
    if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
    {
        if (mpfr_nan_p (mpc_realref (op)))
        {
            mpfr_set_nan (mpc_realref (rop));
            if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
            {
                mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
                if (s_im)
                    mpc_conj (rop, rop, MPC_RNDNN);
            }
            else
                mpfr_set_nan (mpc_imagref (rop));
        }
        else
        {
            if (mpfr_inf_p (mpc_realref (op)))
            {
                inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
                mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
            }
            else
            {
                mpfr_set_nan (mpc_realref (rop));
                mpfr_set_nan (mpc_imagref (rop));
            }
        }
        return MPC_INEX (inex_re, 0);
    }

    if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
    {
        inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));

        mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
        if (s_im)
            mpc_conj (rop, rop, GMP_RNDN);

        return MPC_INEX (inex_re, 0);
    }

    /* pure real argument */
    if (mpfr_zero_p (mpc_imagref (op)))
    {
        inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));

        mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
        if (s_im)
            mpc_conj (rop, rop, GMP_RNDN);

        return MPC_INEX (inex_re, 0);
    }

    /* pure imaginary argument */
    if (mpfr_zero_p (mpc_realref (op)))
    {
        int cmp_1;

        if (s_im)
            cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
        else
            cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);

        if (cmp_1 < 0)
        {
            /* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
               atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */

            mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
            if (s_re)
                mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);

            inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
        }
        else if (cmp_1 == 0)
        {
            /* atan(+/-0+i) = NaN +i*inf
               atan(+/-0-i) = NaN -i*inf */
            mpfr_set_nan (mpc_realref (rop));
            mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
        }
        else
        {
            /* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
               atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
            mpfr_rnd_t rnd_im, rnd_away;
            mpfr_t y;
            mpfr_prec_t p, p_im;
            int ok;

            rnd_im = MPC_RND_IM (rnd);
            mpfr_init (y);
            p_im = mpfr_get_prec (mpc_imagref (rop));
            p = p_im;

            /* a = o(1/y)      with error(a) < 1 ulp(a)
               b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)

               As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
               2 bits of precision are lost.

               We round atanh(1/y) away from 0.
            */
            do
            {
                p += mpc_ceil_log2 (p) + 2;
                mpfr_set_prec (y, p);
                rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
                inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
                /* FIXME: should we consider the case with unreasonably huge
                   precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
                   representable while 1/Im(op) underflows ?
                   This corresponds to |y| = 0.5*2^emin, in which case the
                   result may be wrong. */

                /* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
                inex_im |= mpfr_atanh (y, y, rnd_away);

                ok = inex_im == 0
                     || mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
                                        p_im + (rnd_im == GMP_RNDN));
            } while (ok == 0);

            inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
            inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
            mpfr_clear (y);
        }
        return MPC_INEX (inex_re, inex_im);
    }

    /* regular number argument */
    {
        mpfr_t a, b, x, y;
        mpfr_prec_t prec, p;
        mpfr_exp_t err, expo;
        int ok = 0;
        mpfr_t minus_op_re;
        mpfr_exp_t op_re_exp, op_im_exp;
        mpfr_rnd_t rnd1, rnd2;

        mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);

        /* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
        minus_op_re[0] = mpc_realref (op)[0];
        MPFR_CHANGE_SIGN (minus_op_re);
        op_re_exp = mpfr_get_exp (mpc_realref (op));
        op_im_exp = mpfr_get_exp (mpc_imagref (op));

        prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */

        /* a = o(1-y)         error(a) < 1 ulp(a)
           b = o(atan2(x,a))  error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
                                         = kb ulp(b)
           c = o(1+y)         error(c) < 1 ulp(c)
           d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
                                         = kd ulp(d)
           e = o(b - d)       error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
                                            + kd*2^{Exp(d)-Exp(e)}] ulp(e)
                              error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
                                            + 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
                              because |atan(u)| < |u|
                                       < [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
                                                 -Exp(e)}] ulp(e)
           f = e/2            exact
        */

        /* p: working precision */
        p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
            : (prec - op_im_exp);
        rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
        rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;

        do
        {
            p += mpc_ceil_log2 (p) + 2;
            mpfr_set_prec (a, p);
            mpfr_set_prec (b, p);
            mpfr_set_prec (x, p);

            /* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
               need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
               x positive, and an upper bound on 1-y for x negative */
            mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
            if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
                                  expo will be 1 or 2 below */
            {
                MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
                /* check for intermediate underflow */
                err = 2; /* ensures err will be expo below */
            }
            else
                err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
            mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);

            /* b = lower bound for atan (-x/(1+y)): for x negative, we need a
               lower bound on -x/(1+y), i.e., an upper bound on 1+y */
            mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
            /* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
               and we can simply ignore the terms involving Exp(a) in the error */
            if (mpfr_sgn (a) == 0)
            {
                MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
                /* check for intermediate underflow */
                expo = err; /* will leave err unchanged below */
            }
            else
                expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
            mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);

            err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
            mpfr_sub (x, x, b, GMP_RNDU);

            err = 5 + op_re_exp - err - mpfr_get_exp (x);
            /* error is bounded by [1 + 2^err] ulp(e) */
            err = err < 0 ? 1 : err + 1;

            mpfr_div_2ui (x, x, 1, GMP_RNDU);

            /* Note: using RND2=RNDD guarantees that if x is exactly representable
               on prec + ... bits, mpfr_can_round will return 0 */
            ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
                                 prec + (MPC_RND_RE (rnd) == GMP_RNDN));
        } while (ok == 0);

        /* Imaginary part
           Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
        prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */

        /* a = o(1+y)    error(a) < 1 ulp(a)
           b = o(a^2)    error(b) < 5 ulp(b)
           c = o(x^2)    error(c) < 1 ulp(c)
           d = o(b+c)    error(d) < 7 ulp(d)
           e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
           f = o(1-y)    error(f) < 1 ulp(f)
           g = o(f^2)    error(g) < 5 ulp(g)
           h = o(c+f)    error(h) < 7 ulp(h)
           i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
           j = o(e-i)    error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
                                       + ki*2^{Exp(i)-Exp(j)}] ulp(j)
                         error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
                                       + 7*2^{3-Exp(j)}] ulp(j)
                                  < [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
                                       + 7*2^{3-Exp(j)}] ulp(j)
           k = j/4       exact
        */
        err = 2;
        p = prec; /* working precision */

        do
        {
            p += mpc_ceil_log2 (p) + err;
            mpfr_set_prec (a, p);
            mpfr_set_prec (b, p);
            mpfr_set_prec (y, p);

            /* a = upper bound for log(x^2 + (1+y)^2) */
            ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
            mpfr_sqr (a, a, GMP_RNDU);
            mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
            mpfr_add (a, a, y, GMP_RNDU);
            mpfr_log (a, a, GMP_RNDU);

            /* b = lower bound for log(x^2 + (1-y)^2) */
            mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
            mpfr_sqr (b, b, GMP_RNDZ);
            /* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
               more efficient to reuse the value of y (x^2) above and subtract
               one ulp */
            mpfr_nextbelow (y);
            mpfr_add (b, b, y, GMP_RNDZ);
            mpfr_log (b, b, GMP_RNDZ);

            mpfr_sub (y, a, b, GMP_RNDU);

            if (mpfr_zero_p (y))
                /* FIXME: happens when x and y have very different magnitudes;
                   could be handled more efficiently                           */
                ok = 0;
            else
            {
                expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
                expo = expo - mpfr_get_exp (y) + 1;
                err = 3 - mpfr_get_exp (y);
                /* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
                if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
                    err = (err < 0) ? 1 : err + 2;
                else
                    err = (expo < 0) ? 1 : expo + 2;

                mpfr_div_2ui (y, y, 2, GMP_RNDN);
                MPC_ASSERT (!mpfr_zero_p (y));
                /* FIXME: underflow. Since the main term of the Taylor series
                   in y=0 is 1/(x^2+1) * y, this means that y is very small
                   and/or x very large; but then the mpfr_zero_p (y) above
                   should be true. This needs a proof, or better yet,
                   special code.                                              */

                ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
                                     prec + (MPC_RND_IM (rnd) == GMP_RNDN));
            }
        } while (ok == 0);

        inex = mpc_set_fr_fr (rop, x, y, rnd);

        mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
        return inex;
    }
}
int
mpc_sin_cos (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
   mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
   /* Feature not documented in the texinfo file: One of rop_sin or
      rop_cos may be NULL, in which case it is not computed, and the
      corresponding ternary inexact value is set to 0 (exact).       */
{
   if (!mpc_fin_p (op))
      return mpc_sin_cos_nonfinite (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
   else if (mpfr_zero_p (MPC_IM (op)))
      return mpc_sin_cos_real (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
   else if (mpfr_zero_p (MPC_RE (op)))
      return mpc_sin_cos_imag (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
   else {
      /* let op = a + i*b, then sin(op) = sin(a)*cosh(b) + i*cos(a)*sinh(b)
                           and  cos(op) = cos(a)*cosh(b) - i*sin(a)*sinh(b).

         For Re(sin(op)) (and analogously, the other parts), we use the
         following algorithm, with rounding to nearest for all operations
         and working precision w:

         (1) x = o(sin(a))
         (2) y = o(cosh(b))
         (3) r = o(x*y)
         then the error on r is at most 4 ulps, since we can write
         r = sin(a)*cosh(b)*(1+t)^3 with |t| <= 2^(-w),
         thus for w >= 2, r = sin(a)*cosh(b)*(1+4*t) with |t| <= 2^(-w),
         thus the relative error is bounded by 4*2^(-w) <= 4*ulp(r).
      */
      mpfr_t s, c, sh, ch, sch, csh;
      mpfr_prec_t prec;
      int ok;
      int inex_re, inex_im, inex_sin, inex_cos;

      prec = 2;
      if (rop_sin != NULL)
         prec = MPC_MAX (prec, MPC_MAX_PREC (rop_sin));
      if (rop_cos != NULL)
         prec = MPC_MAX (prec, MPC_MAX_PREC (rop_cos));

      mpfr_init2 (s, 2);
      mpfr_init2 (c, 2);
      mpfr_init2 (sh, 2);
      mpfr_init2 (ch, 2);
      mpfr_init2 (sch, 2);
      mpfr_init2 (csh, 2);

      do {
         ok = 1;
         prec += mpc_ceil_log2 (prec) + 5;

         mpfr_set_prec (s, prec);
         mpfr_set_prec (c, prec);
         mpfr_set_prec (sh, prec);
         mpfr_set_prec (ch, prec);
         mpfr_set_prec (sch, prec);
         mpfr_set_prec (csh, prec);

         mpfr_sin_cos (s, c, MPC_RE(op), GMP_RNDN);
         mpfr_sinh_cosh (sh, ch, MPC_IM(op), GMP_RNDN);

         if (rop_sin != NULL) {
            /* real part of sine */
            mpfr_mul (sch, s, ch, GMP_RNDN);
            ok = (!mpfr_number_p (sch))
                  || mpfr_can_round (sch, prec - 2, GMP_RNDN, GMP_RNDZ,
                        MPC_PREC_RE (rop_sin)
                        + (MPC_RND_RE (rnd_sin) == GMP_RNDN));

            if (ok) {
               /* imaginary part of sine */
               mpfr_mul (csh, c, sh, GMP_RNDN);
               ok = (!mpfr_number_p (csh))
                     || mpfr_can_round (csh, prec - 2, GMP_RNDN, GMP_RNDZ,
                           MPC_PREC_IM (rop_sin)
                           + (MPC_RND_IM (rnd_sin) == GMP_RNDN));
            }
         }

         if (rop_cos != NULL && ok) {
            /* real part of cosine */
            mpfr_mul (c, c, ch, GMP_RNDN);
            ok = (!mpfr_number_p (c))
                  || mpfr_can_round (c, prec - 2, GMP_RNDN, GMP_RNDZ,
                        MPC_PREC_RE (rop_cos)
                        + (MPC_RND_RE (rnd_cos) == GMP_RNDN));

            if (ok) {
               /* imaginary part of cosine */
               mpfr_mul (s, s, sh, GMP_RNDN);
               mpfr_neg (s, s, GMP_RNDN);
               ok = (!mpfr_number_p (s))
                     || mpfr_can_round (s, prec - 2, GMP_RNDN, GMP_RNDZ,
                           MPC_PREC_IM (rop_cos)
                           + (MPC_RND_IM (rnd_cos) == GMP_RNDN));
            }
         }
      } while (ok == 0);

      if (rop_sin != NULL) {
         inex_re = mpfr_set (MPC_RE (rop_sin), sch, MPC_RND_RE (rnd_sin));
         if (mpfr_inf_p (sch))
            inex_re = mpfr_sgn (sch);
         inex_im = mpfr_set (MPC_IM (rop_sin), csh, MPC_RND_IM (rnd_sin));
         if (mpfr_inf_p (csh))
            inex_im = mpfr_sgn (csh);
         inex_sin = MPC_INEX (inex_re, inex_im);
      }
      else
         inex_sin = MPC_INEX (0,0); /* return exact if not computed */

      if (rop_cos != NULL) {
         inex_re = mpfr_set (MPC_RE (rop_cos), c, MPC_RND_RE (rnd_cos));
         if (mpfr_inf_p (c))
            inex_re = mpfr_sgn (c);
         inex_im = mpfr_set (MPC_IM (rop_cos), s, MPC_RND_IM (rnd_cos));
         if (mpfr_inf_p (s))
            inex_im = mpfr_sgn (s);
         inex_cos = MPC_INEX (inex_re, inex_im);
      }
      else
         inex_cos = MPC_INEX (0,0); /* return exact if not computed */

      mpfr_clear (s);
      mpfr_clear (c);
      mpfr_clear (sh);
      mpfr_clear (ch);
      mpfr_clear (sch);
      mpfr_clear (csh);

      return (MPC_INEX12 (inex_sin, inex_cos));
   }
}
예제 #13
0
파일: acos.c 프로젝트: Gwenio/DragonFlyBSD
int
mpc_acos (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
  int inex_re, inex_im, inex;
  mpfr_prec_t p_re, p_im, p;
  mpc_t z1;
  mpfr_t pi_over_2;
  mpfr_exp_t e1, e2;
  mpfr_rnd_t rnd_im;
  mpc_rnd_t rnd1;

  inex_re = 0;
  inex_im = 0;

  /* 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_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? +1 : -1);
          mpfr_set_nan (mpc_realref (rop));
        }
      else if (mpfr_zero_p (mpc_realref (op)))
        {
          inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
          mpfr_set_nan (mpc_imagref (rop));
        }
      else
        {
          mpfr_set_nan (mpc_realref (rop));
          mpfr_set_nan (mpc_imagref (rop));
        }

      return MPC_INEX (inex_re, 0);
    }

  if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
    {
      if (mpfr_inf_p (mpc_realref (op)))
        {
          if (mpfr_inf_p (mpc_imagref (op)))
            {
              if (mpfr_sgn (mpc_realref (op)) > 0)
                {
                  inex_re =
                    set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
                  mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
                }
              else
                {

                  /* the real part of the result is 3*pi/4
                     a = o(pi)  error(a) < 1 ulp(a)
                     b = o(3*a) error(b) < 2 ulp(b)
                     c = b/4    exact
                     thus 1 bit is lost */
                  mpfr_t x;
                  mpfr_prec_t prec;
                  int ok;
                  mpfr_init (x);
                  prec = mpfr_get_prec (mpc_realref (rop));
                  p = prec;

                  do
                    {
                      p += mpc_ceil_log2 (p);
                      mpfr_set_prec (x, p);
                      mpfr_const_pi (x, GMP_RNDD);
                      mpfr_mul_ui (x, x, 3, GMP_RNDD);
                      ok =
                        mpfr_can_round (x, p - 1, GMP_RNDD, MPC_RND_RE (rnd),
                                        prec+(MPC_RND_RE (rnd) == GMP_RNDN));

                    } while (ok == 0);
                  inex_re =
                    mpfr_div_2ui (mpc_realref (rop), x, 2, MPC_RND_RE (rnd));
                  mpfr_clear (x);
                }
            }
          else
            {
              if (mpfr_sgn (mpc_realref (op)) > 0)
                mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
              else
                inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
            }
        }
      else
        inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));

      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 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),
                                  MPC_RND_IM (rnd));
          else
            inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
                                   INV_RND (MPC_RND_IM (rnd)));

          mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
        }
      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,
                                  MPC_RND_IM (rnd));
          else
            inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
                                   INV_RND (MPC_RND_IM (rnd)));
          inex_re = mpfr_const_pi (mpc_realref (rop), MPC_RND_RE (rnd));
        }
      else
        {
          inex_re = mpfr_acos (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
          mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
        }

      if (!s_im)
        mpc_conj (rop, rop, MPC_RNDNN);

      return MPC_INEX (inex_re, inex_im);
    }

  /* pure imaginary argument */
  if (mpfr_zero_p (mpc_realref (op)))
    {
      inex_re = set_pi_over_2 (mpc_realref (rop), +1, MPC_RND_RE (rnd));
      inex_im = -mpfr_asinh (mpc_imagref (rop), mpc_imagref (op),
                             INV_RND (MPC_RND_IM (rnd)));
      mpc_conj (rop,rop, MPC_RNDNN);

      return MPC_INEX (inex_re, inex_im);
    }

  /* regular complex argument: acos(z) = Pi/2 - asin(z) */
  p_re = mpfr_get_prec (mpc_realref(rop));
  p_im = mpfr_get_prec (mpc_imagref(rop));
  p = p_re;
  mpc_init3 (z1, p, p_im); /* we round directly the imaginary part to p_im,
                              with rounding mode opposite to rnd_im */
  rnd_im = MPC_RND_IM(rnd);
  /* the imaginary part of asin(z) has the same sign as Im(z), thus if
     Im(z) > 0 and rnd_im = RNDZ, we want to round the Im(asin(z)) to -Inf
     so that -Im(asin(z)) is rounded to zero */
  if (rnd_im == GMP_RNDZ)
    rnd_im = mpfr_sgn (mpc_imagref(op)) > 0 ? GMP_RNDD : GMP_RNDU;
  else
    rnd_im = rnd_im == GMP_RNDU ? GMP_RNDD
      : rnd_im == GMP_RNDD ? GMP_RNDU
      : rnd_im; /* both RNDZ and RNDA map to themselves for -asin(z) */
  rnd1 = MPC_RND (GMP_RNDN, rnd_im);
  mpfr_init2 (pi_over_2, p);
  for (;;)
    {
      p += mpc_ceil_log2 (p) + 3;

      mpfr_set_prec (mpc_realref(z1), p);
      mpfr_set_prec (pi_over_2, p);

      set_pi_over_2 (pi_over_2, +1, GMP_RNDN);
      e1 = 1; /* Exp(pi_over_2) */
      inex = mpc_asin (z1, op, rnd1); /* asin(z) */
      MPC_ASSERT (mpfr_sgn (mpc_imagref(z1)) * mpfr_sgn (mpc_imagref(op)) > 0);
      inex_im = MPC_INEX_IM(inex); /* inex_im is in {-1, 0, 1} */
      e2 = mpfr_get_exp (mpc_realref(z1));
      mpfr_sub (mpc_realref(z1), pi_over_2, mpc_realref(z1), GMP_RNDN);
      if (!mpfr_zero_p (mpc_realref(z1)))
        {
          /* the error on x=Re(z1) is bounded by 1/2 ulp(x) + 2^(e1-p-1) +
             2^(e2-p-1) */
          e1 = e1 >= e2 ? e1 + 1 : e2 + 1;
          /* the error on x is bounded by 1/2 ulp(x) + 2^(e1-p-1) */
          e1 -= mpfr_get_exp (mpc_realref(z1));
          /* the error on x is bounded by 1/2 ulp(x) [1 + 2^e1] */
          e1 = e1 <= 0 ? 0 : e1;
          /* the error on x is bounded by 2^e1 * ulp(x) */
          mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN); /* exact */
          inex_im = -inex_im;
          if (mpfr_can_round (mpc_realref(z1), p - e1, GMP_RNDN, GMP_RNDZ,
                              p_re + (MPC_RND_RE(rnd) == GMP_RNDN)))
            break;
        }
    }
  inex = mpc_set (rop, z1, rnd);
  inex_re = MPC_INEX_RE(inex);
  mpc_clear (z1);
  mpfr_clear (pi_over_2);

  return MPC_INEX(inex_re, inex_im);
}
예제 #14
0
파일: cos.c 프로젝트: 119/aircam-openwrt
int
mpc_cos (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
  mpfr_t x, y, z;
  mp_prec_t prec;
  int ok = 0;
  int inex_re, inex_im;

  /* special values */
  if (!mpfr_number_p (MPC_RE (op)) || !mpfr_number_p (MPC_IM (op)))
    {
      if (mpfr_nan_p (MPC_RE (op)))
        {
          /* cos(NaN + i * NaN) = NaN + i * NaN */
          /* cos(NaN - i * Inf) = +Inf + i * NaN */
          /* cos(NaN + i * Inf) = +Inf + i * NaN */
          /* cos(NaN - i * 0) = NaN - i * 0 */
          /* cos(NaN + i * 0) = NaN + i * 0 */
          /* cos(NaN + i * y) = NaN + i * NaN, when y != 0 */
          if (mpfr_inf_p (MPC_IM (op)))
            mpfr_set_inf (MPC_RE (rop), +1);
          else
            mpfr_set_nan (MPC_RE (rop));

          if (mpfr_zero_p (MPC_IM (op)))
            mpfr_set (MPC_IM (rop), MPC_IM (op), MPC_RND_IM (rnd));
          else
            mpfr_set_nan (MPC_IM (rop));
        }
      else if (mpfr_nan_p (MPC_IM (op)))
        {
          /* cos(-Inf + i * NaN) = NaN + i * NaN */
          /* cos(+Inf + i * NaN) = NaN + i * NaN */
          /* cos(-0 + i * NaN) = NaN - i * 0 */
          /* cos(+0 + i * NaN) = NaN + i * 0 */
          /* cos(x + i * NaN) = NaN + i * NaN, when x != 0 */
          if (mpfr_zero_p (MPC_RE (op)))
            mpfr_set (MPC_IM (rop), MPC_RE (op), MPC_RND_IM (rnd));
          else
            mpfr_set_nan (MPC_IM (rop));

          mpfr_set_nan (MPC_RE (rop));
        }
      else if (mpfr_inf_p (MPC_RE (op)))
        {
          /* cos(-Inf -i*Inf) = cos(+Inf +i*Inf) = -Inf +i*NaN */
          /* cos(-Inf +i*Inf) = cos(+Inf -i*Inf) = +Inf +i*NaN */
          /* cos(-Inf -i*0) = cos(+Inf +i*0) = NaN -i*0 */
          /* cos(-Inf +i*0) = cos(+Inf -i*0) = NaN +i*0 */
          /* cos(-Inf +i*y) = cos(+Inf +i*y) = NaN +i*NaN, when y != 0 */

          /* SAME_SIGN is useful only if op == (+/-)Inf + i * (+/-)0, but, as
             MPC_RE(OP) might be erased (when ROP == OP), we compute it now */
          const int same_sign =
            mpfr_signbit (MPC_RE (op)) == mpfr_signbit (MPC_IM (op));

          if (mpfr_inf_p (MPC_IM (op)))
            mpfr_set_inf (MPC_RE (rop), (same_sign ? -1 : +1));
          else
            mpfr_set_nan (MPC_RE (rop));

          if (mpfr_zero_p (MPC_IM (op)))
            mpfr_setsign (MPC_IM (rop), MPC_IM (op), same_sign,
                          MPC_RND_IM(rnd));
          else
            mpfr_set_nan (MPC_IM (rop));
        }
      else if (mpfr_zero_p (MPC_RE (op)))
        {
          /* cos(-0 -i*Inf) = cos(+0 +i*Inf) = +Inf -i*0 */
          /* cos(-0 +i*Inf) = cos(+0 -i*Inf) = +Inf +i*0 */
          const int same_sign =
            mpfr_signbit (MPC_RE (op)) == mpfr_signbit (MPC_IM (op));

          mpfr_setsign (MPC_IM (rop), MPC_RE (op), same_sign,
                        MPC_RND_IM (rnd));
          mpfr_set_inf (MPC_RE (rop), +1);
        }
      else
        {
          /* cos(x -i*Inf) = +Inf*cos(x) +i*Inf*sin(x), when x != 0 */
          /* cos(x +i*Inf) = +Inf*cos(x) -i*Inf*sin(x), when x != 0 */
          mpfr_t c;
          mpfr_t s;

          mpfr_init (c);
          mpfr_init (s);

          mpfr_sin_cos (s, c, MPC_RE (op), GMP_RNDN);
          mpfr_set_inf (MPC_RE (rop), mpfr_sgn (c));
          mpfr_set_inf (MPC_IM (rop),
                        (mpfr_sgn (MPC_IM (op)) == mpfr_sgn (s) ? -1 : +1));

          mpfr_clear (s);
          mpfr_clear (c);
        }

      return MPC_INEX (0, 0); /* always exact */
    }

  if (mpfr_zero_p (MPC_RE (op)))
    {
      /* cos(-0 - i * y) = cos(+0 + i * y) = cosh(y) - i * 0
         cos(-0 + i * y) = cos(+0 - i * y) = cosh(y) + i * 0,
         when y >= 0 */

      /* When ROP == OP, the sign of 0 will be erased, so use it now */
      const int imag_sign =
        mpfr_signbit (MPC_RE (op)) ==  mpfr_signbit (MPC_IM (op));

      if (mpfr_zero_p (MPC_IM (op)))
        inex_re = mpfr_set_ui (MPC_RE (rop), 1, MPC_RND_RE (rnd));
      else
        inex_re = mpfr_cosh (MPC_RE (rop), MPC_IM (op), MPC_RND_RE (rnd));

      mpfr_set_ui (MPC_IM (rop), 0, MPC_RND_IM (rnd));
      mpfr_setsign (MPC_IM (rop), MPC_IM (rop), imag_sign, MPC_RND_IM (rnd));

      return MPC_INEX (inex_re, 0);
    }

  if (mpfr_zero_p (MPC_IM (op)))
    {
      /* cos(x +i*0) = cos(x) -i*0*sign(sin(x)) */
      /* cos(x -i*0) = cos(x) +i*0*sign(sin(x)) */
      mpfr_t sign;
      mpfr_init2 (sign, 2);
      mpfr_sin (sign, MPC_RE (op), GMP_RNDN);
      if (!mpfr_signbit (MPC_IM (op)))
         MPFR_CHANGE_SIGN (sign);

      inex_re = mpfr_cos (MPC_RE (rop), MPC_RE (op), MPC_RND_RE (rnd));

      mpfr_set_ui (MPC_IM (rop), 0ul, GMP_RNDN);
      if (mpfr_signbit (sign))
         MPFR_CHANGE_SIGN (MPC_IM (rop));

      mpfr_clear (sign);

      return MPC_INEX (inex_re, 0);
    }

  /* ordinary (non-zero) numbers */

  /* let op = a + i*b, then cos(op) = cos(a)*cosh(b) - i*sin(a)*sinh(b).

     We use the following algorithm (same for the imaginary part),
     with rounding to nearest for all operations, and working precision w:

     (1) x = o(cos(a))
     (2) y = o(cosh(b))
     (3) r = o(x*y)
     then the error on r is at most 4 ulps, since we can write
     r = cos(a)*cosh(b)*(1+t)^3 with |t| <= 2^(-w),
     thus for w >= 2, r = cos(a)*cosh(b)*(1+4*t) with |t| <= 2^(-w),
     thus the relative error is bounded by 4*2^(-w) <= 4*ulp(r).
  */

  prec = MPC_MAX_PREC(rop);

  mpfr_init2 (x, 2);
  mpfr_init2 (y, 2);
  mpfr_init2 (z, 2);

  do
    {
      prec += mpc_ceil_log2 (prec) + 5;

      mpfr_set_prec (x, prec);
      mpfr_set_prec (y, prec);
      mpfr_set_prec (z, prec);

      mpfr_sin_cos (y, x, MPC_RE(op), GMP_RNDN);
      mpfr_cosh (z, MPC_IM(op), GMP_RNDN);
      mpfr_mul (x, x, z, GMP_RNDN);
      ok = mpfr_can_round (x, prec - 2, GMP_RNDN, GMP_RNDZ,
                      MPFR_PREC(MPC_RE(rop)) + (MPC_RND_RE(rnd) == GMP_RNDN));
      if (ok) /* compute imaginary part */
        {
          mpfr_sinh (z, MPC_IM(op), GMP_RNDN);
          mpfr_mul (y, y, z, GMP_RNDN);
          mpfr_neg (y, y, GMP_RNDN);
          ok = mpfr_can_round (y, prec - 2, GMP_RNDN, GMP_RNDZ,
                      MPFR_PREC(MPC_IM(rop)) + (MPC_RND_IM(rnd) == GMP_RNDN));
        }
    }
  while (ok == 0);

  inex_re = mpfr_set (MPC_RE(rop), x, MPC_RND_RE(rnd));
  inex_im = mpfr_set (MPC_IM(rop), y, MPC_RND_IM(rnd));

  mpfr_clear (x);
  mpfr_clear (y);
  mpfr_clear (z);

  return MPC_INEX (inex_re, inex_im);
}