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