1 //  Copyright John Maddock 2008.
2 //  Use, modification and distribution are subject to the
3 //  Boost Software License, Version 1.0. (See accompanying file
4 //  LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
5 //
6 // Wrapper that works with mpfr::mpreal defined in gmpfrxx.h
7 // See http://math.berkeley.edu/~wilken/code/gmpfrxx/
8 // Also requires the gmp and mpfr libraries.
9 //
10 
11 #ifndef BOOST_MATH_MPREAL_BINDINGS_HPP
12 #define BOOST_MATH_MPREAL_BINDINGS_HPP
13 
14 #include <boost/config.hpp>
15 #include <boost/lexical_cast.hpp>
16 
17 #ifdef BOOST_MSVC
18 //
19 // We get a lot of warnings from the gmp, mpfr and gmpfrxx headers,
20 // disable them here, so we only see warnings from *our* code:
21 //
22 #pragma warning(push)
23 #pragma warning(disable: 4127 4800 4512)
24 #endif
25 
26 #include <mpreal.h>
27 
28 #ifdef BOOST_MSVC
29 #pragma warning(pop)
30 #endif
31 
32 #include <boost/math/tools/precision.hpp>
33 #include <boost/math/tools/real_cast.hpp>
34 #include <boost/math/policies/policy.hpp>
35 #include <boost/math/distributions/fwd.hpp>
36 #include <boost/math/special_functions/math_fwd.hpp>
37 #include <boost/math/bindings/detail/big_digamma.hpp>
38 #include <boost/math/bindings/detail/big_lanczos.hpp>
39 
40 namespace mpfr{
41 
42 template <class T>
operator +(const mpreal & r,const T & t)43 inline mpreal operator + (const mpreal& r, const T& t){ return r + mpreal(t); }
44 template <class T>
operator -(const mpreal & r,const T & t)45 inline mpreal operator - (const mpreal& r, const T& t){ return r - mpreal(t); }
46 template <class T>
operator *(const mpreal & r,const T & t)47 inline mpreal operator * (const mpreal& r, const T& t){ return r * mpreal(t); }
48 template <class T>
operator /(const mpreal & r,const T & t)49 inline mpreal operator / (const mpreal& r, const T& t){ return r / mpreal(t); }
50 
51 template <class T>
operator +(const T & t,const mpreal & r)52 inline mpreal operator + (const T& t, const mpreal& r){ return mpreal(t) + r; }
53 template <class T>
operator -(const T & t,const mpreal & r)54 inline mpreal operator - (const T& t, const mpreal& r){ return mpreal(t) - r; }
55 template <class T>
operator *(const T & t,const mpreal & r)56 inline mpreal operator * (const T& t, const mpreal& r){ return mpreal(t) * r; }
57 template <class T>
operator /(const T & t,const mpreal & r)58 inline mpreal operator / (const T& t, const mpreal& r){ return mpreal(t) / r; }
59 
60 template <class T>
operator ==(const mpreal & r,const T & t)61 inline bool operator == (const mpreal& r, const T& t){ return r == mpreal(t); }
62 template <class T>
operator !=(const mpreal & r,const T & t)63 inline bool operator != (const mpreal& r, const T& t){ return r != mpreal(t); }
64 template <class T>
operator <=(const mpreal & r,const T & t)65 inline bool operator <= (const mpreal& r, const T& t){ return r <= mpreal(t); }
66 template <class T>
operator >=(const mpreal & r,const T & t)67 inline bool operator >= (const mpreal& r, const T& t){ return r >= mpreal(t); }
68 template <class T>
operator <(const mpreal & r,const T & t)69 inline bool operator < (const mpreal& r, const T& t){ return r < mpreal(t); }
70 template <class T>
operator >(const mpreal & r,const T & t)71 inline bool operator > (const mpreal& r, const T& t){ return r > mpreal(t); }
72 
73 template <class T>
operator ==(const T & t,const mpreal & r)74 inline bool operator == (const T& t, const mpreal& r){ return mpreal(t) == r; }
75 template <class T>
operator !=(const T & t,const mpreal & r)76 inline bool operator != (const T& t, const mpreal& r){ return mpreal(t) != r; }
77 template <class T>
operator <=(const T & t,const mpreal & r)78 inline bool operator <= (const T& t, const mpreal& r){ return mpreal(t) <= r; }
79 template <class T>
operator >=(const T & t,const mpreal & r)80 inline bool operator >= (const T& t, const mpreal& r){ return mpreal(t) >= r; }
81 template <class T>
operator <(const T & t,const mpreal & r)82 inline bool operator < (const T& t, const mpreal& r){ return mpreal(t) < r; }
83 template <class T>
operator >(const T & t,const mpreal & r)84 inline bool operator > (const T& t, const mpreal& r){ return mpreal(t) > r; }
85 
86 /*
87 inline mpfr::mpreal fabs(const mpfr::mpreal& v)
88 {
89    return abs(v);
90 }
91 inline mpfr::mpreal pow(const mpfr::mpreal& b, const mpfr::mpreal e)
92 {
93    mpfr::mpreal result;
94    mpfr_pow(result.__get_mp(), b.__get_mp(), e.__get_mp(), GMP_RNDN);
95    return result;
96 }
97 */
ldexp(const mpfr::mpreal & v,int e)98 inline mpfr::mpreal ldexp(const mpfr::mpreal& v, int e)
99 {
100    return mpfr::ldexp(v, static_cast<mp_exp_t>(e));
101 }
102 
frexp(const mpfr::mpreal & v,int * expon)103 inline mpfr::mpreal frexp(const mpfr::mpreal& v, int* expon)
104 {
105    mp_exp_t e;
106    mpfr::mpreal r = mpfr::frexp(v, &e);
107    *expon = e;
108    return r;
109 }
110 
111 #if (MPFR_VERSION < MPFR_VERSION_NUM(2,4,0))
fmod(const mpfr::mpreal & v1,const mpfr::mpreal & v2)112 mpfr::mpreal fmod(const mpfr::mpreal& v1, const mpfr::mpreal& v2)
113 {
114    mpfr::mpreal n;
115    if(v1 < 0)
116       n = ceil(v1 / v2);
117    else
118       n = floor(v1 / v2);
119    return v1 - n * v2;
120 }
121 #endif
122 
123 template <class Policy>
modf(const mpfr::mpreal & v,long long * ipart,const Policy & pol)124 inline mpfr::mpreal modf(const mpfr::mpreal& v, long long* ipart, const Policy& pol)
125 {
126    *ipart = lltrunc(v, pol);
127    return v - boost::math::tools::real_cast<mpfr::mpreal>(*ipart);
128 }
129 template <class Policy>
iround(mpfr::mpreal const & x,const Policy & pol)130 inline int iround(mpfr::mpreal const& x, const Policy& pol)
131 {
132    return boost::math::tools::real_cast<int>(boost::math::round(x, pol));
133 }
134 
135 template <class Policy>
lround(mpfr::mpreal const & x,const Policy & pol)136 inline long lround(mpfr::mpreal const& x, const Policy& pol)
137 {
138    return boost::math::tools::real_cast<long>(boost::math::round(x, pol));
139 }
140 
141 template <class Policy>
llround(mpfr::mpreal const & x,const Policy & pol)142 inline long long llround(mpfr::mpreal const& x, const Policy& pol)
143 {
144    return boost::math::tools::real_cast<long long>(boost::math::round(x, pol));
145 }
146 
147 template <class Policy>
itrunc(mpfr::mpreal const & x,const Policy & pol)148 inline int itrunc(mpfr::mpreal const& x, const Policy& pol)
149 {
150    return boost::math::tools::real_cast<int>(boost::math::trunc(x, pol));
151 }
152 
153 template <class Policy>
ltrunc(mpfr::mpreal const & x,const Policy & pol)154 inline long ltrunc(mpfr::mpreal const& x, const Policy& pol)
155 {
156    return boost::math::tools::real_cast<long>(boost::math::trunc(x, pol));
157 }
158 
159 template <class Policy>
lltrunc(mpfr::mpreal const & x,const Policy & pol)160 inline long long lltrunc(mpfr::mpreal const& x, const Policy& pol)
161 {
162    return boost::math::tools::real_cast<long long>(boost::math::trunc(x, pol));
163 }
164 
165 }
166 
167 namespace boost{ namespace math{
168 
169 #if defined(__GNUC__) && (__GNUC__ < 4)
170    using ::iround;
171    using ::lround;
172    using ::llround;
173    using ::itrunc;
174    using ::ltrunc;
175    using ::lltrunc;
176    using ::modf;
177 #endif
178 
179 namespace lanczos{
180 
181 struct mpreal_lanczos
182 {
lanczos_sumboost::math::lanczos::mpreal_lanczos183    static mpfr::mpreal lanczos_sum(const mpfr::mpreal& z)
184    {
185       unsigned long p = z.get_default_prec();
186       if(p <= 72)
187          return lanczos13UDT::lanczos_sum(z);
188       else if(p <= 120)
189          return lanczos22UDT::lanczos_sum(z);
190       else if(p <= 170)
191          return lanczos31UDT::lanczos_sum(z);
192       else //if(p <= 370) approx 100 digit precision:
193          return lanczos61UDT::lanczos_sum(z);
194    }
lanczos_sum_expG_scaledboost::math::lanczos::mpreal_lanczos195    static mpfr::mpreal lanczos_sum_expG_scaled(const mpfr::mpreal& z)
196    {
197       unsigned long p = z.get_default_prec();
198       if(p <= 72)
199          return lanczos13UDT::lanczos_sum_expG_scaled(z);
200       else if(p <= 120)
201          return lanczos22UDT::lanczos_sum_expG_scaled(z);
202       else if(p <= 170)
203          return lanczos31UDT::lanczos_sum_expG_scaled(z);
204       else //if(p <= 370) approx 100 digit precision:
205          return lanczos61UDT::lanczos_sum_expG_scaled(z);
206    }
lanczos_sum_near_1boost::math::lanczos::mpreal_lanczos207    static mpfr::mpreal lanczos_sum_near_1(const mpfr::mpreal& z)
208    {
209       unsigned long p = z.get_default_prec();
210       if(p <= 72)
211          return lanczos13UDT::lanczos_sum_near_1(z);
212       else if(p <= 120)
213          return lanczos22UDT::lanczos_sum_near_1(z);
214       else if(p <= 170)
215          return lanczos31UDT::lanczos_sum_near_1(z);
216       else //if(p <= 370) approx 100 digit precision:
217          return lanczos61UDT::lanczos_sum_near_1(z);
218    }
lanczos_sum_near_2boost::math::lanczos::mpreal_lanczos219    static mpfr::mpreal lanczos_sum_near_2(const mpfr::mpreal& z)
220    {
221       unsigned long p = z.get_default_prec();
222       if(p <= 72)
223          return lanczos13UDT::lanczos_sum_near_2(z);
224       else if(p <= 120)
225          return lanczos22UDT::lanczos_sum_near_2(z);
226       else if(p <= 170)
227          return lanczos31UDT::lanczos_sum_near_2(z);
228       else //if(p <= 370) approx 100 digit precision:
229          return lanczos61UDT::lanczos_sum_near_2(z);
230    }
gboost::math::lanczos::mpreal_lanczos231    static mpfr::mpreal g()
232    {
233       unsigned long p = mpfr::mpreal::get_default_prec();
234       if(p <= 72)
235          return lanczos13UDT::g();
236       else if(p <= 120)
237          return lanczos22UDT::g();
238       else if(p <= 170)
239          return lanczos31UDT::g();
240       else //if(p <= 370) approx 100 digit precision:
241          return lanczos61UDT::g();
242    }
243 };
244 
245 template<class Policy>
246 struct lanczos<mpfr::mpreal, Policy>
247 {
248    typedef mpreal_lanczos type;
249 };
250 
251 } // namespace lanczos
252 
253 namespace tools
254 {
255 
256 template<>
digits(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))257 inline int digits<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
258 {
259    return mpfr::mpreal::get_default_prec();
260 }
261 
262 namespace detail{
263 
264 template<class I>
convert_to_long_result(mpfr::mpreal const & r,I & result)265 void convert_to_long_result(mpfr::mpreal const& r, I& result)
266 {
267    result = 0;
268    I last_result(0);
269    mpfr::mpreal t(r);
270    double term;
271    do
272    {
273       term = real_cast<double>(t);
274       last_result = result;
275       result += static_cast<I>(term);
276       t -= term;
277    }while(result != last_result);
278 }
279 
280 }
281 
282 template <>
real_cast(long long t)283 inline mpfr::mpreal real_cast<mpfr::mpreal, long long>(long long t)
284 {
285    mpfr::mpreal result;
286    int expon = 0;
287    int sign = 1;
288    if(t < 0)
289    {
290       sign = -1;
291       t = -t;
292    }
293    while(t)
294    {
295       result += ldexp((double)(t & 0xffffL), expon);
296       expon += 32;
297       t >>= 32;
298    }
299    return result * sign;
300 }
301 /*
302 template <>
303 inline unsigned real_cast<unsigned, mpfr::mpreal>(mpfr::mpreal t)
304 {
305    return t.get_ui();
306 }
307 template <>
308 inline int real_cast<int, mpfr::mpreal>(mpfr::mpreal t)
309 {
310    return t.get_si();
311 }
312 template <>
313 inline double real_cast<double, mpfr::mpreal>(mpfr::mpreal t)
314 {
315    return t.get_d();
316 }
317 template <>
318 inline float real_cast<float, mpfr::mpreal>(mpfr::mpreal t)
319 {
320    return static_cast<float>(t.get_d());
321 }
322 template <>
323 inline long real_cast<long, mpfr::mpreal>(mpfr::mpreal t)
324 {
325    long result;
326    detail::convert_to_long_result(t, result);
327    return result;
328 }
329 */
330 template <>
real_cast(mpfr::mpreal t)331 inline long long real_cast<long long, mpfr::mpreal>(mpfr::mpreal t)
332 {
333    long long result;
334    detail::convert_to_long_result(t, result);
335    return result;
336 }
337 
338 template <>
max_value(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))339 inline mpfr::mpreal max_value<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
340 {
341    static bool has_init = false;
342    static mpfr::mpreal val(0.5);
343    if(!has_init)
344    {
345       val = ldexp(val, mpfr_get_emax());
346       has_init = true;
347    }
348    return val;
349 }
350 
351 template <>
min_value(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))352 inline mpfr::mpreal min_value<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
353 {
354    static bool has_init = false;
355    static mpfr::mpreal val(0.5);
356    if(!has_init)
357    {
358       val = ldexp(val, mpfr_get_emin());
359       has_init = true;
360    }
361    return val;
362 }
363 
364 template <>
log_max_value(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))365 inline mpfr::mpreal log_max_value<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
366 {
367    static bool has_init = false;
368    static mpfr::mpreal val = max_value<mpfr::mpreal>();
369    if(!has_init)
370    {
371       val = log(val);
372       has_init = true;
373    }
374    return val;
375 }
376 
377 template <>
log_min_value(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))378 inline mpfr::mpreal log_min_value<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
379 {
380    static bool has_init = false;
381    static mpfr::mpreal val = max_value<mpfr::mpreal>();
382    if(!has_init)
383    {
384       val = log(val);
385       has_init = true;
386    }
387    return val;
388 }
389 
390 template <>
epsilon(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC (mpfr::mpreal))391 inline mpfr::mpreal epsilon<mpfr::mpreal>(BOOST_MATH_EXPLICIT_TEMPLATE_TYPE_SPEC(mpfr::mpreal))
392 {
393    return ldexp(mpfr::mpreal(1), 1-boost::math::policies::digits<mpfr::mpreal, boost::math::policies::policy<> >());
394 }
395 
396 } // namespace tools
397 
398 template <class Policy>
skewness(const extreme_value_distribution<mpfr::mpreal,Policy> &)399 inline mpfr::mpreal skewness(const extreme_value_distribution<mpfr::mpreal, Policy>& /*dist*/)
400 {
401    //
402    // This is 12 * sqrt(6) * zeta(3) / pi^3:
403    // See http://mathworld.wolfram.com/ExtremeValueDistribution.html
404    //
405    return boost::lexical_cast<mpfr::mpreal>("1.1395470994046486574927930193898461120875997958366");
406 }
407 
408 template <class Policy>
skewness(const rayleigh_distribution<mpfr::mpreal,Policy> &)409 inline mpfr::mpreal skewness(const rayleigh_distribution<mpfr::mpreal, Policy>& /*dist*/)
410 {
411   // using namespace boost::math::constants;
412   return boost::lexical_cast<mpfr::mpreal>("0.63111065781893713819189935154422777984404221106391");
413   // Computed using NTL at 150 bit, about 50 decimal digits.
414   // return 2 * root_pi<RealType>() * pi_minus_three<RealType>() / pow23_four_minus_pi<RealType>();
415 }
416 
417 template <class Policy>
kurtosis(const rayleigh_distribution<mpfr::mpreal,Policy> &)418 inline mpfr::mpreal kurtosis(const rayleigh_distribution<mpfr::mpreal, Policy>& /*dist*/)
419 {
420   // using namespace boost::math::constants;
421   return boost::lexical_cast<mpfr::mpreal>("3.2450893006876380628486604106197544154170667057995");
422   // Computed using NTL at 150 bit, about 50 decimal digits.
423   // return 3 - (6 * pi<RealType>() * pi<RealType>() - 24 * pi<RealType>() + 16) /
424   // (four_minus_pi<RealType>() * four_minus_pi<RealType>());
425 }
426 
427 template <class Policy>
kurtosis_excess(const rayleigh_distribution<mpfr::mpreal,Policy> &)428 inline mpfr::mpreal kurtosis_excess(const rayleigh_distribution<mpfr::mpreal, Policy>& /*dist*/)
429 {
430   //using namespace boost::math::constants;
431   // Computed using NTL at 150 bit, about 50 decimal digits.
432   return boost::lexical_cast<mpfr::mpreal>("0.2450893006876380628486604106197544154170667057995");
433   // return -(6 * pi<RealType>() * pi<RealType>() - 24 * pi<RealType>() + 16) /
434   //   (four_minus_pi<RealType>() * four_minus_pi<RealType>());
435 } // kurtosis
436 
437 namespace detail{
438 
439 //
440 // Version of Digamma accurate to ~100 decimal digits.
441 //
442 template <class Policy>
digamma_imp(mpfr::mpreal x,const boost::integral_constant<int,0> *,const Policy & pol)443 mpfr::mpreal digamma_imp(mpfr::mpreal x, const boost::integral_constant<int, 0>* , const Policy& pol)
444 {
445    //
446    // This handles reflection of negative arguments, and all our
447    // empfr_classor handling, then forwards to the T-specific approximation.
448    //
449    BOOST_MATH_STD_USING // ADL of std functions.
450 
451    mpfr::mpreal result = 0;
452    //
453    // Check for negative arguments and use reflection:
454    //
455    if(x < 0)
456    {
457       // Reflect:
458       x = 1 - x;
459       // Argument reduction for tan:
460       mpfr::mpreal remainder = x - floor(x);
461       // Shift to negative if > 0.5:
462       if(remainder > 0.5)
463       {
464          remainder -= 1;
465       }
466       //
467       // check for evaluation at a negative pole:
468       //
469       if(remainder == 0)
470       {
471          return policies::raise_pole_error<mpfr::mpreal>("boost::math::digamma<%1%>(%1%)", 0, (1-x), pol);
472       }
473       result = constants::pi<mpfr::mpreal>() / tan(constants::pi<mpfr::mpreal>() * remainder);
474    }
475    result += big_digamma(x);
476    return result;
477 }
478 //
479 // Specialisations of this function provides the initial
480 // starting guess for Halley iteration:
481 //
482 template <class Policy>
erf_inv_imp(const mpfr::mpreal & p,const mpfr::mpreal & q,const Policy &,const boost::integral_constant<int,64> *)483 mpfr::mpreal erf_inv_imp(const mpfr::mpreal& p, const mpfr::mpreal& q, const Policy&, const boost::integral_constant<int, 64>*)
484 {
485    BOOST_MATH_STD_USING // for ADL of std names.
486 
487    mpfr::mpreal result = 0;
488 
489    if(p <= 0.5)
490    {
491       //
492       // Evaluate inverse erf using the rational approximation:
493       //
494       // x = p(p+10)(Y+R(p))
495       //
496       // Where Y is a constant, and R(p) is optimised for a low
497       // absolute empfr_classor compared to |Y|.
498       //
499       // double: Max empfr_classor found: 2.001849e-18
500       // long double: Max empfr_classor found: 1.017064e-20
501       // Maximum Deviation Found (actual empfr_classor term at infinite precision) 8.030e-21
502       //
503       static const float Y = 0.0891314744949340820313f;
504       static const mpfr::mpreal P[] = {
505          -0.000508781949658280665617,
506          -0.00836874819741736770379,
507          0.0334806625409744615033,
508          -0.0126926147662974029034,
509          -0.0365637971411762664006,
510          0.0219878681111168899165,
511          0.00822687874676915743155,
512          -0.00538772965071242932965
513       };
514       static const mpfr::mpreal Q[] = {
515          1,
516          -0.970005043303290640362,
517          -1.56574558234175846809,
518          1.56221558398423026363,
519          0.662328840472002992063,
520          -0.71228902341542847553,
521          -0.0527396382340099713954,
522          0.0795283687341571680018,
523          -0.00233393759374190016776,
524          0.000886216390456424707504
525       };
526       mpfr::mpreal g = p * (p + 10);
527       mpfr::mpreal r = tools::evaluate_polynomial(P, p) / tools::evaluate_polynomial(Q, p);
528       result = g * Y + g * r;
529    }
530    else if(q >= 0.25)
531    {
532       //
533       // Rational approximation for 0.5 > q >= 0.25
534       //
535       // x = sqrt(-2*log(q)) / (Y + R(q))
536       //
537       // Where Y is a constant, and R(q) is optimised for a low
538       // absolute empfr_classor compared to Y.
539       //
540       // double : Max empfr_classor found: 7.403372e-17
541       // long double : Max empfr_classor found: 6.084616e-20
542       // Maximum Deviation Found (empfr_classor term) 4.811e-20
543       //
544       static const float Y = 2.249481201171875f;
545       static const mpfr::mpreal P[] = {
546          -0.202433508355938759655,
547          0.105264680699391713268,
548          8.37050328343119927838,
549          17.6447298408374015486,
550          -18.8510648058714251895,
551          -44.6382324441786960818,
552          17.445385985570866523,
553          21.1294655448340526258,
554          -3.67192254707729348546
555       };
556       static const mpfr::mpreal Q[] = {
557          1,
558          6.24264124854247537712,
559          3.9713437953343869095,
560          -28.6608180499800029974,
561          -20.1432634680485188801,
562          48.5609213108739935468,
563          10.8268667355460159008,
564          -22.6436933413139721736,
565          1.72114765761200282724
566       };
567       mpfr::mpreal g = sqrt(-2 * log(q));
568       mpfr::mpreal xs = q - 0.25;
569       mpfr::mpreal r = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
570       result = g / (Y + r);
571    }
572    else
573    {
574       //
575       // For q < 0.25 we have a series of rational approximations all
576       // of the general form:
577       //
578       // let: x = sqrt(-log(q))
579       //
580       // Then the result is given by:
581       //
582       // x(Y+R(x-B))
583       //
584       // where Y is a constant, B is the lowest value of x for which
585       // the approximation is valid, and R(x-B) is optimised for a low
586       // absolute empfr_classor compared to Y.
587       //
588       // Note that almost all code will really go through the first
589       // or maybe second approximation.  After than we're dealing with very
590       // small input values indeed: 80 and 128 bit long double's go all the
591       // way down to ~ 1e-5000 so the "tail" is rather long...
592       //
593       mpfr::mpreal x = sqrt(-log(q));
594       if(x < 3)
595       {
596          // Max empfr_classor found: 1.089051e-20
597          static const float Y = 0.807220458984375f;
598          static const mpfr::mpreal P[] = {
599             -0.131102781679951906451,
600             -0.163794047193317060787,
601             0.117030156341995252019,
602             0.387079738972604337464,
603             0.337785538912035898924,
604             0.142869534408157156766,
605             0.0290157910005329060432,
606             0.00214558995388805277169,
607             -0.679465575181126350155e-6,
608             0.285225331782217055858e-7,
609             -0.681149956853776992068e-9
610          };
611          static const mpfr::mpreal Q[] = {
612             1,
613             3.46625407242567245975,
614             5.38168345707006855425,
615             4.77846592945843778382,
616             2.59301921623620271374,
617             0.848854343457902036425,
618             0.152264338295331783612,
619             0.01105924229346489121
620          };
621          mpfr::mpreal xs = x - 1.125;
622          mpfr::mpreal R = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
623          result = Y * x + R * x;
624       }
625       else if(x < 6)
626       {
627          // Max empfr_classor found: 8.389174e-21
628          static const float Y = 0.93995571136474609375f;
629          static const mpfr::mpreal P[] = {
630             -0.0350353787183177984712,
631             -0.00222426529213447927281,
632             0.0185573306514231072324,
633             0.00950804701325919603619,
634             0.00187123492819559223345,
635             0.000157544617424960554631,
636             0.460469890584317994083e-5,
637             -0.230404776911882601748e-9,
638             0.266339227425782031962e-11
639          };
640          static const mpfr::mpreal Q[] = {
641             1,
642             1.3653349817554063097,
643             0.762059164553623404043,
644             0.220091105764131249824,
645             0.0341589143670947727934,
646             0.00263861676657015992959,
647             0.764675292302794483503e-4
648          };
649          mpfr::mpreal xs = x - 3;
650          mpfr::mpreal R = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
651          result = Y * x + R * x;
652       }
653       else if(x < 18)
654       {
655          // Max empfr_classor found: 1.481312e-19
656          static const float Y = 0.98362827301025390625f;
657          static const mpfr::mpreal P[] = {
658             -0.0167431005076633737133,
659             -0.00112951438745580278863,
660             0.00105628862152492910091,
661             0.000209386317487588078668,
662             0.149624783758342370182e-4,
663             0.449696789927706453732e-6,
664             0.462596163522878599135e-8,
665             -0.281128735628831791805e-13,
666             0.99055709973310326855e-16
667          };
668          static const mpfr::mpreal Q[] = {
669             1,
670             0.591429344886417493481,
671             0.138151865749083321638,
672             0.0160746087093676504695,
673             0.000964011807005165528527,
674             0.275335474764726041141e-4,
675             0.282243172016108031869e-6
676          };
677          mpfr::mpreal xs = x - 6;
678          mpfr::mpreal R = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
679          result = Y * x + R * x;
680       }
681       else if(x < 44)
682       {
683          // Max empfr_classor found: 5.697761e-20
684          static const float Y = 0.99714565277099609375f;
685          static const mpfr::mpreal P[] = {
686             -0.0024978212791898131227,
687             -0.779190719229053954292e-5,
688             0.254723037413027451751e-4,
689             0.162397777342510920873e-5,
690             0.396341011304801168516e-7,
691             0.411632831190944208473e-9,
692             0.145596286718675035587e-11,
693             -0.116765012397184275695e-17
694          };
695          static const mpfr::mpreal Q[] = {
696             1,
697             0.207123112214422517181,
698             0.0169410838120975906478,
699             0.000690538265622684595676,
700             0.145007359818232637924e-4,
701             0.144437756628144157666e-6,
702             0.509761276599778486139e-9
703          };
704          mpfr::mpreal xs = x - 18;
705          mpfr::mpreal R = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
706          result = Y * x + R * x;
707       }
708       else
709       {
710          // Max empfr_classor found: 1.279746e-20
711          static const float Y = 0.99941349029541015625f;
712          static const mpfr::mpreal P[] = {
713             -0.000539042911019078575891,
714             -0.28398759004727721098e-6,
715             0.899465114892291446442e-6,
716             0.229345859265920864296e-7,
717             0.225561444863500149219e-9,
718             0.947846627503022684216e-12,
719             0.135880130108924861008e-14,
720             -0.348890393399948882918e-21
721          };
722          static const mpfr::mpreal Q[] = {
723             1,
724             0.0845746234001899436914,
725             0.00282092984726264681981,
726             0.468292921940894236786e-4,
727             0.399968812193862100054e-6,
728             0.161809290887904476097e-8,
729             0.231558608310259605225e-11
730          };
731          mpfr::mpreal xs = x - 44;
732          mpfr::mpreal R = tools::evaluate_polynomial(P, xs) / tools::evaluate_polynomial(Q, xs);
733          result = Y * x + R * x;
734       }
735    }
736    return result;
737 }
738 
bessel_i0(mpfr::mpreal x)739 inline mpfr::mpreal bessel_i0(mpfr::mpreal x)
740 {
741     static const mpfr::mpreal P1[] = {
742         boost::lexical_cast<mpfr::mpreal>("-2.2335582639474375249e+15"),
743         boost::lexical_cast<mpfr::mpreal>("-5.5050369673018427753e+14"),
744         boost::lexical_cast<mpfr::mpreal>("-3.2940087627407749166e+13"),
745         boost::lexical_cast<mpfr::mpreal>("-8.4925101247114157499e+11"),
746         boost::lexical_cast<mpfr::mpreal>("-1.1912746104985237192e+10"),
747         boost::lexical_cast<mpfr::mpreal>("-1.0313066708737980747e+08"),
748         boost::lexical_cast<mpfr::mpreal>("-5.9545626019847898221e+05"),
749         boost::lexical_cast<mpfr::mpreal>("-2.4125195876041896775e+03"),
750         boost::lexical_cast<mpfr::mpreal>("-7.0935347449210549190e+00"),
751         boost::lexical_cast<mpfr::mpreal>("-1.5453977791786851041e-02"),
752         boost::lexical_cast<mpfr::mpreal>("-2.5172644670688975051e-05"),
753         boost::lexical_cast<mpfr::mpreal>("-3.0517226450451067446e-08"),
754         boost::lexical_cast<mpfr::mpreal>("-2.6843448573468483278e-11"),
755         boost::lexical_cast<mpfr::mpreal>("-1.5982226675653184646e-14"),
756         boost::lexical_cast<mpfr::mpreal>("-5.2487866627945699800e-18"),
757     };
758     static const mpfr::mpreal Q1[] = {
759         boost::lexical_cast<mpfr::mpreal>("-2.2335582639474375245e+15"),
760         boost::lexical_cast<mpfr::mpreal>("7.8858692566751002988e+12"),
761         boost::lexical_cast<mpfr::mpreal>("-1.2207067397808979846e+10"),
762         boost::lexical_cast<mpfr::mpreal>("1.0377081058062166144e+07"),
763         boost::lexical_cast<mpfr::mpreal>("-4.8527560179962773045e+03"),
764         boost::lexical_cast<mpfr::mpreal>("1.0"),
765     };
766     static const mpfr::mpreal P2[] = {
767         boost::lexical_cast<mpfr::mpreal>("-2.2210262233306573296e-04"),
768         boost::lexical_cast<mpfr::mpreal>("1.3067392038106924055e-02"),
769         boost::lexical_cast<mpfr::mpreal>("-4.4700805721174453923e-01"),
770         boost::lexical_cast<mpfr::mpreal>("5.5674518371240761397e+00"),
771         boost::lexical_cast<mpfr::mpreal>("-2.3517945679239481621e+01"),
772         boost::lexical_cast<mpfr::mpreal>("3.1611322818701131207e+01"),
773         boost::lexical_cast<mpfr::mpreal>("-9.6090021968656180000e+00"),
774     };
775     static const mpfr::mpreal Q2[] = {
776         boost::lexical_cast<mpfr::mpreal>("-5.5194330231005480228e-04"),
777         boost::lexical_cast<mpfr::mpreal>("3.2547697594819615062e-02"),
778         boost::lexical_cast<mpfr::mpreal>("-1.1151759188741312645e+00"),
779         boost::lexical_cast<mpfr::mpreal>("1.3982595353892851542e+01"),
780         boost::lexical_cast<mpfr::mpreal>("-6.0228002066743340583e+01"),
781         boost::lexical_cast<mpfr::mpreal>("8.5539563258012929600e+01"),
782         boost::lexical_cast<mpfr::mpreal>("-3.1446690275135491500e+01"),
783         boost::lexical_cast<mpfr::mpreal>("1.0"),
784     };
785     mpfr::mpreal value, factor, r;
786 
787     BOOST_MATH_STD_USING
788     using namespace boost::math::tools;
789 
790     if (x < 0)
791     {
792         x = -x;                         // even function
793     }
794     if (x == 0)
795     {
796         return static_cast<mpfr::mpreal>(1);
797     }
798     if (x <= 15)                        // x in (0, 15]
799     {
800         mpfr::mpreal y = x * x;
801         value = evaluate_polynomial(P1, y) / evaluate_polynomial(Q1, y);
802     }
803     else                                // x in (15, \infty)
804     {
805         mpfr::mpreal y = 1 / x - mpfr::mpreal(1) / 15;
806         r = evaluate_polynomial(P2, y) / evaluate_polynomial(Q2, y);
807         factor = exp(x) / sqrt(x);
808         value = factor * r;
809     }
810 
811     return value;
812 }
813 
bessel_i1(mpfr::mpreal x)814 inline mpfr::mpreal bessel_i1(mpfr::mpreal x)
815 {
816     static const mpfr::mpreal P1[] = {
817         static_cast<mpfr::mpreal>("-1.4577180278143463643e+15"),
818         static_cast<mpfr::mpreal>("-1.7732037840791591320e+14"),
819         static_cast<mpfr::mpreal>("-6.9876779648010090070e+12"),
820         static_cast<mpfr::mpreal>("-1.3357437682275493024e+11"),
821         static_cast<mpfr::mpreal>("-1.4828267606612366099e+09"),
822         static_cast<mpfr::mpreal>("-1.0588550724769347106e+07"),
823         static_cast<mpfr::mpreal>("-5.1894091982308017540e+04"),
824         static_cast<mpfr::mpreal>("-1.8225946631657315931e+02"),
825         static_cast<mpfr::mpreal>("-4.7207090827310162436e-01"),
826         static_cast<mpfr::mpreal>("-9.1746443287817501309e-04"),
827         static_cast<mpfr::mpreal>("-1.3466829827635152875e-06"),
828         static_cast<mpfr::mpreal>("-1.4831904935994647675e-09"),
829         static_cast<mpfr::mpreal>("-1.1928788903603238754e-12"),
830         static_cast<mpfr::mpreal>("-6.5245515583151902910e-16"),
831         static_cast<mpfr::mpreal>("-1.9705291802535139930e-19"),
832     };
833     static const mpfr::mpreal Q1[] = {
834         static_cast<mpfr::mpreal>("-2.9154360556286927285e+15"),
835         static_cast<mpfr::mpreal>("9.7887501377547640438e+12"),
836         static_cast<mpfr::mpreal>("-1.4386907088588283434e+10"),
837         static_cast<mpfr::mpreal>("1.1594225856856884006e+07"),
838         static_cast<mpfr::mpreal>("-5.1326864679904189920e+03"),
839         static_cast<mpfr::mpreal>("1.0"),
840     };
841     static const mpfr::mpreal P2[] = {
842         static_cast<mpfr::mpreal>("1.4582087408985668208e-05"),
843         static_cast<mpfr::mpreal>("-8.9359825138577646443e-04"),
844         static_cast<mpfr::mpreal>("2.9204895411257790122e-02"),
845         static_cast<mpfr::mpreal>("-3.4198728018058047439e-01"),
846         static_cast<mpfr::mpreal>("1.3960118277609544334e+00"),
847         static_cast<mpfr::mpreal>("-1.9746376087200685843e+00"),
848         static_cast<mpfr::mpreal>("8.5591872901933459000e-01"),
849         static_cast<mpfr::mpreal>("-6.0437159056137599999e-02"),
850     };
851     static const mpfr::mpreal Q2[] = {
852         static_cast<mpfr::mpreal>("3.7510433111922824643e-05"),
853         static_cast<mpfr::mpreal>("-2.2835624489492512649e-03"),
854         static_cast<mpfr::mpreal>("7.4212010813186530069e-02"),
855         static_cast<mpfr::mpreal>("-8.5017476463217924408e-01"),
856         static_cast<mpfr::mpreal>("3.2593714889036996297e+00"),
857         static_cast<mpfr::mpreal>("-3.8806586721556593450e+00"),
858         static_cast<mpfr::mpreal>("1.0"),
859     };
860     mpfr::mpreal value, factor, r, w;
861 
862     BOOST_MATH_STD_USING
863     using namespace boost::math::tools;
864 
865     w = abs(x);
866     if (x == 0)
867     {
868         return static_cast<mpfr::mpreal>(0);
869     }
870     if (w <= 15)                        // w in (0, 15]
871     {
872         mpfr::mpreal y = x * x;
873         r = evaluate_polynomial(P1, y) / evaluate_polynomial(Q1, y);
874         factor = w;
875         value = factor * r;
876     }
877     else                                // w in (15, \infty)
878     {
879         mpfr::mpreal y = 1 / w - mpfr::mpreal(1) / 15;
880         r = evaluate_polynomial(P2, y) / evaluate_polynomial(Q2, y);
881         factor = exp(w) / sqrt(w);
882         value = factor * r;
883     }
884 
885     if (x < 0)
886     {
887         value *= -value;                 // odd function
888     }
889     return value;
890 }
891 
892 } // namespace detail
893 } // namespace math
894 
895 }
896 
897 #endif // BOOST_MATH_MPLFR_BINDINGS_HPP
898 
899