xref: /netbsd-src/external/lgpl3/mpfr/dist/src/atanh.c (revision ec6772edaf0cdcb5f52a48f4aca5e33a8fb8ecfd)
1 /* mpfr_atanh -- Inverse Hyperbolic Tangente
2 
3 Copyright 2001-2023 Free Software Foundation, Inc.
4 Contributed by the AriC and Caramba projects, INRIA.
5 
6 This file is part of the GNU MPFR Library.
7 
8 The GNU MPFR Library is free software; you can redistribute it and/or modify
9 it under the terms of the GNU Lesser General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or (at your
11 option) any later version.
12 
13 The GNU MPFR Library is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15 or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
16 License for more details.
17 
18 You should have received a copy of the GNU Lesser General Public License
19 along with the GNU MPFR Library; see the file COPYING.LESSER.  If not, see
20 https://www.gnu.org/licenses/ or write to the Free Software Foundation, Inc.,
21 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */
22 
23 #define MPFR_NEED_LONGLONG_H
24 #include "mpfr-impl.h"
25 
26 /* Put in y an approximation of atanh(x) for x small.
27    We assume x <= 1/2, in which case:
28    x <= y ~ atanh(x) = x + x^3/3 + x^5/5 + x^7/7 + ... <= 2*x.
29    Return k such that the error is bounded by 2^k*ulp(y).
30 */
31 static int
mpfr_atanh_small(mpfr_ptr y,mpfr_srcptr x)32 mpfr_atanh_small (mpfr_ptr y, mpfr_srcptr x)
33 {
34   mpfr_prec_t p = MPFR_PREC(y), err;
35   mpfr_t x2, t, u;
36   unsigned long i;
37   int k;
38 
39   MPFR_ASSERTD(MPFR_GET_EXP (x) <= -1);
40 
41   /* in the following, theta represents a value with |theta| <= 2^(1-p)
42      (might be a different value each time) */
43 
44   mpfr_init2 (t, p);
45   mpfr_init2 (u, p);
46   mpfr_init2 (x2, p);
47   mpfr_set (t, x, MPFR_RNDF);  /* t = x * (1 + theta) */
48   mpfr_set (y, t, MPFR_RNDF);  /* exact */
49   mpfr_sqr (x2, x, MPFR_RNDF); /* x2 = x^2 * (1 + theta) */
50   for (i = 3; ; i += 2)
51     {
52       mpfr_mul (t, t, x2, MPFR_RNDF);    /* t = x^i * (1 + theta)^i */
53       mpfr_div_ui (u, t, i, MPFR_RNDF); /* u = x^i/i * (1 + theta)^(i+1) */
54       if (MPFR_GET_EXP (u) <= MPFR_GET_EXP (y) - p) /* |u| < ulp(y) */
55         break;
56       mpfr_add (y, y, u, MPFR_RNDF); /* error <= ulp(y) */
57     }
58   /* We assume |(1 + theta)^(i+1)| <= 2.
59      The neglected part is at most |u| + |u|/4 + |u|/16 + ... <= 4/3*|u|,
60      which has to be multiplied by |(1 + theta)^(i+1)| <= 2, thus at most
61      3 ulp(y).
62      The rounding error on y is bounded by:
63      * for the (i-3)/2 add/sub, each error is bounded by ulp(y_i),
64        where y_i is the current value of y, which is bounded by ulp(y)
65        for y the final value (since it increases in absolute value),
66        this yields (i-3)/2*ulp(y)
67      * from Lemma 3.1 from [Higham02] (see algorithms.tex),
68        the relative error on u at step i is bounded by:
69        (i+1)*epsilon/(1-(i+1)*epsilon) where epsilon = 2^(1-p).
70        If (i+1)*epsilon <= 1/2, then the relative error on u at
71        step i is bounded by 2*(i+1)*epsilon, and since |u| <= 1/2^(i+1)
72        at step i, this gives an absolute error bound of;
73        2*epsilon*x*(4/2^4 + 6/2^6 + 8/2^8 + ...) = 2*2^(1-p)*x*(7/18) =
74        14/9*2^(-p)*x <= 2*ulp(x).
75 
76      If (i+1)*epsilon <= 1/2, then the relative error on u at step i
77      is bounded by (i+1)*epsilon/(1-(i+1)*epsilon) <= 1, thus it follows
78      |(1 + theta)^(i+1)| <= 2.
79 
80      Finally the total error is bounded by 3*ulp(y) + (i-3)/2*ulp(y) +2*ulp(x).
81      Since x <= 2*y, we have ulp(x) <= 2*ulp(y), thus the error is bounded by:
82      (i+7)/2*ulp(y).
83   */
84   err = (i + 8) / 2; /* ceil((i+7)/2) */
85   k = __gmpfr_int_ceil_log2 (err);
86   MPFR_ASSERTN(k + 2 < p);
87   /* if k + 2 < p, since k = ceil(log2(err)), we have err <= 2^k <= 2^(p-3),
88      thus i+7 <= 2*err <= 2^(p-2), thus (i+7)*epsilon <= 1/2, which implies
89      our assumption (i+1)*epsilon <= 1/2. */
90   mpfr_clear (t);
91   mpfr_clear (u);
92   mpfr_clear (x2);
93   return k;
94 }
95 
96 /* The computation of atanh is done by:
97    atanh = ln((1+x)/(1-x)) / 2
98    except when x is very small, in which case atanh = x + tiny error,
99    and when x is small, where we use directly the Taylor expansion.
100 */
101 
102 int
mpfr_atanh(mpfr_ptr y,mpfr_srcptr xt,mpfr_rnd_t rnd_mode)103 mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
104 {
105   int inexact;
106   mpfr_t x, t, te;
107   mpfr_prec_t Nx, Ny, Nt;
108   mpfr_exp_t err;
109   MPFR_ZIV_DECL (loop);
110   MPFR_SAVE_EXPO_DECL (expo);
111 
112   MPFR_LOG_FUNC
113     (("x[%Pd]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
114     ("y[%Pd]=%.*Rg inexact=%d",
115      mpfr_get_prec (y), mpfr_log_prec, y, inexact));
116 
117   /* Special cases */
118   if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
119     {
120       /* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
121          between -1 and 1 */
122       if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt))
123         {
124           MPFR_SET_NAN (y);
125           MPFR_RET_NAN;
126         }
127       else /* necessarily xt is 0 */
128         {
129           MPFR_ASSERTD (MPFR_IS_ZERO (xt));
130           MPFR_SET_ZERO (y);   /* atanh(0) = 0 */
131           MPFR_SET_SAME_SIGN (y,xt);
132           MPFR_RET (0);
133         }
134     }
135 
136   /* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
137   if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0))
138     {
139       if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt))
140         {
141           MPFR_SET_INF (y);
142           MPFR_SET_SAME_SIGN (y, xt);
143           MPFR_SET_DIVBY0 ();
144           MPFR_RET (0);
145         }
146       MPFR_SET_NAN (y);
147       MPFR_RET_NAN;
148     }
149 
150   /* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
151   MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1,
152                                     rnd_mode, {});
153 
154   MPFR_SAVE_EXPO_MARK (expo);
155 
156   /* Compute initial precision */
157   Nx = MPFR_PREC (xt);
158   MPFR_TMP_INIT_ABS (x, xt);
159   Ny = MPFR_PREC (y);
160   Nt = MAX (Nx, Ny);
161   Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
162 
163   /* initialize of intermediary variable */
164   mpfr_init2 (t, Nt);
165   mpfr_init2 (te, Nt);
166 
167   MPFR_ZIV_INIT (loop, Nt);
168   for (;;)
169     {
170       int k;
171 
172         /* small case: assuming the AGM algorithm used by mpfr_log uses
173            log2(p) steps for a precision of p bits, we try the special
174            variant whenever EXP(x) <= -p/log2(p). */
175         k = 1 + __gmpfr_int_ceil_log2 (Ny); /* the +1 avoids a division by 0
176                                                when Ny=1 */
177         if (MPFR_GET_EXP (x) <= - 1 - (mpfr_exp_t) (Ny / k))
178           /* this implies EXP(x) <= -1 thus x < 1/2 */
179           {
180             err = Nt - mpfr_atanh_small (t, x);
181             goto round;
182           }
183 
184       /* compute atanh */
185       mpfr_ui_sub (te, 1, x, MPFR_RNDU);   /* (1-x) with x = |xt| */
186       mpfr_add_ui (t, x, 1, MPFR_RNDD);    /* (1+x) */
187       mpfr_div (t, t, te, MPFR_RNDN);      /* (1+x)/(1-x) */
188       mpfr_log (t, t, MPFR_RNDN);          /* ln((1+x)/(1-x)) */
189       mpfr_div_2ui (t, t, 1, MPFR_RNDN);   /* ln((1+x)/(1-x)) / 2 */
190 
191       /* error estimate: see algorithms.tex */
192       /* FIXME: this does not correspond to the value in algorithms.tex!!! */
193       /* err = Nt - __gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t))); */
194       err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
195 
196     round:
197       if (MPFR_LIKELY (MPFR_IS_ZERO (t)
198                        || MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
199         break;
200 
201       /* reactualisation of the precision */
202       MPFR_ZIV_NEXT (loop, Nt);
203       mpfr_set_prec (t, Nt);
204       mpfr_set_prec (te, Nt);
205     }
206   MPFR_ZIV_FREE (loop);
207 
208   inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
209 
210   mpfr_clear (t);
211   mpfr_clear (te);
212 
213   MPFR_SAVE_EXPO_FREE (expo);
214   return mpfr_check_range (y, inexact, rnd_mode);
215 }
216