|
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 |
}
|