Blame src/log.c

Packit Service 2e9770
/* mpc_log -- Take the logarithm of a complex number.
Packit Service 2e9770
Packit Service 2e9770
Copyright (C) 2008, 2009, 2010, 2011, 2012 INRIA
Packit Service 2e9770
Packit Service 2e9770
This file is part of GNU MPC.
Packit Service 2e9770
Packit Service 2e9770
GNU MPC is free software; you can redistribute it and/or modify it under
Packit Service 2e9770
the terms of the GNU Lesser General Public License as published by the
Packit Service 2e9770
Free Software Foundation; either version 3 of the License, or (at your
Packit Service 2e9770
option) any later version.
Packit Service 2e9770
Packit Service 2e9770
GNU MPC is distributed in the hope that it will be useful, but WITHOUT ANY
Packit Service 2e9770
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
Packit Service 2e9770
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
Packit Service 2e9770
more details.
Packit Service 2e9770
Packit Service 2e9770
You should have received a copy of the GNU Lesser General Public License
Packit Service 2e9770
along with this program. If not, see http://www.gnu.org/licenses/ .
Packit Service 2e9770
*/
Packit Service 2e9770
Packit Service 2e9770
#include <stdio.h> /* for MPC_ASSERT */
Packit Service 2e9770
#include "mpc-impl.h"
Packit Service 2e9770
Packit Service 2e9770
int
Packit Service 2e9770
mpc_log (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd){
Packit Service 2e9770
   int ok, underflow = 0;
Packit Service 2e9770
   mpfr_srcptr x, y;
Packit Service 2e9770
   mpfr_t v, w;
Packit Service 2e9770
   mpfr_prec_t prec;
Packit Service 2e9770
   int loops;
Packit Service 2e9770
   int re_cmp, im_cmp;
Packit Service 2e9770
   int inex_re, inex_im;
Packit Service 2e9770
   int err;
Packit Service 2e9770
   mpfr_exp_t expw;
Packit Service 2e9770
   int sgnw;
Packit Service 2e9770
Packit Service 2e9770
   /* special values: NaN and infinities */
Packit Service 2e9770
   if (!mpc_fin_p (op)) {
Packit Service 2e9770
      if (mpfr_nan_p (mpc_realref (op))) {
Packit Service 2e9770
         if (mpfr_inf_p (mpc_imagref (op)))
Packit Service 2e9770
            mpfr_set_inf (mpc_realref (rop), +1);
Packit Service 2e9770
         else
Packit Service 2e9770
            mpfr_set_nan (mpc_realref (rop));
Packit Service 2e9770
         mpfr_set_nan (mpc_imagref (rop));
Packit Service 2e9770
         inex_im = 0; /* Inf/NaN is exact */
Packit Service 2e9770
      }
Packit Service 2e9770
      else if (mpfr_nan_p (mpc_imagref (op))) {
Packit Service 2e9770
         if (mpfr_inf_p (mpc_realref (op)))
Packit Service 2e9770
            mpfr_set_inf (mpc_realref (rop), +1);
Packit Service 2e9770
         else
Packit Service 2e9770
            mpfr_set_nan (mpc_realref (rop));
Packit Service 2e9770
         mpfr_set_nan (mpc_imagref (rop));
Packit Service 2e9770
         inex_im = 0; /* Inf/NaN is exact */
Packit Service 2e9770
      }
Packit Service 2e9770
      else /* We have an infinity in at least one part. */ {
Packit Service 2e9770
         inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
Packit Service 2e9770
                               MPC_RND_IM (rnd));
Packit Service 2e9770
         mpfr_set_inf (mpc_realref (rop), +1);
Packit Service 2e9770
      }
Packit Service 2e9770
      return MPC_INEX(0, inex_im);
Packit Service 2e9770
   }
Packit Service 2e9770
Packit Service 2e9770
   /* special cases: real and purely imaginary numbers */
Packit Service 2e9770
   re_cmp = mpfr_cmp_ui (mpc_realref (op), 0);
Packit Service 2e9770
   im_cmp = mpfr_cmp_ui (mpc_imagref (op), 0);
Packit Service 2e9770
   if (im_cmp == 0) {
Packit Service 2e9770
      if (re_cmp == 0) {
Packit Service 2e9770
         inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
Packit Service 2e9770
                               MPC_RND_IM (rnd));
Packit Service 2e9770
         mpfr_set_inf (mpc_realref (rop), -1);
Packit Service 2e9770
         inex_re = 0; /* -Inf is exact */
Packit Service 2e9770
      }
Packit Service 2e9770
      else if (re_cmp > 0) {
Packit Service 2e9770
         inex_re = mpfr_log (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
Packit Service 2e9770
         inex_im = mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
Packit Service 2e9770
      }
Packit Service 2e9770
      else {
Packit Service 2e9770
         /* op = x + 0*y; let w = -x = |x| */
Packit Service 2e9770
         int negative_zero;
Packit Service 2e9770
         mpfr_rnd_t rnd_im;
Packit Service 2e9770
Packit Service 2e9770
         negative_zero = mpfr_signbit (mpc_imagref (op));
Packit Service 2e9770
         if (negative_zero)
Packit Service 2e9770
            rnd_im = INV_RND (MPC_RND_IM (rnd));
Packit Service 2e9770
         else
Packit Service 2e9770
            rnd_im = MPC_RND_IM (rnd);
Packit Service 2e9770
         w [0] = *mpc_realref (op);
Packit Service 2e9770
         MPFR_CHANGE_SIGN (w);
Packit Service 2e9770
         inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
Packit Service 2e9770
         inex_im = mpfr_const_pi (mpc_imagref (rop), rnd_im);
Packit Service 2e9770
         if (negative_zero) {
Packit Service 2e9770
            mpc_conj (rop, rop, MPC_RNDNN);
Packit Service 2e9770
            inex_im = -inex_im;
Packit Service 2e9770
         }
Packit Service 2e9770
      }
Packit Service 2e9770
      return MPC_INEX(inex_re, inex_im);
Packit Service 2e9770
   }
Packit Service 2e9770
   else if (re_cmp == 0) {
Packit Service 2e9770
      if (im_cmp > 0) {
Packit Service 2e9770
         inex_re = mpfr_log (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE (rnd));
Packit Service 2e9770
         inex_im = mpfr_const_pi (mpc_imagref (rop), MPC_RND_IM (rnd));
Packit Service 2e9770
         /* division by 2 does not change the ternary flag */
Packit Service 2e9770
         mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, MPFR_RNDN);
Packit Service 2e9770
      }
Packit Service 2e9770
      else {
Packit Service 2e9770
         w [0] = *mpc_imagref (op);
Packit Service 2e9770
         MPFR_CHANGE_SIGN (w);
Packit Service 2e9770
         inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
Packit Service 2e9770
         inex_im = mpfr_const_pi (mpc_imagref (rop), INV_RND (MPC_RND_IM (rnd)));
Packit Service 2e9770
         /* division by 2 does not change the ternary flag */
Packit Service 2e9770
         mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, MPFR_RNDN);
Packit Service 2e9770
         mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN);
Packit Service 2e9770
         inex_im = -inex_im; /* negate the ternary flag */
Packit Service 2e9770
      }
Packit Service 2e9770
      return MPC_INEX(inex_re, inex_im);
Packit Service 2e9770
   }
Packit Service 2e9770
Packit Service 2e9770
   prec = MPC_PREC_RE(rop);
Packit Service 2e9770
   mpfr_init2 (w, 2);
Packit Service 2e9770
   /* let op = x + iy; log = 1/2 log (x^2 + y^2) + i atan2 (y, x)   */
Packit Service 2e9770
   /* loop for the real part: 1/2 log (x^2 + y^2), fast, but unsafe */
Packit Service 2e9770
   /* implementation                                                */
Packit Service 2e9770
   ok = 0;
Packit Service 2e9770
   for (loops = 1; !ok && loops <= 2; loops++) {
Packit Service 2e9770
      prec += mpc_ceil_log2 (prec) + 4;
Packit Service 2e9770
      mpfr_set_prec (w, prec);
Packit Service 2e9770
Packit Service 2e9770
      mpc_abs (w, op, MPFR_RNDN);
Packit Service 2e9770
         /* error 0.5 ulp */
Packit Service 2e9770
      if (mpfr_inf_p (w))
Packit Service 2e9770
         /* intermediate overflow; the logarithm may be representable.
Packit Service 2e9770
            Intermediate underflow is impossible.                      */
Packit Service 2e9770
         break;
Packit Service 2e9770
Packit Service 2e9770
      mpfr_log (w, w, MPFR_RNDN);
Packit Service 2e9770
         /* generic error of log: (2^(- exp(w)) + 0.5) ulp */
Packit Service 2e9770
Packit Service 2e9770
      if (mpfr_zero_p (w))
Packit Service 2e9770
         /* impossible to round, switch to second algorithm */
Packit Service 2e9770
         break;
Packit Service 2e9770
Packit Service 2e9770
      err = MPC_MAX (-mpfr_get_exp (w), 0) + 1;
Packit Service 2e9770
         /* number of lost digits */
Packit Service 2e9770
      ok = mpfr_can_round (w, prec - err, MPFR_RNDN, MPFR_RNDZ,
Packit Service 2e9770
         mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == MPFR_RNDN));
Packit Service 2e9770
   }
