375 lines · plain
1// Copyright (c) 2006 Xiaogang Zhang2// Copyright (c) 2006 John Maddock3// Use, modification and distribution are subject to the4// Boost Software License, Version 1.0. (See accompanying file5// LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)6//7// History:8// XZ wrote the original of this file as part of the Google9// Summer of Code 2006. JM modified it to fit into the10// Boost.Math conceptual framework better, and to correctly11// handle the various corner cases.12//13 14#ifndef BOOST_MATH_ELLINT_3_HPP15#define BOOST_MATH_ELLINT_3_HPP16 17#ifdef _MSC_VER18#pragma once19#endif20 21#include <boost/math/tools/config.hpp>22#include <boost/math/tools/type_traits.hpp>23#include <boost/math/special_functions/math_fwd.hpp>24#include <boost/math/special_functions/ellint_rf.hpp>25#include <boost/math/special_functions/ellint_rj.hpp>26#include <boost/math/special_functions/ellint_1.hpp>27#include <boost/math/special_functions/ellint_2.hpp>28#include <boost/math/special_functions/log1p.hpp>29#include <boost/math/special_functions/atanh.hpp>30#include <boost/math/constants/constants.hpp>31#include <boost/math/policies/error_handling.hpp>32#include <boost/math/tools/workaround.hpp>33#include <boost/math/special_functions/round.hpp>34 35// Elliptic integrals (complete and incomplete) of the third kind36// Carlson, Numerische Mathematik, vol 33, 1 (1979)37 38namespace boost { namespace math { 39 40namespace detail{41 42template <typename T, typename Policy>43BOOST_MATH_CUDA_ENABLED T ellint_pi_imp(T v, T k, T vc, const Policy& pol);44 45// Elliptic integral (Legendre form) of the third kind46template <typename T, typename Policy>47BOOST_MATH_CUDA_ENABLED T ellint_pi_imp(T v, T phi, T k, T vc, const Policy& pol)48{49 // Note vc = 1-v presumably without cancellation error.50 BOOST_MATH_STD_USING51 52 constexpr auto function = "boost::math::ellint_3<%1%>(%1%,%1%,%1%)";53 54 55 T sphi = sin(fabs(phi));56 T result = 0;57 58 if (k * k * sphi * sphi > 1)59 {60 return policies::raise_domain_error<T>(function, "Got k = %1%, function requires |k| <= 1", k, pol);61 }62 // Special cases first:63 if(v == 0)64 {65 // A&S 17.7.18 & 1966 return (k == 0) ? phi : ellint_f_imp(phi, k, pol);67 }68 if((v > 0) && (1 / v < (sphi * sphi)))69 {70 // Complex result is a domain error:71 return policies::raise_domain_error<T>(function, "Got v = %1%, but result is complex for v > 1 / sin^2(phi)", v, pol);72 }73 74 if(v == 1)75 {76 if (k == 0)77 return tan(phi);78 79 // http://functions.wolfram.com/08.06.03.0008.0180 T m = k * k;81 result = sqrt(1 - m * sphi * sphi) * tan(phi) - ellint_e_imp(phi, k, pol);82 result /= 1 - m;83 result += ellint_f_imp(phi, k, pol);84 return result;85 }86 if(phi == constants::half_pi<T>())87 {88 // Have to filter this case out before the next89 // special case, otherwise we might get an infinity from90 // tan(phi).91 // Also note that since we can't represent PI/2 exactly92 // in a T, this is a bit of a guess as to the users true93 // intent...94 //95 return ellint_pi_imp(v, k, vc, pol);96 }97 if((phi > constants::half_pi<T>()) || (phi < 0))98 {99 // Carlson's algorithm works only for |phi| <= pi/2,100 // use the integrand's periodicity to normalize phi101 //102 // Xiaogang's original code used a cast to long long here103 // but that fails if T has more digits than a long long,104 // so rewritten to use fmod instead:105 //106 // See http://functions.wolfram.com/08.06.16.0002.01107 //108 if(fabs(phi) > 1 / tools::epsilon<T>())109 {110 // Invalid for v > 1, this case is caught above since v > 1 implies 1/v < sin^2(phi)111 BOOST_MATH_ASSERT(v <= 1);112 // 113 // Phi is so large that phi%pi is necessarily zero (or garbage),114 // just return the second part of the duplication formula:115 //116 result = 2 * fabs(phi) * ellint_pi_imp(v, k, vc, pol) / constants::pi<T>();117 }118 else119 {120 T rphi = boost::math::tools::fmod_workaround(T(fabs(phi)), T(constants::half_pi<T>()));121 T m = boost::math::round((fabs(phi) - rphi) / constants::half_pi<T>());122 int sign = 1;123 if((m != 0) && (k >= 1))124 {125 return policies::raise_domain_error<T>(function, "Got k=1 and phi=%1% but the result is complex in that domain", phi, pol);126 }127 if(boost::math::tools::fmod_workaround(m, T(2)) > T(0.5))128 {129 m += 1;130 sign = -1;131 rphi = constants::half_pi<T>() - rphi;132 }133 result = sign * ellint_pi_imp(v, rphi, k, vc, pol);134 if((m > 0) && (vc > 0))135 result += m * ellint_pi_imp(v, k, vc, pol);136 }137 return phi < 0 ? T(-result) : result;138 }139 if(k == 0)140 {141 // A&S 17.7.20:142 if(v < 1)143 {144 T vcr = sqrt(vc);145 return atan(vcr * tan(phi)) / vcr;146 }147 else148 {149 // v > 1:150 T vcr = sqrt(-vc);151 T arg = vcr * tan(phi);152 return (boost::math::log1p(arg, pol) - boost::math::log1p(-arg, pol)) / (2 * vcr);153 }154 }155 if((v < 0) && fabs(k) <= 1)156 {157 //158 // If we don't shift to 0 <= v <= 1 we get159 // cancellation errors later on. Use160 // A&S 17.7.15/16 to shift to v > 0.161 //162 // Mathematica simplifies the expressions163 // given in A&S as follows (with thanks to164 // Rocco Romeo for figuring these out!):165 //166 // V = (k2 - n)/(1 - n)167 // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[(1 - V)*(1 - k2 / V)] / Sqrt[((1 - n)*(1 - k2 / n))]]]168 // Result: ((-1 + k2) n) / ((-1 + n) (-k2 + n))169 //170 // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[k2 / (Sqrt[-n*(k2 - n) / (1 - n)] * Sqrt[(1 - n)*(1 - k2 / n)])]]171 // Result : k2 / (k2 - n)172 //173 // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[1 / ((1 - n)*(1 - k2 / n))]]]174 // Result : Sqrt[n / ((k2 - n) (-1 + n))]175 //176 T k2 = k * k;177 T N = (k2 - v) / (1 - v);178 T Nm1 = (1 - k2) / (1 - v);179 T p2 = -v * N;180 T t;181 if (p2 <= tools::min_value<T>())182 {183 p2 = sqrt(-v) * sqrt(N);184 }185 else186 p2 = sqrt(p2);187 T delta = sqrt(1 - k2 * sphi * sphi);188 if(N > k2)189 {190 result = ellint_pi_imp(N, phi, k, Nm1, pol);191 result *= v / (v - 1);192 result *= (k2 - 1) / (v - k2);193 }194 195 if(k != 0)196 {197 t = ellint_f_imp(phi, k, pol);198 t *= k2 / (k2 - v);199 result += t;200 }201 t = v / ((k2 - v) * (v - 1));202 if(t > tools::min_value<T>())203 {204 result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(t);205 }206 else207 {208 result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(fabs(1 / (k2 - v))) * sqrt(fabs(v / (v - 1)));209 }210 return result;211 }212 if(k == 1)213 {214 // See http://functions.wolfram.com/08.06.03.0013.01215 result = sqrt(v) * atanh(sqrt(v) * sin(phi), pol) - log(1 / cos(phi) + tan(phi));216 result /= v - 1;217 return result;218 }219#if 0 // disabled but retained for future reference: see below.220 if(v > 1)221 {222 //223 // If v > 1 we can use the identity in A&S 17.7.7/8224 // to shift to 0 <= v <= 1. In contrast to previous225 // revisions of this header, this identity does now work226 // but appears not to produce better error rates in 227 // practice. Archived here for future reference...228 //229 T k2 = k * k;230 T N = k2 / v;231 T Nm1 = (v - k2) / v;232 T p1 = sqrt((-vc) * (1 - k2 / v));233 T delta = sqrt(1 - k2 * sphi * sphi);234 //235 // These next two terms have a large amount of cancellation236 // so it's not clear if this relation is useable even if237 // the issues with phi > pi/2 can be fixed:238 //239 result = -ellint_pi_imp(N, phi, k, Nm1, pol);240 result += ellint_f_imp(phi, k, pol);241 //242 // This log term gives the complex result when243 // n > 1/sin^2(phi)244 // However that case is dealt with as an error above, 245 // so we should always get a real result here:246 //247 result += log((delta + p1 * tan(phi)) / (delta - p1 * tan(phi))) / (2 * p1);248 return result;249 }250#endif251 //252 // Carlson's algorithm works only for |phi| <= pi/2,253 // by the time we get here phi should already have been254 // normalised above.255 //256 BOOST_MATH_ASSERT(fabs(phi) < constants::half_pi<T>());257 BOOST_MATH_ASSERT(phi >= 0);258 T x, y, z, p, t;259 T cosp = cos(phi);260 x = cosp * cosp;261 t = sphi * sphi;262 y = 1 - k * k * t;263 z = 1;264 if(v * t < T(0.5))265 p = 1 - v * t;266 else267 p = x + vc * t;268 result = sphi * (ellint_rf_imp(x, y, z, pol) + v * t * ellint_rj_imp(x, y, z, p, pol) / 3);269 270 return result;271}272 273// Complete elliptic integral (Legendre form) of the third kind274template <typename T, typename Policy>275BOOST_MATH_CUDA_ENABLED T ellint_pi_imp(T v, T k, T vc, const Policy& pol)276{277 // Note arg vc = 1-v, possibly without cancellation errors278 BOOST_MATH_STD_USING279 using namespace boost::math::tools;280 281 constexpr auto function = "boost::math::ellint_pi<%1%>(%1%,%1%)";282 283 if (abs(k) >= 1)284 {285 return policies::raise_domain_error<T>(function, "Got k = %1%, function requires |k| <= 1", k, pol);286 }287 if(vc <= 0)288 {289 // Result is complex:290 return policies::raise_domain_error<T>(function, "Got v = %1%, function requires v < 1", v, pol);291 }292 293 if(v == 0)294 {295 return (k == 0) ? boost::math::constants::pi<T>() / 2 : boost::math::ellint_1(k, pol);296 }297 298 if(v < 0)299 {300 // Apply A&S 17.7.17:301 T k2 = k * k;302 T N = (k2 - v) / (1 - v);303 T Nm1 = (1 - k2) / (1 - v);304 T result = 0;305 result = boost::math::detail::ellint_pi_imp(N, k, Nm1, pol);306 // This next part is split in two to avoid spurious over/underflow:307 result *= -v / (1 - v);308 result *= (1 - k2) / (k2 - v);309 result += boost::math::ellint_1(k, pol) * k2 / (k2 - v);310 return result;311 }312 313 T x = 0;314 T y = 1 - k * k;315 T z = 1;316 T p = vc;317 T value = ellint_rf_imp(x, y, z, pol) + v * ellint_rj_imp(x, y, z, p, pol) / 3;318 319 return value;320}321 322template <class T1, class T2, class T3>323BOOST_MATH_CUDA_ENABLED inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const boost::math::false_type&)324{325 return boost::math::ellint_3(k, v, phi, policies::policy<>());326}327 328template <class T1, class T2, class Policy>329BOOST_MATH_CUDA_ENABLED inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v, const Policy& pol, const boost::math::true_type&)330{331 typedef typename tools::promote_args<T1, T2>::type result_type;332 typedef typename policies::evaluation<result_type, Policy>::type value_type;333 return policies::checked_narrowing_cast<result_type, Policy>(334 detail::ellint_pi_imp(335 static_cast<value_type>(v), 336 static_cast<value_type>(k),337 static_cast<value_type>(1-v),338 pol), "boost::math::ellint_3<%1%>(%1%,%1%)");339}340 341} // namespace detail342 343template <class T1, class T2, class T3, class Policy>344BOOST_MATH_CUDA_ENABLED inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const Policy&)345{346 typedef typename tools::promote_args<T1, T2, T3>::type result_type;347 typedef typename policies::evaluation<result_type, Policy>::type value_type;348 typedef typename policies::normalise<Policy, policies::promote_float<false>, policies::promote_double<false> >::type forwarding_policy;349 return policies::checked_narrowing_cast<result_type, Policy>(350 detail::ellint_pi_imp(351 static_cast<value_type>(v), 352 static_cast<value_type>(phi), 353 static_cast<value_type>(k),354 static_cast<value_type>(1-v),355 forwarding_policy()), "boost::math::ellint_3<%1%>(%1%,%1%,%1%)");356}357 358template <class T1, class T2, class T3>359BOOST_MATH_CUDA_ENABLED typename detail::ellint_3_result<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi)360{361 typedef typename policies::is_policy<T3>::type tag_type;362 return detail::ellint_3(k, v, phi, tag_type());363}364 365template <class T1, class T2>366BOOST_MATH_CUDA_ENABLED inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v)367{368 return ellint_3(k, v, policies::policy<>());369}370 371}} // namespaces372 373#endif // BOOST_MATH_ELLINT_3_HPP374 375