Chris@16: //  Copyright (c) 2006 Xiaogang Zhang
Chris@16: //  Copyright (c) 2006 John Maddock
Chris@16: //  Use, modification and distribution are subject to the
Chris@16: //  Boost Software License, Version 1.0. (See accompanying file
Chris@16: //  LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
Chris@16: //
Chris@16: //  History:
Chris@16: //  XZ wrote the original of this file as part of the Google
Chris@16: //  Summer of Code 2006.  JM modified it to fit into the
Chris@16: //  Boost.Math conceptual framework better, and to correctly
Chris@16: //  handle the various corner cases.
Chris@16: //
Chris@16: 
Chris@16: #ifndef BOOST_MATH_ELLINT_3_HPP
Chris@16: #define BOOST_MATH_ELLINT_3_HPP
Chris@16: 
Chris@16: #ifdef _MSC_VER
Chris@16: #pragma once
Chris@16: #endif
Chris@16: 
Chris@101: #include <boost/math/special_functions/math_fwd.hpp>
Chris@16: #include <boost/math/special_functions/ellint_rf.hpp>
Chris@16: #include <boost/math/special_functions/ellint_rj.hpp>
Chris@16: #include <boost/math/special_functions/ellint_1.hpp>
Chris@16: #include <boost/math/special_functions/ellint_2.hpp>
Chris@16: #include <boost/math/special_functions/log1p.hpp>
Chris@101: #include <boost/math/special_functions/atanh.hpp>
Chris@16: #include <boost/math/constants/constants.hpp>
Chris@16: #include <boost/math/policies/error_handling.hpp>
Chris@16: #include <boost/math/tools/workaround.hpp>
Chris@16: #include <boost/math/special_functions/round.hpp>
Chris@16: 
Chris@16: // Elliptic integrals (complete and incomplete) of the third kind
Chris@16: // Carlson, Numerische Mathematik, vol 33, 1 (1979)
Chris@16: 
Chris@16: namespace boost { namespace math { 
Chris@16:    
Chris@16: namespace detail{
Chris@16: 
Chris@16: template <typename T, typename Policy>
Chris@16: T ellint_pi_imp(T v, T k, T vc, const Policy& pol);
Chris@16: 
Chris@16: // Elliptic integral (Legendre form) of the third kind
Chris@16: template <typename T, typename Policy>
Chris@16: T ellint_pi_imp(T v, T phi, T k, T vc, const Policy& pol)
Chris@16: {
Chris@101:    // Note vc = 1-v presumably without cancellation error.
Chris@101:    BOOST_MATH_STD_USING
Chris@16: 
Chris@101:    static const char* function = "boost::math::ellint_3<%1%>(%1%,%1%,%1%)";
Chris@16: 
Chris@101:    if(abs(k) > 1)
Chris@101:    {
Chris@101:       return policies::raise_domain_error<T>(function,
Chris@101:          "Got k = %1%, function requires |k| <= 1", k, pol);
Chris@101:    }
Chris@16: 
Chris@101:    T sphi = sin(fabs(phi));
Chris@101:    T result = 0;
Chris@16: 
Chris@101:    if(v > 1 / (sphi * sphi))
Chris@101:    {
Chris@101:       // Complex result is a domain error:
Chris@101:       return policies::raise_domain_error<T>(function,
Chris@101:          "Got v = %1%, but result is complex for v > 1 / sin^2(phi)", v, pol);
Chris@101:    }
Chris@16: 
Chris@101:    // Special cases first:
Chris@101:    if(v == 0)
Chris@101:    {
Chris@101:       // A&S 17.7.18 & 19
Chris@101:       return (k == 0) ? phi : ellint_f_imp(phi, k, pol);
Chris@101:    }
Chris@101:    if(v == 1)
Chris@101:    {
Chris@101:       // http://functions.wolfram.com/08.06.03.0008.01
Chris@101:       T m = k * k;
Chris@101:       result = sqrt(1 - m * sphi * sphi) * tan(phi) - ellint_e_imp(phi, k, pol);
Chris@101:       result /= 1 - m;
Chris@101:       result += ellint_f_imp(phi, k, pol);
Chris@101:       return result;
Chris@101:    }
Chris@101:    if(phi == constants::half_pi<T>())
Chris@101:    {
Chris@101:       // Have to filter this case out before the next
Chris@101:       // special case, otherwise we might get an infinity from
Chris@101:       // tan(phi).
Chris@101:       // Also note that since we can't represent PI/2 exactly
Chris@101:       // in a T, this is a bit of a guess as to the users true
Chris@101:       // intent...
Chris@101:       //
Chris@101:       return ellint_pi_imp(v, k, vc, pol);
Chris@101:    }
Chris@101:    if((phi > constants::half_pi<T>()) || (phi < 0))
Chris@101:    {
Chris@101:       // Carlson's algorithm works only for |phi| <= pi/2,
Chris@101:       // use the integrand's periodicity to normalize phi
Chris@101:       //
Chris@101:       // Xiaogang's original code used a cast to long long here
Chris@101:       // but that fails if T has more digits than a long long,
Chris@101:       // so rewritten to use fmod instead:
Chris@101:       //
Chris@101:       // See http://functions.wolfram.com/08.06.16.0002.01
Chris@101:       //
Chris@101:       if(fabs(phi) > 1 / tools::epsilon<T>())
Chris@101:       {
Chris@101:          if(v > 1)
Chris@101:             return policies::raise_domain_error<T>(
Chris@16:             function,
Chris@16:             "Got v = %1%, but this is only supported for 0 <= phi <= pi/2", v, pol);
Chris@101:          //  
Chris@101:          // Phi is so large that phi%pi is necessarily zero (or garbage),
Chris@101:          // just return the second part of the duplication formula:
Chris@101:          //
Chris@101:          result = 2 * fabs(phi) * ellint_pi_imp(v, k, vc, pol) / constants::pi<T>();
Chris@101:       }
Chris@101:       else
Chris@101:       {
Chris@101:          T rphi = boost::math::tools::fmod_workaround(T(fabs(phi)), T(constants::half_pi<T>()));
Chris@101:          T m = boost::math::round((fabs(phi) - rphi) / constants::half_pi<T>());
Chris@101:          int sign = 1;
Chris@101:          if((m != 0) && (k >= 1))
Chris@101:          {
Chris@101:             return policies::raise_domain_error<T>(function, "Got k=1 and phi=%1% but the result is complex in that domain", phi, pol);
Chris@101:          }
Chris@101:          if(boost::math::tools::fmod_workaround(m, T(2)) > 0.5)
Chris@101:          {
Chris@101:             m += 1;
Chris@101:             sign = -1;
Chris@101:             rphi = constants::half_pi<T>() - rphi;
Chris@101:          }
Chris@101:          result = sign * ellint_pi_imp(v, rphi, k, vc, pol);
Chris@101:          if((m > 0) && (vc > 0))
Chris@101:             result += m * ellint_pi_imp(v, k, vc, pol);
Chris@101:       }
Chris@101:       return phi < 0 ? -result : result;
Chris@101:    }
Chris@101:    if(k == 0)
Chris@101:    {
Chris@101:       // A&S 17.7.20:
Chris@101:       if(v < 1)
Chris@101:       {
Chris@101:          T vcr = sqrt(vc);
Chris@101:          return atan(vcr * tan(phi)) / vcr;
Chris@101:       }
Chris@101:       else if(v == 1)
Chris@101:       {
Chris@101:          return tan(phi);
Chris@101:       }
Chris@101:       else
Chris@101:       {
Chris@101:          // v > 1:
Chris@101:          T vcr = sqrt(-vc);
Chris@101:          T arg = vcr * tan(phi);
Chris@101:          return (boost::math::log1p(arg, pol) - boost::math::log1p(-arg, pol)) / (2 * vcr);
Chris@101:       }
Chris@101:    }
Chris@101:    if(v < 0)
Chris@101:    {
Chris@101:       //
Chris@101:       // If we don't shift to 0 <= v <= 1 we get
Chris@101:       // cancellation errors later on.  Use
Chris@101:       // A&S 17.7.15/16 to shift to v > 0.
Chris@101:       //
Chris@101:       // Mathematica simplifies the expressions
Chris@101:       // given in A&S as follows (with thanks to
Chris@101:       // Rocco Romeo for figuring these out!):
Chris@101:       //
Chris@101:       // V = (k2 - n)/(1 - n)
Chris@101:       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[(1 - V)*(1 - k2 / V)] / Sqrt[((1 - n)*(1 - k2 / n))]]]
Chris@101:       // Result: ((-1 + k2) n) / ((-1 + n) (-k2 + n))
Chris@101:       //
Chris@101:       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[k2 / (Sqrt[-n*(k2 - n) / (1 - n)] * Sqrt[(1 - n)*(1 - k2 / n)])]]
Chris@101:       // Result : k2 / (k2 - n)
Chris@101:       //
Chris@101:       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[1 / ((1 - n)*(1 - k2 / n))]]]
Chris@101:       // Result : Sqrt[n / ((k2 - n) (-1 + n))]
Chris@101:       //
Chris@101:       T k2 = k * k;
Chris@101:       T N = (k2 - v) / (1 - v);
Chris@101:       T Nm1 = (1 - k2) / (1 - v);
Chris@101:       T p2 = -v * N;
Chris@101:       T t;
Chris@101:       if(p2 <= tools::min_value<T>())
Chris@101:          p2 = sqrt(-v) * sqrt(N);
Chris@101:       else
Chris@101:          p2 = sqrt(p2);
Chris@101:       T delta = sqrt(1 - k2 * sphi * sphi);
Chris@101:       if(N > k2)
Chris@101:       {
Chris@101:          result = ellint_pi_imp(N, phi, k, Nm1, pol);
Chris@101:          result *= v / (v - 1);
Chris@101:          result *= (k2 - 1) / (v - k2);
Chris@101:       }
Chris@16: 
Chris@101:       if(k != 0)
Chris@101:       {
Chris@101:          t = ellint_f_imp(phi, k, pol);
Chris@101:          t *= k2 / (k2 - v);
Chris@101:          result += t;
Chris@101:       }
Chris@101:       t = v / ((k2 - v) * (v - 1));
Chris@101:       if(t > tools::min_value<T>())
Chris@101:       {
Chris@101:          result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(t);
Chris@101:       }
Chris@101:       else
Chris@101:       {
Chris@101:          result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(fabs(1 / (k2 - v))) * sqrt(fabs(v / (v - 1)));
Chris@101:       }
Chris@101:       return result;
Chris@101:    }
Chris@101:    if(k == 1)
Chris@101:    {
Chris@101:       // See http://functions.wolfram.com/08.06.03.0013.01
Chris@101:       result = sqrt(v) * atanh(sqrt(v) * sin(phi)) - log(1 / cos(phi) + tan(phi));
Chris@101:       result /= v - 1;
Chris@101:       return result;
Chris@101:    }
Chris@101: #if 0  // disabled but retained for future reference: see below.
Chris@101:    if(v > 1)
Chris@101:    {
Chris@101:       //
Chris@101:       // If v > 1 we can use the identity in A&S 17.7.7/8
Chris@101:       // to shift to 0 <= v <= 1.  In contrast to previous
Chris@101:       // revisions of this header, this identity does now work
Chris@101:       // but appears not to produce better error rates in 
Chris@101:       // practice.  Archived here for future reference...
Chris@101:       //
Chris@101:       T k2 = k * k;
Chris@101:       T N = k2 / v;
Chris@101:       T Nm1 = (v - k2) / v;
Chris@101:       T p1 = sqrt((-vc) * (1 - k2 / v));
Chris@101:       T delta = sqrt(1 - k2 * sphi * sphi);
Chris@101:       //
Chris@101:       // These next two terms have a large amount of cancellation
Chris@101:       // so it's not clear if this relation is useable even if
Chris@101:       // the issues with phi > pi/2 can be fixed:
Chris@101:       //
Chris@101:       result = -ellint_pi_imp(N, phi, k, Nm1, pol);
Chris@101:       result += ellint_f_imp(phi, k, pol);
Chris@101:       //
Chris@101:       // This log term gives the complex result when
Chris@101:       //     n > 1/sin^2(phi)
Chris@101:       // However that case is dealt with as an error above, 
Chris@101:       // so we should always get a real result here:
Chris@101:       //
Chris@101:       result += log((delta + p1 * tan(phi)) / (delta - p1 * tan(phi))) / (2 * p1);
Chris@101:       return result;
Chris@101:    }
Chris@101: #endif
Chris@101:    //
Chris@101:    // Carlson's algorithm works only for |phi| <= pi/2,
Chris@101:    // by the time we get here phi should already have been
Chris@101:    // normalised above.
Chris@101:    //
Chris@101:    BOOST_ASSERT(fabs(phi) < constants::half_pi<T>());
Chris@101:    BOOST_ASSERT(phi >= 0);
Chris@101:    T x, y, z, p, t;
Chris@101:    T cosp = cos(phi);
Chris@101:    x = cosp * cosp;
Chris@101:    t = sphi * sphi;
Chris@101:    y = 1 - k * k * t;
Chris@101:    z = 1;
Chris@101:    if(v * t < 0.5)
Chris@101:       p = 1 - v * t;
Chris@101:    else
Chris@101:       p = x + vc * t;
Chris@101:    result = sphi * (ellint_rf_imp(x, y, z, pol) + v * t * ellint_rj_imp(x, y, z, p, pol) / 3);
Chris@101: 
Chris@101:    return result;
Chris@16: }
Chris@16: 
Chris@16: // Complete elliptic integral (Legendre form) of the third kind
Chris@16: template <typename T, typename Policy>
Chris@16: T ellint_pi_imp(T v, T k, T vc, const Policy& pol)
Chris@16: {
Chris@16:     // Note arg vc = 1-v, possibly without cancellation errors
Chris@16:     BOOST_MATH_STD_USING
Chris@16:     using namespace boost::math::tools;
Chris@16: 
Chris@16:     static const char* function = "boost::math::ellint_pi<%1%>(%1%,%1%)";
Chris@16: 
Chris@16:     if (abs(k) >= 1)
Chris@16:     {
Chris@16:        return policies::raise_domain_error<T>(function,
Chris@16:             "Got k = %1%, function requires |k| <= 1", k, pol);
Chris@16:     }
Chris@16:     if(vc <= 0)
Chris@16:     {
Chris@16:        // Result is complex:
Chris@16:        return policies::raise_domain_error<T>(function,
Chris@16:             "Got v = %1%, function requires v < 1", v, pol);
Chris@16:     }
Chris@16: 
Chris@16:     if(v == 0)
Chris@16:     {
Chris@16:        return (k == 0) ? boost::math::constants::pi<T>() / 2 : ellint_k_imp(k, pol);
Chris@16:     }
Chris@16: 
Chris@16:     if(v < 0)
Chris@16:     {
Chris@101:        // Apply A&S 17.7.17:
Chris@16:        T k2 = k * k;
Chris@16:        T N = (k2 - v) / (1 - v);
Chris@16:        T Nm1 = (1 - k2) / (1 - v);
Chris@101:        T result = 0;
Chris@101:        result = boost::math::detail::ellint_pi_imp(N, k, Nm1, pol);
Chris@101:        // This next part is split in two to avoid spurious over/underflow:
Chris@101:        result *= -v / (1 - v);
Chris@101:        result *= (1 - k2) / (k2 - v);
Chris@101:        result += ellint_k_imp(k, pol) * k2 / (k2 - v);
Chris@16:        return result;
Chris@16:     }
Chris@16: 
Chris@16:     T x = 0;
Chris@16:     T y = 1 - k * k;
Chris@16:     T z = 1;
Chris@16:     T p = vc;
Chris@16:     T value = ellint_rf_imp(x, y, z, pol) + v * ellint_rj_imp(x, y, z, p, pol) / 3;
Chris@16: 
Chris@16:     return value;
Chris@16: }
Chris@16: 
Chris@16: template <class T1, class T2, class T3>
Chris@16: inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const mpl::false_&)
Chris@16: {
Chris@16:    return boost::math::ellint_3(k, v, phi, policies::policy<>());
Chris@16: }
Chris@16: 
Chris@16: template <class T1, class T2, class Policy>
Chris@16: inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v, const Policy& pol, const mpl::true_&)
Chris@16: {
Chris@16:    typedef typename tools::promote_args<T1, T2>::type result_type;
Chris@16:    typedef typename policies::evaluation<result_type, Policy>::type value_type;
Chris@16:    return policies::checked_narrowing_cast<result_type, Policy>(
Chris@16:       detail::ellint_pi_imp(
Chris@16:          static_cast<value_type>(v), 
Chris@16:          static_cast<value_type>(k),
Chris@16:          static_cast<value_type>(1-v),
Chris@16:          pol), "boost::math::ellint_3<%1%>(%1%,%1%)");
Chris@16: }
Chris@16: 
Chris@16: } // namespace detail
Chris@16: 
Chris@16: template <class T1, class T2, class T3, class Policy>
Chris@16: inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const Policy& pol)
Chris@16: {
Chris@16:    typedef typename tools::promote_args<T1, T2, T3>::type result_type;
Chris@16:    typedef typename policies::evaluation<result_type, Policy>::type value_type;
Chris@16:    return policies::checked_narrowing_cast<result_type, Policy>(
Chris@16:       detail::ellint_pi_imp(
Chris@16:          static_cast<value_type>(v), 
Chris@16:          static_cast<value_type>(phi), 
Chris@16:          static_cast<value_type>(k),
Chris@16:          static_cast<value_type>(1-v),
Chris@16:          pol), "boost::math::ellint_3<%1%>(%1%,%1%,%1%)");
Chris@16: }
Chris@16: 
Chris@16: template <class T1, class T2, class T3>
Chris@16: typename detail::ellint_3_result<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi)
Chris@16: {
Chris@16:    typedef typename policies::is_policy<T3>::type tag_type;
Chris@16:    return detail::ellint_3(k, v, phi, tag_type());
Chris@16: }
Chris@16: 
Chris@16: template <class T1, class T2>
Chris@16: inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v)
Chris@16: {
Chris@16:    return ellint_3(k, v, policies::policy<>());
Chris@16: }
Chris@16: 
Chris@16: }} // namespaces
Chris@16: 
Chris@16: #endif // BOOST_MATH_ELLINT_3_HPP
Chris@16: