xref: /dflybsd-src/contrib/mpfr/src/log.c (revision 2786097444a0124b5d33763854de247e230c6629)
14a238c70SJohn Marino /* mpfr_log -- natural logarithm of a floating-point number
24a238c70SJohn Marino 
3*ab6d115fSJohn Marino Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
4*ab6d115fSJohn Marino Contributed by the AriC and Caramel projects, INRIA.
54a238c70SJohn Marino 
64a238c70SJohn Marino This file is part of the GNU MPFR Library.
74a238c70SJohn Marino 
84a238c70SJohn Marino The GNU MPFR Library is free software; you can redistribute it and/or modify
94a238c70SJohn Marino it under the terms of the GNU Lesser General Public License as published by
104a238c70SJohn Marino the Free Software Foundation; either version 3 of the License, or (at your
114a238c70SJohn Marino option) any later version.
124a238c70SJohn Marino 
134a238c70SJohn Marino The GNU MPFR Library is distributed in the hope that it will be useful, but
144a238c70SJohn Marino WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
154a238c70SJohn Marino or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
164a238c70SJohn Marino License for more details.
174a238c70SJohn Marino 
184a238c70SJohn Marino You should have received a copy of the GNU Lesser General Public License
194a238c70SJohn Marino along with the GNU MPFR Library; see the file COPYING.LESSER.  If not, see
204a238c70SJohn Marino http://www.gnu.org/licenses/ or write to the Free Software Foundation, Inc.,
214a238c70SJohn Marino 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */
224a238c70SJohn Marino 
234a238c70SJohn Marino #define MPFR_NEED_LONGLONG_H
244a238c70SJohn Marino #include "mpfr-impl.h"
254a238c70SJohn Marino 
264a238c70SJohn Marino /* The computation of log(x) is done using the formula :
274a238c70SJohn Marino      if we want p bits of the result,
284a238c70SJohn Marino 
294a238c70SJohn Marino                        pi
304a238c70SJohn Marino           log(x) ~ ------------  -   m log 2
314a238c70SJohn Marino                     2 AG(1,4/s)
324a238c70SJohn Marino 
334a238c70SJohn Marino      where s = x 2^m > 2^(p/2)
344a238c70SJohn Marino 
354a238c70SJohn Marino      More precisely, if F(x) = int(1/sqrt(1-(1-x^2)*sin(t)^2), t=0..PI/2),
364a238c70SJohn Marino      then for s>=1.26 we have log(s) < F(4/s) < log(s)*(1+4/s^2)
374a238c70SJohn Marino      from which we deduce pi/2/AG(1,4/s)*(1-4/s^2) < log(s) < pi/2/AG(1,4/s)
384a238c70SJohn Marino      so the relative error 4/s^2 is < 4/2^p i.e. 4 ulps.
394a238c70SJohn Marino */
404a238c70SJohn Marino 
414a238c70SJohn Marino int
mpfr_log(mpfr_ptr r,mpfr_srcptr a,mpfr_rnd_t rnd_mode)424a238c70SJohn Marino mpfr_log (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode)
434a238c70SJohn Marino {
444a238c70SJohn Marino   int inexact;
454a238c70SJohn Marino   mpfr_prec_t p, q;
464a238c70SJohn Marino   mpfr_t tmp1, tmp2;
474a238c70SJohn Marino   MPFR_SAVE_EXPO_DECL (expo);
484a238c70SJohn Marino   MPFR_ZIV_DECL (loop);
494a238c70SJohn Marino   MPFR_GROUP_DECL(group);
504a238c70SJohn Marino 
514a238c70SJohn Marino   MPFR_LOG_FUNC
524a238c70SJohn Marino     (("a[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (a), mpfr_log_prec, a, rnd_mode),
534a238c70SJohn Marino      ("r[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (r), mpfr_log_prec, r,
544a238c70SJohn Marino       inexact));
554a238c70SJohn Marino 
564a238c70SJohn Marino   /* Special cases */
574a238c70SJohn Marino   if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a)))
584a238c70SJohn Marino     {
594a238c70SJohn Marino       /* If a is NaN, the result is NaN */
604a238c70SJohn Marino       if (MPFR_IS_NAN (a))
614a238c70SJohn Marino         {
624a238c70SJohn Marino           MPFR_SET_NAN (r);
634a238c70SJohn Marino           MPFR_RET_NAN;
644a238c70SJohn Marino         }
654a238c70SJohn Marino       /* check for infinity before zero */
664a238c70SJohn Marino       else if (MPFR_IS_INF (a))
674a238c70SJohn Marino         {
684a238c70SJohn Marino           if (MPFR_IS_NEG (a))
694a238c70SJohn Marino             /* log(-Inf) = NaN */
704a238c70SJohn Marino             {
714a238c70SJohn Marino               MPFR_SET_NAN (r);
724a238c70SJohn Marino               MPFR_RET_NAN;
734a238c70SJohn Marino             }
744a238c70SJohn Marino           else /* log(+Inf) = +Inf */
754a238c70SJohn Marino             {
764a238c70SJohn Marino               MPFR_SET_INF (r);
774a238c70SJohn Marino               MPFR_SET_POS (r);
784a238c70SJohn Marino               MPFR_RET (0);
794a238c70SJohn Marino             }
804a238c70SJohn Marino         }
814a238c70SJohn Marino       else /* a is zero */
824a238c70SJohn Marino         {
834a238c70SJohn Marino           MPFR_ASSERTD (MPFR_IS_ZERO (a));
844a238c70SJohn Marino           MPFR_SET_INF (r);
854a238c70SJohn Marino           MPFR_SET_NEG (r);
864a238c70SJohn Marino           mpfr_set_divby0 ();
874a238c70SJohn Marino           MPFR_RET (0); /* log(0) is an exact -infinity */
884a238c70SJohn Marino         }
894a238c70SJohn Marino     }
904a238c70SJohn Marino   /* If a is negative, the result is NaN */
914a238c70SJohn Marino   else if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
924a238c70SJohn Marino     {
934a238c70SJohn Marino       MPFR_SET_NAN (r);
944a238c70SJohn Marino       MPFR_RET_NAN;
954a238c70SJohn Marino     }
964a238c70SJohn Marino   /* If a is 1, the result is 0 */
974a238c70SJohn Marino   else if (MPFR_UNLIKELY (MPFR_GET_EXP (a) == 1 && mpfr_cmp_ui (a, 1) == 0))
984a238c70SJohn Marino     {
994a238c70SJohn Marino       MPFR_SET_ZERO (r);
1004a238c70SJohn Marino       MPFR_SET_POS (r);
1014a238c70SJohn Marino       MPFR_RET (0); /* only "normal" case where the result is exact */
1024a238c70SJohn Marino     }
1034a238c70SJohn Marino 
1044a238c70SJohn Marino   q = MPFR_PREC (r);
1054a238c70SJohn Marino 
1064a238c70SJohn Marino   /* use initial precision about q+lg(q)+5 */
1074a238c70SJohn Marino   p = q + 5 + 2 * MPFR_INT_CEIL_LOG2 (q);
1084a238c70SJohn Marino   /* % ~(mpfr_prec_t)GMP_NUMB_BITS  ;
1094a238c70SJohn Marino      m=q; while (m) { p++; m >>= 1; }  */
1104a238c70SJohn Marino   /* if (MPFR_LIKELY(p % GMP_NUMB_BITS != 0))
1114a238c70SJohn Marino       p += GMP_NUMB_BITS - (p%GMP_NUMB_BITS); */
1124a238c70SJohn Marino 
1134a238c70SJohn Marino   MPFR_SAVE_EXPO_MARK (expo);
1144a238c70SJohn Marino   MPFR_GROUP_INIT_2 (group, p, tmp1, tmp2);
1154a238c70SJohn Marino 
1164a238c70SJohn Marino   MPFR_ZIV_INIT (loop, p);
1174a238c70SJohn Marino   for (;;)
1184a238c70SJohn Marino     {
1194a238c70SJohn Marino       long m;
1204a238c70SJohn Marino       mpfr_exp_t cancel;
1214a238c70SJohn Marino 
1224a238c70SJohn Marino       /* Calculus of m (depends on p) */
1234a238c70SJohn Marino       m = (p + 1) / 2 - MPFR_GET_EXP (a) + 1;
1244a238c70SJohn Marino 
1254a238c70SJohn Marino       mpfr_mul_2si (tmp2, a, m, MPFR_RNDN);    /* s=a*2^m,        err<=1 ulp  */
1264a238c70SJohn Marino       mpfr_div (tmp1, __gmpfr_four, tmp2, MPFR_RNDN);/* 4/s,      err<=2 ulps */
1274a238c70SJohn Marino       mpfr_agm (tmp2, __gmpfr_one, tmp1, MPFR_RNDN); /* AG(1,4/s),err<=3 ulps */
1284a238c70SJohn Marino       mpfr_mul_2ui (tmp2, tmp2, 1, MPFR_RNDN); /* 2*AG(1,4/s),    err<=3 ulps */
1294a238c70SJohn Marino       mpfr_const_pi (tmp1, MPFR_RNDN);         /* compute pi,     err<=1ulp   */
1304a238c70SJohn Marino       mpfr_div (tmp2, tmp1, tmp2, MPFR_RNDN);  /* pi/2*AG(1,4/s), err<=5ulps  */
1314a238c70SJohn Marino       mpfr_const_log2 (tmp1, MPFR_RNDN);      /* compute log(2),  err<=1ulp   */
1324a238c70SJohn Marino       mpfr_mul_si (tmp1, tmp1, m, MPFR_RNDN); /* compute m*log(2),err<=2ulps  */
1334a238c70SJohn Marino       mpfr_sub (tmp1, tmp2, tmp1, MPFR_RNDN); /* log(a),    err<=7ulps+cancel */
1344a238c70SJohn Marino 
1354a238c70SJohn Marino       if (MPFR_LIKELY (MPFR_IS_PURE_FP (tmp1) && MPFR_IS_PURE_FP (tmp2)))
1364a238c70SJohn Marino         {
1374a238c70SJohn Marino           cancel = MPFR_GET_EXP (tmp2) - MPFR_GET_EXP (tmp1);
1384a238c70SJohn Marino           MPFR_LOG_MSG (("canceled bits=%ld\n", (long) cancel));
1394a238c70SJohn Marino           MPFR_LOG_VAR (tmp1);
1404a238c70SJohn Marino           if (MPFR_UNLIKELY (cancel < 0))
1414a238c70SJohn Marino             cancel = 0;
1424a238c70SJohn Marino 
1434a238c70SJohn Marino           /* we have 7 ulps of error from the above roundings,
1444a238c70SJohn Marino              4 ulps from the 4/s^2 second order term,
1454a238c70SJohn Marino              plus the canceled bits */
1464a238c70SJohn Marino           if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp1, p-cancel-4, q, rnd_mode)))
1474a238c70SJohn Marino             break;
1484a238c70SJohn Marino 
1494a238c70SJohn Marino           /* VL: I think it is better to have an increment that it isn't
1504a238c70SJohn Marino              too low; in particular, the increment must be positive even
1514a238c70SJohn Marino              if cancel = 0 (can this occur?). */
1524a238c70SJohn Marino           p += cancel >= 8 ? cancel : 8;
1534a238c70SJohn Marino         }
1544a238c70SJohn Marino       else
1554a238c70SJohn Marino         {
1564a238c70SJohn Marino           /* TODO: find why this case can occur and what is best to do
1574a238c70SJohn Marino              with it. */
1584a238c70SJohn Marino           p += 32;
1594a238c70SJohn Marino         }
1604a238c70SJohn Marino 
1614a238c70SJohn Marino       MPFR_ZIV_NEXT (loop, p);
1624a238c70SJohn Marino       MPFR_GROUP_REPREC_2 (group, p, tmp1, tmp2);
1634a238c70SJohn Marino     }
1644a238c70SJohn Marino   MPFR_ZIV_FREE (loop);
1654a238c70SJohn Marino   inexact = mpfr_set (r, tmp1, rnd_mode);
1664a238c70SJohn Marino   /* We clean */
1674a238c70SJohn Marino   MPFR_GROUP_CLEAR (group);
1684a238c70SJohn Marino 
1694a238c70SJohn Marino   MPFR_SAVE_EXPO_FREE (expo);
1704a238c70SJohn Marino   return mpfr_check_range (r, inexact, rnd_mode);
1714a238c70SJohn Marino }
172