9 #include "cln/lfloat.h"
15 #include "cln/float.h"
19 #define MAYBE_INLINE inline
20 #include "cl_LF_zerop.cc"
21 #include "cl_LF_minusp.cc"
22 #include "cl_LF_exponent.cc"
26 // cl_F atanhx (const cl_F& x)
27 // cl_LF atanhx (const cl_LF& x)
30 // e := Exponent aus (decode-float x), d := (float-digits x)
31 // Bei x=0.0 oder e<=-d/2 liefere x
32 // (denn bei e<=-d/2 ist x^2 < 2^(-d), also
33 // 1 <= atanh(x)/x = 1+x^2/3+x^4/5+... < 1+x^2/2 < 1+2^(-d-1) < 1+2^(-d),
34 // also ist atanh(x)/x, auf d Bits gerundet, gleich 1.0).
35 // Bei großem d verwende die Formel ln((1+x)/(1-x))/2 (asymptotisch schneller),
36 // aber erhöhe die Genauigkeit, so daß beim Bilden von 1+x keine Bits verloren
38 // Bei e<=-sqrt(d) verwende die Potenzreihe
39 // atanh(x)/x = sum(j=0..inf,(x^2)^j/(2j+1)):
40 // a:=x^2, b:=1, i:=1, sum:=0,
41 // while (/= sum (setq sum (+ sum (/ b i)))) do i:=i+2, b:=b*a.
43 // Sonst setze y := x/(1+sqrt(1-x^2)), berechne rekursiv z:=atanh(y)
44 // und liefere 2*z = (scale-float z 1).
45 // Diese Rekursion wird entrekursiviert. Statt k mal hintereinander
46 // x := x/(1+sqrt(1-x^2)) zu bilden, arbeitet man lieber mit den Kehrwerten,
47 // setzt also x := 1/|x|, dann k mal x := x+sqrt(x^2-1), dann x := +- 1/x.
48 // Aufwand: asymptotisch d^2.5 .
50 const cl_LF atanhx (const cl_LF& x)
54 var uintC actuallen = TheLfloat(x)->len;
55 var uintC d = float_digits(x);
56 var sintE e = float_exponent(x);
57 if (e <= (sintC)(-d)>>1) // e <= -d/2 <==> e <= -ceiling(d/2)
58 return x; // ja -> x als Ergebnis
59 if (actuallen >= 34) {
61 var cl_LF xx = extend(x,TheLfloat(x)->len+ceiling((uintE)(-e),intDsize));
62 return cl_float(scale_float(ln((1+xx)/(1-xx)),-1),x);
64 var uintL k = 0; // Rekursionszähler k:=0
65 // Bei e <= -1-limit_slope*floor(sqrt(d)) kann die Potenzreihe
66 // angewandt werden. limit_slope = 1.0 ist schlecht (ca. 15% zu
67 // schlecht). Ein guter Wert ist:
68 // für naive1: limit_scope = 0.625 = 5/8,
69 // für naive2: limit_scope = 0.4 = 13/32.
70 var uintL sqrt_d = floor(isqrtC(d)*13,32); // limit_slope*floor(sqrt(d))
72 if (e >= (sintL)(-sqrt_d)) {
73 // e > -1-limit_slope*floor(sqrt(d)) -> muß |x| verkleinern.
74 var sintL e_limit = 1+sqrt_d; // 1+limit_slope*floor(sqrt(d))
75 xx = recip(abs(xx)); // 1/|x|
77 // nächstes x nach der Formel x := x+sqrt(x^2 - 1) berechnen:
78 xx = sqrt(square(xx) + cl_float(-1,xx)) + xx;
80 } until (float_exponent(xx) > e_limit);
81 // Schleifenende mit Exponent(x) > 1+limit_slope*floor(sqrt(d)),
82 // also x >= 2^(1+limit_slope*floor(sqrt(d))),
83 // also 1/x <= 2^(-1-limit_slope*floor(sqrt(d))).
84 // Nun kann die Potenzreihe auf 1/x angewandt werden.
87 xx = - xx; // Vorzeichen wieder rein
89 // Potenzreihe anwenden:
91 var cl_LF a = square(xx); // a = x^2
92 var cl_LF b = cl_float(1,xx); // b := (float 1 x)
93 var cl_LF sum = cl_float(0,xx); // sum := (float 0 x)
96 // floating-point representation
98 var cl_LF new_sum = sum + b/(cl_I)i; // (+ sum (/ b i))
99 if (new_sum == sum) // = sum ?
100 break; // ja -> Potenzreihe abbrechen
107 // floating-point representation with smooth precision reduction
108 var cl_LF eps = scale_float(b,-(sintC)d-10);
110 var cl_LF new_sum = sum + LF_to_LF(b/(cl_I)i,actuallen); // (+ sum (/ b i))
111 if (new_sum == sum) // = sum ?
112 break; // ja -> Potenzreihe abbrechen
114 b = cl_LF_shortenwith(b,eps);
119 var cl_LF erg = sum*xx; // sum*x als Ergebnis
120 return scale_float(erg,k); // wegen Rekursion noch mal 2^k
122 // Bit complexity (N = length(x)): O(log(N)^2*M(N)).
124 const cl_F atanhx (const cl_F& x)
127 DeclareType(cl_LF,x);
132 var uintC d = float_digits(x);
133 var sintE e = float_exponent(x);
134 if (e <= (sintC)(-d)>>1) // e <= -d/2 <==> e <= -ceiling(d/2)
135 return x; // ja -> x als Ergebnis
136 var uintL k = 0; // Rekursionszähler k:=0
137 // Bei e <= -1-limit_slope*floor(sqrt(d)) kann die Potenzreihe
138 // angewandt werden. limit_slope = 1.0 ist schlecht (ca. 15% zu
139 // schlecht). Ein guter Wert ist limit_scope = 0.625 = 5/8.
140 var uintL sqrt_d = floor(isqrtC(d)*5,8); // limit_slope*floor(sqrt(d))
142 if (e >= (sintL)(-sqrt_d)) {
143 // e > -1-limit_slope*floor(sqrt(d)) -> muß |x| verkleinern.
144 var sintL e_limit = 1+sqrt_d; // 1+limit_slope*floor(sqrt(d))
145 xx = recip(abs(xx)); // 1/|x|
147 // nächstes x nach der Formel x := x+sqrt(x^2 - 1) berechnen:
148 xx = sqrt(square(xx) + cl_float(-1,xx)) + xx;
150 } until (float_exponent(xx) > e_limit);
151 // Schleifenende mit Exponent(x) > 1+limit_slope*floor(sqrt(d)),
152 // also x >= 2^(1+limit_slope*floor(sqrt(d))),
153 // also 1/x <= 2^(-1-limit_slope*floor(sqrt(d))).
154 // Nun kann die Potenzreihe auf 1/x angewandt werden.
157 xx = - xx; // Vorzeichen wieder rein
159 // Potenzreihe anwenden:
161 var cl_F a = square(xx); // a = x^2
162 var cl_F b = cl_float(1,xx); // b := (float 1 x)
163 var cl_F sum = cl_float(0,xx); // sum := (float 0 x)
165 var cl_F new_sum = sum + b / (cl_I)i; // (+ sum (/ b i))
166 if (new_sum == sum) // = sum ?
167 break; // ja -> Potenzreihe abbrechen
172 var cl_F erg = sum*xx; // sum*x als Ergebnis
173 return scale_float(erg,k); // wegen Rekursion noch mal 2^k
175 // Bit complexity (N = length(x)): O(log(N)^2*M(N)).
177 // Timings of the above algorithms, on an i486 33 MHz, running Linux,
178 // applied to x = sqrt(2)-1 = 0.414...
179 // N naive1 naive2 use ln
180 // 10 0.013 0.013 0.015
181 // 25 0.064 0.050 0.049
182 // 50 0.25 0.018 0.17
183 // 100 1.07 0.75 0.64
187 // ==> using ln faster for N >= 34.