Blame src/root.c

Packit fbef6a
/* mpfr_root -- kth root.
Packit fbef6a
Packit fbef6a
Copyright 2005-2017 Free Software Foundation, Inc.
Packit fbef6a
Contributed by the AriC and Caramba projects, INRIA.
Packit fbef6a
Packit fbef6a
This file is part of the GNU MPFR Library.
Packit fbef6a
Packit fbef6a
The GNU MPFR Library is free software; you can redistribute it and/or modify
Packit fbef6a
it under the terms of the GNU Lesser General Public License as published by
Packit fbef6a
the Free Software Foundation; either version 3 of the License, or (at your
Packit fbef6a
option) any later version.
Packit fbef6a
Packit fbef6a
The GNU MPFR Library is distributed in the hope that it will be useful, but
Packit fbef6a
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
Packit fbef6a
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
Packit fbef6a
License for more details.
Packit fbef6a
Packit fbef6a
You should have received a copy of the GNU Lesser General Public License
Packit fbef6a
along with the GNU MPFR Library; see the file COPYING.LESSER.  If not, see
Packit fbef6a
http://www.gnu.org/licenses/ or write to the Free Software Foundation, Inc.,
Packit fbef6a
51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */
Packit fbef6a
Packit fbef6a
#define MPFR_NEED_LONGLONG_H
Packit fbef6a
#include "mpfr-impl.h"
Packit fbef6a
Packit fbef6a
 /* The computation of y = x^(1/k) is done as follows, except for large
Packit fbef6a
    values of k, for which this would be inefficient or yield internal
Packit fbef6a
    integer overflows:
Packit fbef6a
Packit fbef6a
    Let x = sign * m * 2^(k*e) where m is an integer
Packit fbef6a
Packit fbef6a
    with 2^(k*(n-1)) <= m < 2^(k*n) where n = PREC(y)
Packit fbef6a
Packit fbef6a
    and m = s^k + t where 0 <= t and m < (s+1)^k
Packit fbef6a
Packit fbef6a
    we want that s has n bits i.e. s >= 2^(n-1), or m >= 2^(k*(n-1))
Packit fbef6a
    i.e. m must have at least k*(n-1)+1 bits
Packit fbef6a
Packit fbef6a
    then, not taking into account the sign, the result will be
Packit fbef6a
    x^(1/k) = s * 2^e or (s+1) * 2^e according to the rounding mode.
Packit fbef6a
 */
Packit fbef6a
Packit fbef6a
static int
Packit fbef6a
mpfr_root_aux (mpfr_ptr y, mpfr_srcptr x, unsigned long k,
Packit fbef6a
               mpfr_rnd_t rnd_mode);
