Chris@16: // boost\math\distributions\non_central_beta.hpp
Chris@16: 
Chris@16: // Copyright John Maddock 2008.
Chris@16: 
Chris@16: // Use, modification and distribution are subject to the
Chris@16: // Boost Software License, Version 1.0.
Chris@16: // (See accompanying file LICENSE_1_0.txt
Chris@16: // or copy at http://www.boost.org/LICENSE_1_0.txt)
Chris@16: 
Chris@16: #ifndef BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16: #define BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16: 
Chris@16: #include <boost/math/distributions/fwd.hpp>
Chris@16: #include <boost/math/special_functions/beta.hpp> // for incomplete gamma. gamma_q
Chris@16: #include <boost/math/distributions/complement.hpp> // complements
Chris@16: #include <boost/math/distributions/beta.hpp> // central distribution
Chris@16: #include <boost/math/distributions/detail/generic_mode.hpp>
Chris@16: #include <boost/math/distributions/detail/common_error_handling.hpp> // error checks
Chris@16: #include <boost/math/special_functions/fpclassify.hpp> // isnan.
Chris@16: #include <boost/math/tools/roots.hpp> // for root finding.
Chris@16: #include <boost/math/tools/series.hpp>
Chris@16: 
Chris@16: namespace boost
Chris@16: {
Chris@16:    namespace math
Chris@16:    {
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       class non_central_beta_distribution;
Chris@16: 
Chris@16:       namespace detail{
Chris@16: 
Chris@16:          template <class T, class Policy>
Chris@16:          T non_central_beta_p(T a, T b, T lam, T x, T y, const Policy& pol, T init_val = 0)
Chris@16:          {
Chris@16:             BOOST_MATH_STD_USING
Chris@16:                using namespace boost::math;
Chris@16:             //
Chris@16:             // Variables come first:
Chris@16:             //
Chris@16:             boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16:             T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16:             T l2 = lam / 2;
Chris@16:             //
Chris@16:             // k is the starting point for iteration, and is the
Chris@16:             // maximum of the poisson weighting term,
Chris@16:             // note that unlike other similar code, we do not set
Chris@16:             // k to zero, when l2 is small, as forward iteration
Chris@16:             // is unstable:
Chris@16:             //
Chris@16:             int k = itrunc(l2);
Chris@16:             if(k == 0)
Chris@16:                k = 1;
Chris@16:                // Starting Poisson weight:
Chris@16:             T pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16:             if(pois == 0)
Chris@16:                return init_val;
Chris@16:             // recurance term:
Chris@16:             T xterm;
Chris@16:             // Starting beta term:
Chris@16:             T beta = x < y
Chris@16:                ? detail::ibeta_imp(T(a + k), b, x, pol, false, true, &xterm)
Chris@16:                : detail::ibeta_imp(b, T(a + k), y, pol, true, true, &xterm);
Chris@16: 
Chris@16:             xterm *= y / (a + b + k - 1);
Chris@16:             T poisf(pois), betaf(beta), xtermf(xterm);
Chris@16:             T sum = init_val;
Chris@16: 
Chris@16:             if((beta == 0) && (xterm == 0))
Chris@16:                return init_val;
Chris@16: 
Chris@16:             //
Chris@16:             // Backwards recursion first, this is the stable
Chris@16:             // direction for recursion:
Chris@16:             //
Chris@16:             T last_term = 0;
Chris@16:             boost::uintmax_t count = k;
Chris@16:             for(int i = k; i >= 0; --i)
Chris@16:             {
Chris@16:                T term = beta * pois;
Chris@16:                sum += term;
Chris@16:                if(((fabs(term/sum) < errtol) && (last_term >= term)) || (term == 0))
Chris@16:                {
Chris@16:                   count = k - i;
Chris@16:                   break;
Chris@16:                }
Chris@16:                pois *= i / l2;
Chris@16:                beta += xterm;
Chris@16:                xterm *= (a + i - 1) / (x * (a + b + i - 2));
Chris@16:                last_term = term;
Chris@16:             }
Chris@16:             for(int i = k + 1; ; ++i)
Chris@16:             {
Chris@16:                poisf *= l2 / i;
Chris@16:                xtermf *= (x * (a + b + i - 2)) / (a + i - 1);
Chris@16:                betaf -= xtermf;
Chris@16: 
Chris@16:                T term = poisf * betaf;
Chris@16:                sum += term;
Chris@16:                if((fabs(term/sum) < errtol) || (term == 0))
Chris@16:                {
Chris@16:                   break;
Chris@16:                }
Chris@16:                if(static_cast<boost::uintmax_t>(count + i - k) > max_iter)
Chris@16:                {
Chris@16:                   return policies::raise_evaluation_error(
Chris@16:                      "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16:                      "Series did not converge, closest value was %1%", sum, pol);
Chris@16:                }
Chris@16:             }
Chris@16:             return sum;
Chris@16:          }
Chris@16: 
Chris@16:          template <class T, class Policy>
Chris@16:          T non_central_beta_q(T a, T b, T lam, T x, T y, const Policy& pol, T init_val = 0)
Chris@16:          {
Chris@16:             BOOST_MATH_STD_USING
Chris@16:                using namespace boost::math;
Chris@16:             //
Chris@16:             // Variables come first:
Chris@16:             //
Chris@16:             boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16:             T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16:             T l2 = lam / 2;
Chris@16:             //
Chris@16:             // k is the starting point for iteration, and is the
Chris@16:             // maximum of the poisson weighting term:
Chris@16:             //
Chris@16:             int k = itrunc(l2);
Chris@16:             T pois;
Chris@16:             if(k <= 30)
Chris@16:             {
Chris@16:                //
Chris@16:                // Might as well start at 0 since we'll likely have this number of terms anyway:
Chris@16:                //
Chris@16:                if(a + b > 1)
Chris@16:                   k = 0;
Chris@16:                else if(k == 0)
Chris@16:                   k = 1;
Chris@16:             }
Chris@16:             if(k == 0)
Chris@16:             {
Chris@16:                // Starting Poisson weight:
Chris@16:                pois = exp(-l2);
Chris@16:             }
Chris@16:             else
Chris@16:             {
Chris@16:                // Starting Poisson weight:
Chris@16:                pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16:             }
Chris@16:             if(pois == 0)
Chris@16:                return init_val;
Chris@16:             // recurance term:
Chris@16:             T xterm;
Chris@16:             // Starting beta term:
Chris@16:             T beta = x < y
Chris@16:                ? detail::ibeta_imp(T(a + k), b, x, pol, true, true, &xterm)
Chris@16:                : detail::ibeta_imp(b, T(a + k), y, pol, false, true, &xterm);
Chris@16: 
Chris@16:             xterm *= y / (a + b + k - 1);
Chris@16:             T poisf(pois), betaf(beta), xtermf(xterm);
Chris@16:             T sum = init_val;
Chris@16:             if((beta == 0) && (xterm == 0))
Chris@16:                return init_val;
Chris@16:             //
Chris@16:             // Forwards recursion first, this is the stable
Chris@16:             // direction for recursion, and the location
Chris@16:             // of the bulk of the sum:
Chris@16:             //
Chris@16:             T last_term = 0;
Chris@16:             boost::uintmax_t count = 0;
Chris@16:             for(int i = k + 1; ; ++i)
Chris@16:             {
Chris@16:                poisf *= l2 / i;
Chris@16:                xtermf *= (x * (a + b + i - 2)) / (a + i - 1);
Chris@16:                betaf += xtermf;
Chris@16: 
Chris@16:                T term = poisf * betaf;
Chris@16:                sum += term;
Chris@16:                if((fabs(term/sum) < errtol) && (last_term >= term))
Chris@16:                {
Chris@16:                   count = i - k;
Chris@16:                   break;
Chris@16:                }
Chris@16:                if(static_cast<boost::uintmax_t>(i - k) > max_iter)
Chris@16:                {
Chris@16:                   return policies::raise_evaluation_error(
Chris@16:                      "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16:                      "Series did not converge, closest value was %1%", sum, pol);
Chris@16:                }
Chris@16:                last_term = term;
Chris@16:             }
Chris@16:             for(int i = k; i >= 0; --i)
Chris@16:             {
Chris@16:                T term = beta * pois;
Chris@16:                sum += term;
Chris@16:                if(fabs(term/sum) < errtol)
Chris@16:                {
Chris@16:                   break;
Chris@16:                }
Chris@16:                if(static_cast<boost::uintmax_t>(count + k - i) > max_iter)
Chris@16:                {
Chris@16:                   return policies::raise_evaluation_error(
Chris@16:                      "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16:                      "Series did not converge, closest value was %1%", sum, pol);
Chris@16:                }
Chris@16:                pois *= i / l2;
Chris@16:                beta -= xterm;
Chris@16:                xterm *= (a + i - 1) / (x * (a + b + i - 2));
Chris@16:             }
Chris@16:             return sum;
Chris@16:          }
Chris@16: 
Chris@16:          template <class RealType, class Policy>
Chris@16:          inline RealType non_central_beta_cdf(RealType x, RealType y, RealType a, RealType b, RealType l, bool invert, const Policy&)
Chris@16:          {
Chris@16:             typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16:             typedef typename policies::normalise<
Chris@16:                Policy,
Chris@16:                policies::promote_float<false>,
Chris@16:                policies::promote_double<false>,
Chris@16:                policies::discrete_quantile<>,
Chris@16:                policies::assert_undefined<> >::type forwarding_policy;
Chris@16: 
Chris@16:             BOOST_MATH_STD_USING
Chris@16: 
Chris@16:             if(x == 0)
Chris@16:                return invert ? 1.0f : 0.0f;
Chris@16:             if(y == 0)
Chris@16:                return invert ? 0.0f : 1.0f;
Chris@16:             value_type result;
Chris@16:             value_type c = a + b + l / 2;
Chris@16:             value_type cross = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16:             if(l == 0)
Chris@16:                result = cdf(boost::math::beta_distribution<RealType, Policy>(a, b), x);
Chris@16:             else if(x > cross)
Chris@16:             {
Chris@16:                // Complement is the smaller of the two:
Chris@16:                result = detail::non_central_beta_q(
Chris@16:                   static_cast<value_type>(a),
Chris@16:                   static_cast<value_type>(b),
Chris@16:                   static_cast<value_type>(l),
Chris@16:                   static_cast<value_type>(x),
Chris@16:                   static_cast<value_type>(y),
Chris@16:                   forwarding_policy(),
Chris@16:                   static_cast<value_type>(invert ? 0 : -1));
Chris@16:                invert = !invert;
Chris@16:             }
Chris@16:             else
Chris@16:             {
Chris@16:                result = detail::non_central_beta_p(
Chris@16:                   static_cast<value_type>(a),
Chris@16:                   static_cast<value_type>(b),
Chris@16:                   static_cast<value_type>(l),
Chris@16:                   static_cast<value_type>(x),
Chris@16:                   static_cast<value_type>(y),
Chris@16:                   forwarding_policy(),
Chris@16:                   static_cast<value_type>(invert ? -1 : 0));
Chris@16:             }
Chris@16:             if(invert)
Chris@16:                result = -result;
Chris@16:             return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16:                result,
Chris@16:                "boost::math::non_central_beta_cdf<%1%>(%1%, %1%, %1%)");
Chris@16:          }
Chris@16: 
Chris@16:          template <class T, class Policy>
Chris@16:          struct nc_beta_quantile_functor
Chris@16:          {
Chris@16:             nc_beta_quantile_functor(const non_central_beta_distribution<T,Policy>& d, T t, bool c)
Chris@16:                : dist(d), target(t), comp(c) {}
Chris@16: 
Chris@16:             T operator()(const T& x)
Chris@16:             {
Chris@16:                return comp ?
Chris@16:                   T(target - cdf(complement(dist, x)))
Chris@16:                   : T(cdf(dist, x) - target);
Chris@16:             }
Chris@16: 
Chris@16:          private:
Chris@16:             non_central_beta_distribution<T,Policy> dist;
Chris@16:             T target;
Chris@16:             bool comp;
Chris@16:          };
Chris@16: 
Chris@16:          //
Chris@16:          // This is more or less a copy of bracket_and_solve_root, but
Chris@16:          // modified to search only the interval [0,1] using similar
Chris@16:          // heuristics.
Chris@16:          //
Chris@16:          template <class F, class T, class Tol, class Policy>
Chris@16:          std::pair<T, T> bracket_and_solve_root_01(F f, const T& guess, T factor, bool rising, Tol tol, boost::uintmax_t& max_iter, const Policy& pol)
Chris@16:          {
Chris@16:             BOOST_MATH_STD_USING
Chris@16:                static const char* function = "boost::math::tools::bracket_and_solve_root_01<%1%>";
Chris@16:             //
Chris@16:             // Set up inital brackets:
Chris@16:             //
Chris@16:             T a = guess;
Chris@16:             T b = a;
Chris@16:             T fa = f(a);
Chris@16:             T fb = fa;
Chris@16:             //
Chris@16:             // Set up invocation count:
Chris@16:             //
Chris@16:             boost::uintmax_t count = max_iter - 1;
Chris@16: 
Chris@16:             if((fa < 0) == (guess < 0 ? !rising : rising))
Chris@16:             {
Chris@16:                //
Chris@16:                // Zero is to the right of b, so walk upwards
Chris@16:                // until we find it:
Chris@16:                //
Chris@16:                while((boost::math::sign)(fb) == (boost::math::sign)(fa))
Chris@16:                {
Chris@16:                   if(count == 0)
Chris@16:                   {
Chris@16:                      b = policies::raise_evaluation_error(function, "Unable to bracket root, last nearest value was %1%", b, pol);
Chris@16:                      return std::make_pair(a, b);
Chris@16:                   }
Chris@16:                   //
Chris@16:                   // Heuristic: every 20 iterations we double the growth factor in case the
Chris@16:                   // initial guess was *really* bad !
Chris@16:                   //
Chris@16:                   if((max_iter - count) % 20 == 0)
Chris@16:                      factor *= 2;
Chris@16:                   //
Chris@16:                   // Now go ahead and move are guess by "factor",
Chris@16:                   // we do this by reducing 1-guess by factor:
Chris@16:                   //
Chris@16:                   a = b;
Chris@16:                   fa = fb;
Chris@16:                   b = 1 - ((1 - b) / factor);
Chris@16:                   fb = f(b);
Chris@16:                   --count;
Chris@16:                   BOOST_MATH_INSTRUMENT_CODE("a = " << a << " b = " << b << " fa = " << fa << " fb = " << fb << " count = " << count);
Chris@16:                }
Chris@16:             }
Chris@16:             else
Chris@16:             {
Chris@16:                //
Chris@16:                // Zero is to the left of a, so walk downwards
Chris@16:                // until we find it:
Chris@16:                //
Chris@16:                while((boost::math::sign)(fb) == (boost::math::sign)(fa))
Chris@16:                {
Chris@16:                   if(fabs(a) < tools::min_value<T>())
Chris@16:                   {
Chris@16:                      // Escape route just in case the answer is zero!
Chris@16:                      max_iter -= count;
Chris@16:                      max_iter += 1;
Chris@16:                      return a > 0 ? std::make_pair(T(0), T(a)) : std::make_pair(T(a), T(0));
Chris@16:                   }
Chris@16:                   if(count == 0)
Chris@16:                   {
Chris@16:                      a = policies::raise_evaluation_error(function, "Unable to bracket root, last nearest value was %1%", a, pol);
Chris@16:                      return std::make_pair(a, b);
Chris@16:                   }
Chris@16:                   //
Chris@16:                   // Heuristic: every 20 iterations we double the growth factor in case the
Chris@16:                   // initial guess was *really* bad !
Chris@16:                   //
Chris@16:                   if((max_iter - count) % 20 == 0)
Chris@16:                      factor *= 2;
Chris@16:                   //
Chris@16:                   // Now go ahead and move are guess by "factor":
Chris@16:                   //
Chris@16:                   b = a;
Chris@16:                   fb = fa;
Chris@16:                   a /= factor;
Chris@16:                   fa = f(a);
Chris@16:                   --count;
Chris@16:                   BOOST_MATH_INSTRUMENT_CODE("a = " << a << " b = " << b << " fa = " << fa << " fb = " << fb << " count = " << count);
Chris@16:                }
Chris@16:             }
Chris@16:             max_iter -= count;
Chris@16:             max_iter += 1;
Chris@16:             std::pair<T, T> r = toms748_solve(
Chris@16:                f,
Chris@16:                (a < 0 ? b : a),
Chris@16:                (a < 0 ? a : b),
Chris@16:                (a < 0 ? fb : fa),
Chris@16:                (a < 0 ? fa : fb),
Chris@16:                tol,
Chris@16:                count,
Chris@16:                pol);
Chris@16:             max_iter += count;
Chris@16:             BOOST_MATH_INSTRUMENT_CODE("max_iter = " << max_iter << " count = " << count);
Chris@16:             return r;
Chris@16:          }
Chris@16: 
Chris@16:          template <class RealType, class Policy>
Chris@16:          RealType nc_beta_quantile(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& p, bool comp)
Chris@16:          {
Chris@16:             static const char* function = "quantile(non_central_beta_distribution<%1%>, %1%)";
Chris@16:             typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16:             typedef typename policies::normalise<
Chris@16:                Policy,
Chris@16:                policies::promote_float<false>,
Chris@16:                policies::promote_double<false>,
Chris@16:                policies::discrete_quantile<>,
Chris@16:                policies::assert_undefined<> >::type forwarding_policy;
Chris@16: 
Chris@16:             value_type a = dist.alpha();
Chris@16:             value_type b = dist.beta();
Chris@16:             value_type l = dist.non_centrality();
Chris@16:             value_type r;
Chris@16:             if(!beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy())
Chris@16:                ||
Chris@16:             !detail::check_non_centrality(
Chris@16:                function,
Chris@16:                l,
Chris@16:                &r,
Chris@16:                Policy())
Chris@16:                ||
Chris@16:             !detail::check_probability(
Chris@16:                function,
Chris@16:                static_cast<value_type>(p),
Chris@16:                &r,
Chris@16:                Policy()))
Chris@16:                   return (RealType)r;
Chris@16:             //
Chris@16:             // Special cases first:
Chris@16:             //
Chris@16:             if(p == 0)
Chris@16:                return comp
Chris@16:                ? 1.0f
Chris@16:                : 0.0f;
Chris@16:             if(p == 1)
Chris@16:                return !comp
Chris@16:                ? 1.0f
Chris@16:                : 0.0f;
Chris@16: 
Chris@16:             value_type c = a + b + l / 2;
Chris@16:             value_type mean = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16:             /*
Chris@16:             //
Chris@16:             // Calculate a normal approximation to the quantile,
Chris@16:             // uses mean and variance approximations from:
Chris@16:             // Algorithm AS 310:
Chris@16:             // Computing the Non-Central Beta Distribution Function
Chris@16:             // R. Chattamvelli; R. Shanmugam
Chris@16:             // Applied Statistics, Vol. 46, No. 1. (1997), pp. 146-156.
Chris@16:             //
Chris@16:             // Unfortunately, when this is wrong it tends to be *very*
Chris@16:             // wrong, so it's disabled for now, even though it often
Chris@16:             // gets the initial guess quite close.  Probably we could
Chris@16:             // do much better by factoring in the skewness if only
Chris@16:             // we could calculate it....
Chris@16:             //
Chris@16:             value_type delta = l / 2;
Chris@16:             value_type delta2 = delta * delta;
Chris@16:             value_type delta3 = delta * delta2;
Chris@16:             value_type delta4 = delta2 * delta2;
Chris@16:             value_type G = c * (c + 1) + delta;
Chris@16:             value_type alpha = a + b;
Chris@16:             value_type alpha2 = alpha * alpha;
Chris@16:             value_type eta = (2 * alpha + 1) * (2 * alpha + 1) + 1;
Chris@16:             value_type H = 3 * alpha2 + 5 * alpha + 2;
Chris@16:             value_type F = alpha2 * (alpha + 1) + H * delta
Chris@16:                + (2 * alpha + 4) * delta2 + delta3;
Chris@16:             value_type P = (3 * alpha + 1) * (9 * alpha + 17)
Chris@16:                + 2 * alpha * (3 * alpha + 2) * (3 * alpha + 4) + 15;
Chris@16:             value_type Q = 54 * alpha2 + 162 * alpha + 130;
Chris@16:             value_type R = 6 * (6 * alpha + 11);
Chris@16:             value_type D = delta
Chris@16:                * (H * H + 2 * P * delta + Q * delta2 + R * delta3 + 9 * delta4);
Chris@16:             value_type variance = (b / G)
Chris@16:                * (1 + delta * (l * l + 3 * l + eta) / (G * G))
Chris@16:                - (b * b / F) * (1 + D / (F * F));
Chris@16:             value_type sd = sqrt(variance);
Chris@16: 
Chris@16:             value_type guess = comp
Chris@16:                ? quantile(complement(normal_distribution<RealType, Policy>(static_cast<RealType>(mean), static_cast<RealType>(sd)), p))
Chris@16:                : quantile(normal_distribution<RealType, Policy>(static_cast<RealType>(mean), static_cast<RealType>(sd)), p);
Chris@16: 
Chris@16:             if(guess >= 1)
Chris@16:                guess = mean;
Chris@16:             if(guess <= tools::min_value<value_type>())
Chris@16:                guess = mean;
Chris@16:             */
Chris@16:             value_type guess = mean;
Chris@16:             detail::nc_beta_quantile_functor<value_type, Policy>
Chris@16:                f(non_central_beta_distribution<value_type, Policy>(a, b, l), p, comp);
Chris@16:             tools::eps_tolerance<value_type> tol(policies::digits<RealType, Policy>());
Chris@16:             boost::uintmax_t max_iter = policies::get_max_root_iterations<Policy>();
Chris@16: 
Chris@16:             std::pair<value_type, value_type> ir
Chris@16:                = bracket_and_solve_root_01(
Chris@16:                   f, guess, value_type(2.5), true, tol,
Chris@16:                   max_iter, Policy());
Chris@16:             value_type result = ir.first + (ir.second - ir.first) / 2;
Chris@16: 
Chris@16:             if(max_iter >= policies::get_max_root_iterations<Policy>())
Chris@16:             {
Chris@16:                return policies::raise_evaluation_error<RealType>(function, "Unable to locate solution in a reasonable time:"
Chris@16:                   " either there is no answer to quantile of the non central beta distribution"
Chris@16:                   " or the answer is infinite.  Current best guess is %1%",
Chris@16:                   policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16:                      result,
Chris@16:                      function), Policy());
Chris@16:             }
Chris@16:             return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16:                result,
Chris@16:                function);
Chris@16:          }
Chris@16: 
Chris@16:          template <class T, class Policy>
Chris@16:          T non_central_beta_pdf(T a, T b, T lam, T x, T y, const Policy& pol)
Chris@16:          {
Chris@16:             BOOST_MATH_STD_USING
Chris@16:                using namespace boost::math;
Chris@16:             //
Chris@16:             // Variables come first:
Chris@16:             //
Chris@16:             boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16:             T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16:             T l2 = lam / 2;
Chris@16:             //
Chris@16:             // k is the starting point for iteration, and is the
Chris@16:             // maximum of the poisson weighting term:
Chris@16:             //
Chris@16:             int k = itrunc(l2);
Chris@16:             // Starting Poisson weight:
Chris@16:             T pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16:             // Starting beta term:
Chris@16:             T beta = x < y ?
Chris@16:                ibeta_derivative(a + k, b, x, pol)
Chris@16:                : ibeta_derivative(b, a + k, y, pol);
Chris@16:             T sum = 0;
Chris@16:             T poisf(pois);
Chris@16:             T betaf(beta);
Chris@16: 
Chris@16:             //
Chris@16:             // Stable backwards recursion first:
Chris@16:             //
Chris@16:             boost::uintmax_t count = k;
Chris@16:             for(int i = k; i >= 0; --i)
Chris@16:             {
Chris@16:                T term = beta * pois;
Chris@16:                sum += term;
Chris@16:                if((fabs(term/sum) < errtol) || (term == 0))
Chris@16:                {
Chris@16:                   count = k - i;
Chris@16:                   break;
Chris@16:                }
Chris@16:                pois *= i / l2;
Chris@16:                beta *= (a + i - 1) / (x * (a + i + b - 1));
Chris@16:             }
Chris@16:             for(int i = k + 1; ; ++i)
Chris@16:             {
Chris@16:                poisf *= l2 / i;
Chris@16:                betaf *= x * (a + b + i - 1) / (a + i - 1);
Chris@16: 
Chris@16:                T term = poisf * betaf;
Chris@16:                sum += term;
Chris@16:                if((fabs(term/sum) < errtol) || (term == 0))
Chris@16:                {
Chris@16:                   break;
Chris@16:                }
Chris@16:                if(static_cast<boost::uintmax_t>(count + i - k) > max_iter)
Chris@16:                {
Chris@16:                   return policies::raise_evaluation_error(
Chris@16:                      "pdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16:                      "Series did not converge, closest value was %1%", sum, pol);
Chris@16:                }
Chris@16:             }
Chris@16:             return sum;
Chris@16:          }
Chris@16: 
Chris@16:          template <class RealType, class Policy>
Chris@16:          RealType nc_beta_pdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16:          {
Chris@16:             BOOST_MATH_STD_USING
Chris@16:             static const char* function = "pdf(non_central_beta_distribution<%1%>, %1%)";
Chris@16:             typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16:             typedef typename policies::normalise<
Chris@16:                Policy,
Chris@16:                policies::promote_float<false>,
Chris@16:                policies::promote_double<false>,
Chris@16:                policies::discrete_quantile<>,
Chris@16:                policies::assert_undefined<> >::type forwarding_policy;
Chris@16: 
Chris@16:             value_type a = dist.alpha();
Chris@16:             value_type b = dist.beta();
Chris@16:             value_type l = dist.non_centrality();
Chris@16:             value_type r;
Chris@16:             if(!beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy())
Chris@16:                ||
Chris@16:             !detail::check_non_centrality(
Chris@16:                function,
Chris@16:                l,
Chris@16:                &r,
Chris@16:                Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_x(
Chris@16:                function,
Chris@16:                static_cast<value_type>(x),
Chris@16:                &r,
Chris@16:                Policy()))
Chris@16:                   return (RealType)r;
Chris@16: 
Chris@16:             if(l == 0)
Chris@16:                return pdf(boost::math::beta_distribution<RealType, Policy>(dist.alpha(), dist.beta()), x);
Chris@16:             return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16:                non_central_beta_pdf(a, b, l, static_cast<value_type>(x), value_type(1 - static_cast<value_type>(x)), forwarding_policy()),
Chris@16:                "function");
Chris@16:          }
Chris@16: 
Chris@16:          template <class T>
Chris@16:          struct hypergeometric_2F2_sum
Chris@16:          {
Chris@16:             typedef T result_type;
Chris@16:             hypergeometric_2F2_sum(T a1_, T a2_, T b1_, T b2_, T z_) : a1(a1_), a2(a2_), b1(b1_), b2(b2_), z(z_), term(1), k(0) {}
Chris@16:             T operator()()
Chris@16:             {
Chris@16:                T result = term;
Chris@16:                term *= a1 * a2 / (b1 * b2);
Chris@16:                a1 += 1;
Chris@16:                a2 += 1;
Chris@16:                b1 += 1;
Chris@16:                b2 += 1;
Chris@16:                k += 1;
Chris@16:                term /= k;
Chris@16:                term *= z;
Chris@16:                return result;
Chris@16:             }
Chris@16:             T a1, a2, b1, b2, z, term, k;
Chris@16:          };
Chris@16: 
Chris@16:          template <class T, class Policy>
Chris@16:          T hypergeometric_2F2(T a1, T a2, T b1, T b2, T z, const Policy& pol)
Chris@16:          {
Chris@16:             typedef typename policies::evaluation<T, Policy>::type value_type;
Chris@16: 
Chris@16:             const char* function = "boost::math::detail::hypergeometric_2F2<%1%>(%1%,%1%,%1%,%1%,%1%)";
Chris@16: 
Chris@16:             hypergeometric_2F2_sum<value_type> s(a1, a2, b1, b2, z);
Chris@16:             boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16: #if BOOST_WORKAROUND(__BORLANDC__, BOOST_TESTED_AT(0x582))
Chris@16:             value_type zero = 0;
Chris@16:             value_type result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<value_type, Policy>(), max_iter, zero);
Chris@16: #else
Chris@16:             value_type result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<value_type, Policy>(), max_iter);
Chris@16: #endif
Chris@16:             policies::check_series_iterations<T>(function, max_iter, pol);
Chris@16:             return policies::checked_narrowing_cast<T, Policy>(result, function);
Chris@16:          }
Chris@16: 
Chris@16:       } // namespace detail
Chris@16: 
Chris@16:       template <class RealType = double, class Policy = policies::policy<> >
Chris@16:       class non_central_beta_distribution
Chris@16:       {
Chris@16:       public:
Chris@16:          typedef RealType value_type;
Chris@16:          typedef Policy policy_type;
Chris@16: 
Chris@16:          non_central_beta_distribution(RealType a_, RealType b_, RealType lambda) : a(a_), b(b_), ncp(lambda)
Chris@16:          {
Chris@16:             const char* function = "boost::math::non_central_beta_distribution<%1%>::non_central_beta_distribution(%1%,%1%)";
Chris@16:             RealType r;
Chris@16:             beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy());
Chris@16:             beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy());
Chris@16:             detail::check_non_centrality(
Chris@16:                function,
Chris@16:                lambda,
Chris@16:                &r,
Chris@16:                Policy());
Chris@16:          } // non_central_beta_distribution constructor.
Chris@16: 
Chris@16:          RealType alpha() const
Chris@16:          { // Private data getter function.
Chris@16:             return a;
Chris@16:          }
Chris@16:          RealType beta() const
Chris@16:          { // Private data getter function.
Chris@16:             return b;
Chris@16:          }
Chris@16:          RealType non_centrality() const
Chris@16:          { // Private data getter function.
Chris@16:             return ncp;
Chris@16:          }
Chris@16:       private:
Chris@16:          // Data member, initialized by constructor.
Chris@16:          RealType a;   // alpha.
Chris@16:          RealType b;   // beta.
Chris@16:          RealType ncp; // non-centrality parameter
Chris@16:       }; // template <class RealType, class Policy> class non_central_beta_distribution
Chris@16: 
Chris@16:       typedef non_central_beta_distribution<double> non_central_beta; // Reserved name of type double.
Chris@16: 
Chris@16:       // Non-member functions to give properties of the distribution.
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline const std::pair<RealType, RealType> range(const non_central_beta_distribution<RealType, Policy>& /* dist */)
Chris@16:       { // Range of permissible values for random variable k.
Chris@16:          using boost::math::tools::max_value;
Chris@16:          return std::pair<RealType, RealType>(static_cast<RealType>(0), static_cast<RealType>(1));
Chris@16:       }
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline const std::pair<RealType, RealType> support(const non_central_beta_distribution<RealType, Policy>& /* dist */)
Chris@16:       { // Range of supported values for random variable k.
Chris@16:          // This is range where cdf rises from 0 to 1, and outside it, the pdf is zero.
Chris@16:          using boost::math::tools::max_value;
Chris@16:          return std::pair<RealType, RealType>(static_cast<RealType>(0), static_cast<RealType>(1));
Chris@16:       }
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType mode(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16:       { // mode.
Chris@16:          static const char* function = "mode(non_central_beta_distribution<%1%> const&)";
Chris@16: 
Chris@16:          RealType a = dist.alpha();
Chris@16:          RealType b = dist.beta();
Chris@16:          RealType l = dist.non_centrality();
Chris@16:          RealType r;
Chris@16:          if(!beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy())
Chris@16:                ||
Chris@16:             !detail::check_non_centrality(
Chris@16:                function,
Chris@16:                l,
Chris@16:                &r,
Chris@16:                Policy()))
Chris@16:                   return (RealType)r;
Chris@16:          RealType c = a + b + l / 2;
Chris@16:          RealType mean = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16:          return detail::generic_find_mode_01(
Chris@16:             dist,
Chris@16:             mean,
Chris@16:             function);
Chris@16:       }
Chris@16: 
Chris@16:       //
Chris@16:       // We don't have the necessary information to implement
Chris@16:       // these at present.  These are just disabled for now,
Chris@16:       // prototypes retained so we can fill in the blanks
Chris@16:       // later:
Chris@16:       //
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType mean(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16:       {
Chris@16:          BOOST_MATH_STD_USING
Chris@16:          RealType a = dist.alpha();
Chris@16:          RealType b = dist.beta();
Chris@16:          RealType d = dist.non_centrality();
Chris@16:          RealType apb = a + b;
Chris@16:          return exp(-d / 2) * a * detail::hypergeometric_2F2<RealType, Policy>(1 + a, apb, a, 1 + apb, d / 2, Policy()) / apb;
Chris@16:       } // mean
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType variance(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16:       { 
Chris@16:          //
Chris@16:          // Relative error of this function may be arbitarily large... absolute
Chris@16:          // error will be small however... that's the best we can do for now.
Chris@16:          //
Chris@16:          BOOST_MATH_STD_USING
Chris@16:          RealType a = dist.alpha();
Chris@16:          RealType b = dist.beta();
Chris@16:          RealType d = dist.non_centrality();
Chris@16:          RealType apb = a + b;
Chris@16:          RealType result = detail::hypergeometric_2F2(RealType(1 + a), apb, a, RealType(1 + apb), RealType(d / 2), Policy());
Chris@16:          result *= result * -exp(-d) * a * a / (apb * apb);
Chris@16:          result += exp(-d / 2) * a * (1 + a) * detail::hypergeometric_2F2(RealType(2 + a), apb, a, RealType(2 + apb), RealType(d / 2), Policy()) / (apb * (1 + apb));
Chris@16:          return result;
Chris@16:       }
Chris@16: 
Chris@16:       // RealType standard_deviation(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16:       // standard_deviation provided by derived accessors.
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType skewness(const non_central_beta_distribution<RealType, Policy>& /*dist*/)
Chris@16:       { // skewness = sqrt(l).
Chris@16:          const char* function = "boost::math::non_central_beta_distribution<%1%>::skewness()";
Chris@16:          typedef typename Policy::assert_undefined_type assert_type;
Chris@16:          BOOST_STATIC_ASSERT(assert_type::value == 0);
Chris@16: 
Chris@16:          return policies::raise_evaluation_error<RealType>(
Chris@16:             function,
Chris@16:             "This function is not yet implemented, the only sensible result is %1%.",
Chris@16:             std::numeric_limits<RealType>::quiet_NaN(), Policy()); // infinity?
Chris@16:       }
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType kurtosis_excess(const non_central_beta_distribution<RealType, Policy>& /*dist*/)
Chris@16:       {
Chris@16:          const char* function = "boost::math::non_central_beta_distribution<%1%>::kurtosis_excess()";
Chris@16:          typedef typename Policy::assert_undefined_type assert_type;
Chris@16:          BOOST_STATIC_ASSERT(assert_type::value == 0);
Chris@16: 
Chris@16:          return policies::raise_evaluation_error<RealType>(
Chris@16:             function,
Chris@16:             "This function is not yet implemented, the only sensible result is %1%.",
Chris@16:             std::numeric_limits<RealType>::quiet_NaN(), Policy()); // infinity?
Chris@16:       } // kurtosis_excess
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType kurtosis(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16:       {
Chris@16:          return kurtosis_excess(dist) + 3;
Chris@16:       }
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType pdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16:       { // Probability Density/Mass Function.
Chris@16:          return detail::nc_beta_pdf(dist, x);
Chris@16:       } // pdf
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       RealType cdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16:       {
Chris@16:          const char* function = "boost::math::non_central_beta_distribution<%1%>::cdf(%1%)";
Chris@16:             RealType a = dist.alpha();
Chris@16:             RealType b = dist.beta();
Chris@16:             RealType l = dist.non_centrality();
Chris@16:             RealType r;
Chris@16:             if(!beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy())
Chris@16:                ||
Chris@16:             !detail::check_non_centrality(
Chris@16:                function,
Chris@16:                l,
Chris@16:                &r,
Chris@16:                Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_x(
Chris@16:                function,
Chris@16:                x,
Chris@16:                &r,
Chris@16:                Policy()))
Chris@16:                   return (RealType)r;
Chris@16: 
Chris@16:          if(l == 0)
Chris@16:             return cdf(beta_distribution<RealType, Policy>(a, b), x);
Chris@16: 
Chris@16:          return detail::non_central_beta_cdf(x, RealType(1 - x), a, b, l, false, Policy());
Chris@16:       } // cdf
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       RealType cdf(const complemented2_type<non_central_beta_distribution<RealType, Policy>, RealType>& c)
Chris@16:       { // Complemented Cumulative Distribution Function
Chris@16:          const char* function = "boost::math::non_central_beta_distribution<%1%>::cdf(%1%)";
Chris@16:          non_central_beta_distribution<RealType, Policy> const& dist = c.dist;
Chris@16:             RealType a = dist.alpha();
Chris@16:             RealType b = dist.beta();
Chris@16:             RealType l = dist.non_centrality();
Chris@16:             RealType x = c.param;
Chris@16:             RealType r;
Chris@16:             if(!beta_detail::check_alpha(
Chris@16:                function,
Chris@16:                a, &r, Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_beta(
Chris@16:                function,
Chris@16:                b, &r, Policy())
Chris@16:                ||
Chris@16:             !detail::check_non_centrality(
Chris@16:                function,
Chris@16:                l,
Chris@16:                &r,
Chris@16:                Policy())
Chris@16:                ||
Chris@16:             !beta_detail::check_x(
Chris@16:                function,
Chris@16:                x,
Chris@16:                &r,
Chris@16:                Policy()))
Chris@16:                   return (RealType)r;
Chris@16: 
Chris@16:          if(l == 0)
Chris@16:             return cdf(complement(beta_distribution<RealType, Policy>(a, b), x));
Chris@16: 
Chris@16:          return detail::non_central_beta_cdf(x, RealType(1 - x), a, b, l, true, Policy());
Chris@16:       } // ccdf
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType quantile(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& p)
Chris@16:       { // Quantile (or Percent Point) function.
Chris@16:          return detail::nc_beta_quantile(dist, p, false);
Chris@16:       } // quantile
Chris@16: 
Chris@16:       template <class RealType, class Policy>
Chris@16:       inline RealType quantile(const complemented2_type<non_central_beta_distribution<RealType, Policy>, RealType>& c)
Chris@16:       { // Quantile (or Percent Point) function.
Chris@16:          return detail::nc_beta_quantile(c.dist, c.param, true);
Chris@16:       } // quantile complement.
Chris@16: 
Chris@16:    } // namespace math
Chris@16: } // namespace boost
Chris@16: 
Chris@16: // This include must be at the end, *after* the accessors
Chris@16: // for this distribution have been defined, in order to
Chris@16: // keep compilers that support two-phase lookup happy.
Chris@16: #include <boost/math/distributions/detail/derived_accessors.hpp>
Chris@16: 
Chris@16: #endif // BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16: