hypergeometric_rational.hpp 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167
  1. ///////////////////////////////////////////////////////////////////////////////
  2. // Copyright 2014 Anton Bikineev
  3. // Copyright 2014 Christopher Kormanyos
  4. // Copyright 2014 John Maddock
  5. // Copyright 2014 Paul Bristow
  6. // Distributed under the Boost
  7. // Software License, Version 1.0. (See accompanying file
  8. // LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
  9. //
  10. #ifndef BOOST_MATH_HYPERGEOMETRIC_RATIONAL_HPP
  11. #define BOOST_MATH_HYPERGEOMETRIC_RATIONAL_HPP
  12. #include <boost/array.hpp>
  13. namespace boost{ namespace math{ namespace detail{
  14. // Luke: C ------- SUBROUTINE R1F1P(AP, CP, Z, A, B, N) ---------
  15. // Luke: C --- RATIONAL APPROXIMATION OF 1F1( AP ; CP ; -Z ) ----
  16. template <class T, class Policy>
  17. inline T hypergeometric_1F1_rational(const T& ap, const T& cp, const T& zp, const Policy& )
  18. {
  19. BOOST_MATH_STD_USING
  20. static const T zero = T(0), one = T(1), two = T(2), three = T(3);
  21. // Luke: C ------------- INITIALIZATION -------------
  22. const T z = -zp;
  23. const T z2 = z / two;
  24. T ct1 = ap * (z / cp);
  25. T ct2 = z2 / (one + cp);
  26. T xn3 = zero;
  27. T xn2 = one;
  28. T xn1 = two;
  29. T xn0 = three;
  30. T b1 = one;
  31. T a1 = one;
  32. T b2 = one + ((one + ap) * (z2 / cp));
  33. T a2 = b2 - ct1;
  34. T b3 = one + ((two + b2) * (((two + ap) / three) * ct2));
  35. T a3 = b3 - ((one + ct2) * ct1);
  36. ct1 = three;
  37. const unsigned max_iterations = boost::math::policies::get_max_series_iterations<Policy>();
  38. T a4 = T(0), b4 = T(0);
  39. T result = T(0), prev_result = a3 / b3;
  40. for (unsigned k = 2; k < max_iterations; ++k)
  41. {
  42. // Luke: C ----- CALCULATION OF THE MULTIPLIERS -----
  43. // Luke: C ----------- FOR THE RECURSION ------------
  44. ct2 = (z2 / ct1) / (cp + xn1);
  45. const T g1 = one + (ct2 * (xn2 - ap));
  46. ct2 *= ((ap + xn1) / (cp + xn2));
  47. const T g2 = ct2 * ((cp - xn1) + (((ap + xn0) / (ct1 + two)) * z2));
  48. const T g3 = ((ct2 * z2) * (((z2 / ct1) / (ct1 - two)) * ((ap + xn2)) / (cp + xn3))) * (ap - xn2);
  49. // Luke: C ------- THE RECURRENCE RELATIONS ---------
  50. // Luke: C ------------ ARE AS FOLLOWS --------------
  51. b4 = (g1 * b3) + (g2 * b2) + (g3 * b1);
  52. a4 = (g1 * a3) + (g2 * a2) + (g3 * a1);
  53. prev_result = result;
  54. result = a4 / b4;
  55. // condition for interruption
  56. if ((fabs(result) * boost::math::tools::epsilon<T>()) > fabs(result - prev_result) / fabs(result))
  57. break;
  58. b1 = b2; b2 = b3; b3 = b4;
  59. a1 = a2; a2 = a3; a3 = a4;
  60. xn3 = xn2;
  61. xn2 = xn1;
  62. xn1 = xn0;
  63. xn0 += 1;
  64. ct1 += two;
  65. }
  66. return result;
  67. }
  68. // Luke: C ----- SUBROUTINE R2F1P(AB, BP, CP, Z, A, B, N) -------
  69. // Luke: C -- RATIONAL APPROXIMATION OF 2F1( AB , BP; CP ; -Z ) -
  70. template <class T, class Policy>
  71. inline T hypergeometric_2F1_rational(const T& ap, const T& bp, const T& cp, const T& zp, const unsigned n, const Policy& )
  72. {
  73. BOOST_MATH_STD_USING
  74. static const T one = T(1), two = T(2), three = T(3), four = T(4),
  75. six = T(6), half_7 = T(3.5), half_3 = T(1.5), forth_3 = T(0.75);
  76. // Luke: C ------------- INITIALIZATION -------------
  77. const T z = -zp;
  78. const T z2 = z / two;
  79. T sabz = (ap + bp) * z;
  80. const T ab = ap * bp;
  81. const T abz = ab * z;
  82. const T abz1 = z + (abz + sabz);
  83. const T abz2 = abz1 + (sabz + (three * z));
  84. const T cp1 = cp + one;
  85. const T ct1 = cp1 + cp1;
  86. T b1 = one;
  87. T a1 = one;
  88. T b2 = one + (abz1 / (cp + cp));
  89. T a2 = b2 - (abz / cp);
  90. T b3 = one + ((abz2 / ct1) * (one + (abz1 / ((-six) + (three * ct1)))));
  91. T a3 = b3 - ((abz / cp) * (one + ((abz2 - abz1) / ct1)));
  92. sabz /= four;
  93. const T abz1_div_4 = abz1 / four;
  94. const T cp1_inc = cp1 + one;
  95. const T cp1_mul_cp1_inc = cp1 * cp1_inc;
  96. boost::array<T, 9u> d = {{
  97. ((half_7 - ab) * z2) - sabz,
  98. abz1_div_4,
  99. abz1_div_4 - (two * sabz),
  100. cp1_inc,
  101. cp1_mul_cp1_inc,
  102. cp * cp1_mul_cp1_inc,
  103. half_3,
  104. forth_3,
  105. forth_3 * z
  106. }};
  107. T xi = three;
  108. T a4 = T(0), b4 = T(0);
  109. for (unsigned k = 2; k < n; ++k)
  110. {
  111. // Luke: C ----- CALCULATION OF THE MULTIPLIERS -----
  112. // Luke: C ----------- FOR THE RECURSION ------------
  113. T g3 = (d[2] / d[7]) * (d[1] / d[5]);
  114. d[1] += d[8] + sabz;
  115. d[2] += d[8] - sabz;
  116. g3 *= d[1] / d[6];
  117. T g1 = one + (((d[1] + d[0]) / d[6]) / d[3]);
  118. T g2 = (d[1] / d[4]) / d[6];
  119. d[7] += two * d[6];
  120. ++d[6];
  121. g2 *= cp1 - (xi + ((d[2] + d[0]) / d[6]));
  122. // Luke: C ------- THE RECURRENCE RELATIONS ---------
  123. // Luke: C ------------ ARE AS FOLLOWS --------------
  124. b4 = (g1 * b3) + (g2 * b2) + (g3 * b1);
  125. a4 = (g1 * a3) + (g2 * a2) + (g3 * a1);
  126. b1 = b2; b2 = b3; b3 = b4;
  127. a1 = a2; a2 = a3; a3 = a4;
  128. d[8] += z2;
  129. d[0] += two * d[8];
  130. d[5] += three * d[4];
  131. d[4] += two * d[3];
  132. ++d[3];
  133. ++xi;
  134. }
  135. return a4 / b4;
  136. }
  137. } } } // namespaces
  138. #endif // BOOST_MATH_HYPERGEOMETRIC_RATIONAL_HPP