Packit Service 2e9770
Packit Service 2e9770
   if (!ok) {
Packit Service 2e9770
      prec = MPC_PREC_RE(rop);
Packit Service 2e9770
      mpfr_init2 (v, 2);
Packit Service 2e9770
      /* compute 1/2 log (x^2 + y^2) = log |x| + 1/2 * log (1 + (y/x)^2)
Packit Service 2e9770
            if |x| >= |y|; otherwise, exchange x and y                   */
Packit Service 2e9770
      if (mpfr_cmpabs (mpc_realref (op), mpc_imagref (op)) >= 0) {
Packit Service 2e9770
         x = mpc_realref (op);
Packit Service 2e9770
         y = mpc_imagref (op);
Packit Service 2e9770
      }
Packit Service 2e9770
      else {
Packit Service 2e9770
         x = mpc_imagref (op);
Packit Service 2e9770
         y = mpc_realref (op);
Packit Service 2e9770
      }
Packit Service 2e9770
Packit Service 2e9770
      do {
Packit Service 2e9770
         prec += mpc_ceil_log2 (prec) + 4;
Packit Service 2e9770
         mpfr_set_prec (v, prec);
Packit Service 2e9770
         mpfr_set_prec (w, prec);
Packit Service 2e9770
Packit Service 2e9770
         mpfr_div (v, y, x, MPFR_RNDD); /* error 1 ulp */
Packit Service 2e9770
         mpfr_sqr (v, v, MPFR_RNDD);
Packit Service 2e9770
            /* generic error of multiplication:
Packit Service 2e9770
               1 + 2*1*(2+1*2^(1-prec)) <= 5.0625 since prec >= 6 */
Packit Service 2e9770
         mpfr_log1p (v, v, MPFR_RNDD);
Packit Service 2e9770
            /* error 1 + 4*5.0625 = 21.25 , see algorithms.tex */
Packit Service 2e9770
         mpfr_div_2ui (v, v, 1, MPFR_RNDD);
Packit Service 2e9770
            /* If the result is 0, then there has been an underflow somewhere. */
Packit Service 2e9770
Packit Service 2e9770
         mpfr_abs (w, x, MPFR_RNDN); /* exact */
Packit Service 2e9770
         mpfr_log (w, w, MPFR_RNDN); /* error 0.5 ulp */
Packit Service 2e9770
         expw = mpfr_get_exp (w);
Packit Service 2e9770
         sgnw = mpfr_signbit (w);
Packit Service 2e9770
Packit Service 2e9770
         mpfr_add (w, w, v, MPFR_RNDN);
Packit Service 2e9770
         if (!sgnw) /* v is positive, so no cancellation;
Packit Service 2e9770
                       error 22.25 ulp; error counts lost bits */
Packit Service 2e9770
            err = 5;
Packit Service 2e9770
         else
Packit Service 2e9770
            err =   MPC_MAX (5 + mpfr_get_exp (v),
Packit Service 2e9770
                  /* 21.25 ulp (v) rewritten in ulp (result, now in w) */
Packit Service 2e9770
                           -1 + expw             - mpfr_get_exp (w)
Packit Service 2e9770
                  /* 0.5 ulp (previous w), rewritten in ulp (result) */
Packit Service 2e9770
                  ) + 2;
Packit Service 2e9770
Packit Service 2e9770
         /* handle one special case: |x|=1, and (y/x)^2 underflows;
Packit Service 2e9770
            then 1/2*log(x^2+y^2) \approx 1/2*y^2 also underflows.  */
Packit Service 2e9770
         if (   (mpfr_cmp_si (x, -1) == 0 || mpfr_cmp_ui (x, 1) == 0)
Packit Service 2e9770
             && mpfr_zero_p (w))
Packit Service 2e9770
            underflow = 1;
Packit Service 2e9770
Packit Service 2e9770
      } while (!underflow &&
Packit Service 2e9770
               !mpfr_can_round (w, prec - err, MPFR_RNDN, MPFR_RNDZ,
Packit Service 2e9770
               mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == MPFR_RNDN)));
Packit Service 2e9770
      mpfr_clear (v);
Packit Service 2e9770
   }
Packit Service 2e9770
Packit Service 2e9770
   /* imaginary part */
Packit Service 2e9770
   inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
Packit Service 2e9770
                         MPC_RND_IM (rnd));
Packit Service 2e9770
Packit Service 2e9770
   /* set the real part; cannot be done before if rop==op */
Packit Service 2e9770
   if (underflow)
Packit Service 2e9770
      /* create underflow in result */
Packit Service 2e9770
      inex_re = mpfr_set_ui_2exp (mpc_realref (rop), 1,
Packit Service 2e9770
                                  mpfr_get_emin_min () - 2, MPC_RND_RE (rnd));
Packit Service 2e9770
   else
Packit Service 2e9770
      inex_re = mpfr_set (mpc_realref (rop), w, MPC_RND_RE (rnd));
Packit Service 2e9770
   mpfr_clear (w);
Packit Service 2e9770
   return MPC_INEX(inex_re, inex_im);
Packit Service 2e9770
}