Packit fbef6a
Packit fbef6a
int
Packit fbef6a
mpfr_root (mpfr_ptr y, mpfr_srcptr x, unsigned long k, mpfr_rnd_t rnd_mode)
Packit fbef6a
{
Packit fbef6a
  mpz_t m;
Packit fbef6a
  mpfr_exp_t e, r, sh, f;
Packit fbef6a
  mpfr_prec_t n, size_m, tmp;
Packit fbef6a
  int inexact, negative;
Packit fbef6a
  MPFR_SAVE_EXPO_DECL (expo);
Packit fbef6a
Packit fbef6a
  MPFR_LOG_FUNC
Packit fbef6a
    (("x[%Pu]=%.*Rg k=%lu rnd=%d",
Packit fbef6a
      mpfr_get_prec (x), mpfr_log_prec, x, k, rnd_mode),
Packit fbef6a
     ("y[%Pu]=%.*Rg inexact=%d",
Packit fbef6a
      mpfr_get_prec (y), mpfr_log_prec, y, inexact));
Packit fbef6a
Packit fbef6a
  if (MPFR_UNLIKELY (k <= 1))
Packit fbef6a
    {
Packit fbef6a
      if (k == 0)
Packit fbef6a
        {
Packit fbef6a
          MPFR_SET_NAN (y);
Packit fbef6a
          MPFR_RET_NAN;
Packit fbef6a
        }
Packit fbef6a
      else /* y = x^(1/1) = x */
Packit fbef6a
        return mpfr_set (y, x, rnd_mode);
Packit fbef6a
    }
Packit fbef6a
Packit fbef6a
  /* Singular values */
Packit fbef6a
  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
Packit fbef6a
    {
Packit fbef6a
      if (MPFR_IS_NAN (x))
Packit fbef6a
        {
Packit fbef6a
          MPFR_SET_NAN (y); /* NaN^(1/k) = NaN */
Packit fbef6a
          MPFR_RET_NAN;
Packit fbef6a
        }
Packit fbef6a
Packit fbef6a
      if (MPFR_IS_INF (x)) /* +Inf^(1/k) = +Inf
Packit fbef6a
                              -Inf^(1/k) = -Inf if k odd
Packit fbef6a
                              -Inf^(1/k) = NaN if k even */
Packit fbef6a
        {
Packit fbef6a
          if (MPFR_IS_NEG(x) && (k % 2 == 0))
Packit fbef6a
            {
Packit fbef6a
              MPFR_SET_NAN (y);
Packit fbef6a
              MPFR_RET_NAN;
Packit fbef6a
            }
Packit fbef6a
          MPFR_SET_INF (y);
Packit fbef6a
        }
Packit fbef6a
      else /* x is necessarily 0: (+0)^(1/k) = +0
Packit fbef6a
                                  (-0)^(1/k) = -0 */
Packit fbef6a
        {
Packit fbef6a
          MPFR_ASSERTD (MPFR_IS_ZERO (x));
Packit fbef6a
          MPFR_SET_ZERO (y);
Packit fbef6a
        }
Packit fbef6a
      MPFR_SET_SAME_SIGN (y, x);
Packit fbef6a
      MPFR_RET (0);
Packit fbef6a
    }
Packit fbef6a
Packit fbef6a
  /* Returns NAN for x < 0 and k even */
Packit fbef6a
  if (MPFR_UNLIKELY (MPFR_IS_NEG (x) && (k % 2 == 0)))
Packit fbef6a
    {
Packit fbef6a
      MPFR_SET_NAN (y);
Packit fbef6a
      MPFR_RET_NAN;
Packit fbef6a
    }
Packit fbef6a
Packit Service f62a41
  /* Special case |x| = 1. Note that if x = -1, then k is odd
Packit Service f62a41
     (NaN results have already been filtered), so that y = -1. */
Packit Service f62a41
  if (mpfr_cmpabs (x, __gmpfr_one) == 0)
Packit Service f62a41
    return mpfr_set (y, x, rnd_mode);
Packit Service f62a41
Packit fbef6a
  /* General case */
Packit fbef6a
Packit fbef6a
  /* For large k, use exp(log(x)/k). The threshold of 100 seems to be quite
Packit fbef6a
     good when the precision goes to infinity. */
Packit fbef6a
  if (k > 100)
Packit fbef6a
    return mpfr_root_aux (y, x, k, rnd_mode);
Packit fbef6a
Packit fbef6a
  MPFR_SAVE_EXPO_MARK (expo);
Packit fbef6a
  mpz_init (m);
Packit fbef6a
Packit fbef6a
  e = mpfr_get_z_2exp (m, x);                /* x = m * 2^e */
Packit fbef6a
  if ((negative = MPFR_IS_NEG(x)))
Packit fbef6a
    mpz_neg (m, m);
Packit fbef6a
  r = e % (mpfr_exp_t) k;
Packit fbef6a
  if (r < 0)
Packit fbef6a
    r += k; /* now r = e (mod k) with 0 <= r < k */
Packit fbef6a
  MPFR_ASSERTD (0 <= r && r < k);
Packit fbef6a
  /* x = (m*2^r) * 2^(e-r) where e-r is a multiple of k */
Packit fbef6a
Packit fbef6a
  MPFR_MPZ_SIZEINBASE2 (size_m, m);
Packit fbef6a
  /* for rounding to nearest, we want the round bit to be in the root */
Packit fbef6a
  n = MPFR_PREC (y) + (rnd_mode == MPFR_RNDN);
Packit fbef6a
Packit fbef6a
  /* we now multiply m by 2^sh so that root(m,k) will give
Packit fbef6a
     exactly n bits: we want k*(n-1)+1 <= size_m + sh <= k*n
Packit fbef6a
     i.e. sh = k*f + r with f = max(floor((k*n-size_m-r)/k),0) */
Packit fbef6a
  if ((mpfr_exp_t) size_m + r >= k * (mpfr_exp_t) n)
Packit fbef6a
    f = 0; /* we already have too many bits */
Packit fbef6a
  else
Packit fbef6a
    f = (k * (mpfr_exp_t) n - (mpfr_exp_t) size_m - r) / k;
Packit fbef6a
  sh = k * f + r;
Packit fbef6a
  mpz_mul_2exp (m, m, sh);
Packit fbef6a
  e = e - sh;
Packit fbef6a
Packit fbef6a
  /* invariant: x = m*2^e, with e divisible by k */
Packit fbef6a
Packit fbef6a
  /* we reuse the variable m to store the kth root, since it is not needed
Packit fbef6a
     any more: we just need to know if the root is exact */
Packit fbef6a
  inexact = mpz_root (m, m, k) == 0;
Packit fbef6a
Packit fbef6a
  MPFR_MPZ_SIZEINBASE2 (tmp, m);
Packit fbef6a
  sh = tmp - n;
Packit fbef6a
  if (sh > 0) /* we have to flush to 0 the last sh bits from m */
Packit fbef6a
    {
Packit fbef6a
      inexact = inexact || ((mpfr_exp_t) mpz_scan1 (m, 0) < sh);
Packit fbef6a
      mpz_fdiv_q_2exp (m, m, sh);
Packit fbef6a
      e += k * sh;
Packit fbef6a
    }
Packit fbef6a
Packit fbef6a
  if (inexact)
Packit fbef6a
    {
Packit fbef6a
      if (negative)
Packit fbef6a
        rnd_mode = MPFR_INVERT_RND (rnd_mode);
Packit fbef6a
      if (rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDA
Packit fbef6a
          || (rnd_mode == MPFR_RNDN && mpz_tstbit (m, 0)))
Packit fbef6a
        inexact = 1, mpz_add_ui (m, m, 1);
Packit fbef6a
      else
Packit fbef6a
        inexact = -1;
Packit fbef6a
    }
Packit fbef6a
Packit fbef6a
  /* either inexact is not zero, and the conversion is exact, i.e. inexact
Packit fbef6a
     is not changed; or inexact=0, and inexact is set only when
Packit fbef6a
     rnd_mode=MPFR_RNDN and bit (n+1) from m is 1 */
Packit fbef6a
  inexact += mpfr_set_z (y, m, MPFR_RNDN);
Packit fbef6a
  MPFR_SET_EXP (y, MPFR_GET_EXP (y) + e / (mpfr_exp_t) k);
Packit fbef6a
Packit fbef6a
  if (negative)
Packit fbef6a
    {
Packit fbef6a
      MPFR_CHANGE_SIGN (y);
Packit fbef6a
      inexact = -inexact;
Packit fbef6a
    }
Packit fbef6a
Packit fbef6a
  mpz_clear (m);
Packit fbef6a
  MPFR_SAVE_EXPO_FREE (expo);
Packit fbef6a
  return mpfr_check_range (y, inexact, rnd_mode);
Packit fbef6a
}
Packit fbef6a
Packit fbef6a
/* Compute y <- x^(1/k) using exp(log(x)/k).
Packit fbef6a
   Assume all special cases have been eliminated before.
Packit fbef6a
   In the extended exponent range, overflows/underflows are not possible.
Packit fbef6a
   Assume x > 0, or x < 0 and k odd.
Packit Service f62a41
   Also assume |x| <> 1 because log(1) = 0, which does not have an exponent
Packit Service f62a41
   and would yield a failure in the error bound computation. A priori, this
Packit Service f62a41
   constraint is quite artificial because if |x| is close enough to 1, then
Packit Service f62a41
   the exponent of log|x| does not need to be used (in the code, err would
Packit Service f62a41
   be 1 in such a domain). So this constraint |x| <> 1 could be avoided in
Packit Service f62a41
   the code. However, this is an exact case easy to detect, so that such a
Packit Service f62a41
   change would be useless. Values very close to 1 are not an issue, since
Packit Service f62a41
   an underflow is not possible before the MPFR_GET_EXP.
Packit fbef6a
*/
Packit fbef6a
static int
Packit fbef6a
mpfr_root_aux (mpfr_ptr y, mpfr_srcptr x, unsigned long k, mpfr_rnd_t rnd_mode)
Packit fbef6a
{
Packit fbef6a
  int inexact, exact_root = 0;
Packit fbef6a
  mpfr_prec_t w; /* working precision */
Packit fbef6a
  mpfr_t absx, t;
Packit fbef6a
  MPFR_GROUP_DECL(group);
Packit fbef6a
  MPFR_TMP_DECL(marker);
Packit fbef6a
  MPFR_ZIV_DECL(loop);
Packit fbef6a
  MPFR_SAVE_EXPO_DECL (expo);
Packit fbef6a
Packit fbef6a
  MPFR_TMP_INIT_ABS (absx, x);
Packit fbef6a
Packit fbef6a
  MPFR_TMP_MARK(marker);
Packit fbef6a
  w = MPFR_PREC(y) + 10;
Packit fbef6a
  /* Take some guard bits to prepare for the 'expt' lost bits below.
Packit fbef6a
     If |x| < 2^k, then log|x| < k, thus taking log2(k) bits should be fine. */
Packit fbef6a
  if (MPFR_GET_EXP(x) > 0)
Packit fbef6a
    w += MPFR_INT_CEIL_LOG2 (MPFR_GET_EXP(x));
Packit fbef6a
  MPFR_GROUP_INIT_1(group, w, t);
Packit fbef6a
  MPFR_SAVE_EXPO_MARK (expo);
Packit fbef6a
  MPFR_ZIV_INIT (loop, w);
Packit fbef6a
  for (;;)
Packit fbef6a
    {
Packit fbef6a
      mpfr_exp_t expt;
Packit fbef6a
      unsigned int err;
Packit fbef6a
Packit fbef6a
      mpfr_log (t, absx, MPFR_RNDN);
Packit fbef6a
      /* t = log|x| * (1 + theta) with |theta| <= 2^(-w) */
Packit fbef6a
      mpfr_div_ui (t, t, k, MPFR_RNDN);
Packit Service f62a41
      /* No possible underflow in mpfr_log and mpfr_div_ui. */
Packit Service f62a41
      expt = MPFR_GET_EXP (t);  /* assumes t <> 0 */
Packit fbef6a
      /* t = log|x|/k * (1 + theta) + eps with |theta| <= 2^(-w)
Packit fbef6a
         and |eps| <= 1/2 ulp(t), thus the total error is bounded
Packit fbef6a
         by 1.5 * 2^(expt - w) */
Packit fbef6a
      mpfr_exp (t, t, MPFR_RNDN);
Packit fbef6a
      /* t = |x|^(1/k) * exp(tau) * (1 + theta1) with
Packit fbef6a
         |tau| <= 1.5 * 2^(expt - w) and |theta1| <= 2^(-w).
Packit fbef6a
         For |tau| <= 0.5 we have |exp(tau)-1| < 4/3*tau, thus
Packit fbef6a
         for w >= expt + 2 we have:
Packit fbef6a
         t = |x|^(1/k) * (1 + 2^(expt+2)*theta2) * (1 + theta1) with
Packit fbef6a
         |theta1|, |theta2| <= 2^(-w).
Packit fbef6a
         If expt+2 > 0, as long as w >= 1, we have:
Packit fbef6a
         t = |x|^(1/k) * (1 + 2^(expt+3)*theta3) with |theta3| < 2^(-w).
Packit fbef6a
         For expt+2 = 0, we have:
Packit fbef6a
         t = |x|^(1/k) * (1 + 2^2*theta3) with |theta3| < 2^(-w).
Packit fbef6a
         Finally for expt+2 < 0 we have:
Packit fbef6a
         t = |x|^(1/k) * (1 + 2*theta3) with |theta3| < 2^(-w).
Packit fbef6a
      */
Packit fbef6a
      err = (expt + 2 > 0) ? expt + 3
Packit fbef6a
        : (expt + 2 == 0) ? 2 : 1;
Packit fbef6a
      /* now t = |x|^(1/k) * (1 + 2^(err-w)) thus the error is at most
Packit fbef6a
         2^(EXP(t) - w + err) */
Packit fbef6a
      if (MPFR_LIKELY (MPFR_CAN_ROUND(t, w - err, MPFR_PREC(y), rnd_mode)))
Packit fbef6a
        break;
Packit fbef6a
Packit fbef6a
      /* If we fail to round correctly, check for an exact result or a
Packit fbef6a
         midpoint result with MPFR_RNDN (regarded as hard-to-round in
Packit fbef6a
         all precisions in order to determine the ternary value). */
Packit fbef6a
      {
Packit fbef6a
        mpfr_t z, zk;
Packit fbef6a
Packit fbef6a
        mpfr_init2 (z, MPFR_PREC(y) + (rnd_mode == MPFR_RNDN));
Packit fbef6a
        mpfr_init2 (zk, MPFR_PREC(x));
Packit fbef6a
        mpfr_set (z, t, MPFR_RNDN);
Packit fbef6a
        inexact = mpfr_pow_ui (zk, z, k, MPFR_RNDN);
Packit fbef6a
        exact_root = !inexact && mpfr_equal_p (zk, absx);
Packit fbef6a
        if (exact_root) /* z is the exact root, thus round z directly */
Packit fbef6a
          inexact = mpfr_set4 (y, z, rnd_mode, MPFR_SIGN (x));
Packit fbef6a
        mpfr_clear (zk);
Packit fbef6a
        mpfr_clear (z);
Packit fbef6a
        if (exact_root)
Packit fbef6a
          break;
Packit fbef6a
      }
Packit fbef6a
Packit fbef6a
      MPFR_ZIV_NEXT (loop, w);
Packit fbef6a
      MPFR_GROUP_REPREC_1(group, w, t);
Packit fbef6a
    }
Packit fbef6a
  MPFR_ZIV_FREE (loop);
Packit fbef6a
Packit fbef6a
  if (!exact_root)
Packit fbef6a
    inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (x));
Packit fbef6a
Packit fbef6a
  MPFR_GROUP_CLEAR(group);
Packit fbef6a
  MPFR_TMP_FREE(marker);
Packit fbef6a
  MPFR_SAVE_EXPO_FREE (expo);
Packit fbef6a
Packit fbef6a
  return mpfr_check_range (y, inexact, rnd_mode);
Packit fbef6a
}