246 lines
9.8 KiB
Plaintext
246 lines
9.8 KiB
Plaintext
|
// Copyright 2008 John Maddock
|
||
|
|
//
|
||
|
|
// 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_DISTRIBUTIONS_DETAIL_HG_QUANTILE_HPP
|
||
|
|
#define BOOST_MATH_DISTRIBUTIONS_DETAIL_HG_QUANTILE_HPP
|
||
|
|
|
||
|
|
#include <boost/math/policies/error_handling.hpp>
|
||
|
|
#include <boost/math/distributions/detail/hypergeometric_pdf.hpp>
|
||
|
|
|
||
|
|
namespace boost{ namespace math{ namespace detail{
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_p(unsigned x, T p, T cum, T fudge_factor, unsigned lbound, unsigned /*ubound*/, const policies::discrete_quantile<policies::integer_round_down>&)
|
||
|
|
{
|
||
|
|
if((p < cum * fudge_factor) && (x != lbound))
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x-1);
|
||
|
|
return --x;
|
||
|
|
}
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_p(unsigned x, T p, T cum, T fudge_factor, unsigned /*lbound*/, unsigned ubound, const policies::discrete_quantile<policies::integer_round_up>&)
|
||
|
|
{
|
||
|
|
if((cum < p * fudge_factor) && (x != ubound))
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x+1);
|
||
|
|
return ++x;
|
||
|
|
}
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_p(unsigned x, T p, T cum, T fudge_factor, unsigned lbound, unsigned ubound, const policies::discrete_quantile<policies::integer_round_inwards>&)
|
||
|
|
{
|
||
|
|
if(p >= 0.5)
|
||
|
|
return round_x_from_p(x, p, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_down>());
|
||
|
|
return round_x_from_p(x, p, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_up>());
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_p(unsigned x, T p, T cum, T fudge_factor, unsigned lbound, unsigned ubound, const policies::discrete_quantile<policies::integer_round_outwards>&)
|
||
|
|
{
|
||
|
|
if(p >= 0.5)
|
||
|
|
return round_x_from_p(x, p, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_up>());
|
||
|
|
return round_x_from_p(x, p, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_down>());
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_p(unsigned x, T /*p*/, T /*cum*/, T /*fudge_factor*/, unsigned /*lbound*/, unsigned /*ubound*/, const policies::discrete_quantile<policies::integer_round_nearest>&)
|
||
|
|
{
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_q(unsigned x, T q, T cum, T fudge_factor, unsigned lbound, unsigned /*ubound*/, const policies::discrete_quantile<policies::integer_round_down>&)
|
||
|
|
{
|
||
|
|
if((q * fudge_factor > cum) && (x != lbound))
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x-1);
|
||
|
|
return --x;
|
||
|
|
}
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_q(unsigned x, T q, T cum, T fudge_factor, unsigned /*lbound*/, unsigned ubound, const policies::discrete_quantile<policies::integer_round_up>&)
|
||
|
|
{
|
||
|
|
if((q < cum * fudge_factor) && (x != ubound))
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x+1);
|
||
|
|
return ++x;
|
||
|
|
}
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_q(unsigned x, T q, T cum, T fudge_factor, unsigned lbound, unsigned ubound, const policies::discrete_quantile<policies::integer_round_inwards>&)
|
||
|
|
{
|
||
|
|
if(q < 0.5)
|
||
|
|
return round_x_from_q(x, q, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_down>());
|
||
|
|
return round_x_from_q(x, q, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_up>());
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_q(unsigned x, T q, T cum, T fudge_factor, unsigned lbound, unsigned ubound, const policies::discrete_quantile<policies::integer_round_outwards>&)
|
||
|
|
{
|
||
|
|
if(q >= 0.5)
|
||
|
|
return round_x_from_q(x, q, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_down>());
|
||
|
|
return round_x_from_q(x, q, cum, fudge_factor, lbound, ubound, policies::discrete_quantile<policies::integer_round_up>());
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T>
|
||
|
|
inline unsigned round_x_from_q(unsigned x, T /*q*/, T /*cum*/, T /*fudge_factor*/, unsigned /*lbound*/, unsigned /*ubound*/, const policies::discrete_quantile<policies::integer_round_nearest>&)
|
||
|
|
{
|
||
|
|
return x;
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T, class Policy>
|
||
|
|
unsigned hypergeometric_quantile_imp(T p, T q, unsigned r, unsigned n, unsigned N, const Policy& pol)
|
||
|
|
{
|
||
|
|
#ifdef BOOST_MSVC
|
||
|
|
# pragma warning(push)
|
||
|
|
# pragma warning(disable:4267)
|
||
|
|
#endif
|
||
|
|
typedef typename Policy::discrete_quantile_type discrete_quantile_type;
|
||
|
|
BOOST_MATH_STD_USING
|
||
|
|
BOOST_FPU_EXCEPTION_GUARD
|
||
|
|
T result;
|
||
|
|
T fudge_factor = 1 + tools::epsilon<T>() * ((N <= boost::math::prime(boost::math::max_prime - 1)) ? 50 : 2 * N);
|
||
|
|
unsigned base = static_cast<unsigned>((std::max)(0, (int)(n + r) - (int)(N)));
|
||
|
|
unsigned lim = (std::min)(r, n);
|
||
|
|
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(p);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(q);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(r);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(n);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(N);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(fudge_factor);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(base);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(lim);
|
||
|
|
|
||
|
|
if(p <= 0.5)
|
||
|
|
{
|
||
|
|
unsigned x = base;
|
||
|
|
result = hypergeometric_pdf<T>(x, r, n, N, pol);
|
||
|
|
T diff = result;
|
||
|
|
if (diff == 0)
|
||
|
|
{
|
||
|
|
++x;
|
||
|
|
// We want to skip through x values as fast as we can until we start getting non-zero values,
|
||
|
|
// otherwise we're just making lots of expensive PDF calls:
|
||
|
|
T log_pdf = boost::math::lgamma(static_cast<T>(n + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(r + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(N - n + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(N - r + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(N + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(n - x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(r - x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(N - n - r + x + 1), pol);
|
||
|
|
while (log_pdf < tools::log_min_value<T>())
|
||
|
|
{
|
||
|
|
log_pdf += -log(static_cast<T>(x + 1)) + log(static_cast<T>(n - x)) + log(static_cast<T>(r - x)) - log(static_cast<T>(N - n - r + x + 1));
|
||
|
|
++x;
|
||
|
|
}
|
||
|
|
// By the time we get here, log_pdf may be fairly inaccurate due to
|
||
|
|
// roundoff errors, get a fresh PDF calculation before proceding:
|
||
|
|
diff = hypergeometric_pdf<T>(x, r, n, N, pol);
|
||
|
|
}
|
||
|
|
while(result < p)
|
||
|
|
{
|
||
|
|
diff = (diff > tools::min_value<T>() * 8)
|
||
|
|
? T(n - x) * T(r - x) * diff / (T(x + 1) * T(N + x + 1 - n - r))
|
||
|
|
: hypergeometric_pdf<T>(x + 1, r, n, N, pol);
|
||
|
|
if(result + diff / 2 > p)
|
||
|
|
break;
|
||
|
|
++x;
|
||
|
|
result += diff;
|
||
|
|
#ifdef BOOST_MATH_INSTRUMENT
|
||
|
|
if(diff != 0)
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(diff);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
||
|
|
}
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
return round_x_from_p(x, p, result, fudge_factor, base, lim, discrete_quantile_type());
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
unsigned x = lim;
|
||
|
|
result = 0;
|
||
|
|
T diff = hypergeometric_pdf<T>(x, r, n, N, pol);
|
||
|
|
if (diff == 0)
|
||
|
|
{
|
||
|
|
// We want to skip through x values as fast as we can until we start getting non-zero values,
|
||
|
|
// otherwise we're just making lots of expensive PDF calls:
|
||
|
|
--x;
|
||
|
|
T log_pdf = boost::math::lgamma(static_cast<T>(n + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(r + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(N - n + 1), pol)
|
||
|
|
+ boost::math::lgamma(static_cast<T>(N - r + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(N + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(n - x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(r - x + 1), pol)
|
||
|
|
- boost::math::lgamma(static_cast<T>(N - n - r + x + 1), pol);
|
||
|
|
while (log_pdf < tools::log_min_value<T>())
|
||
|
|
{
|
||
|
|
log_pdf += log(static_cast<T>(x)) - log(static_cast<T>(n - x + 1)) - log(static_cast<T>(r - x + 1)) + log(static_cast<T>(N - n - r + x));
|
||
|
|
--x;
|
||
|
|
}
|
||
|
|
// By the time we get here, log_pdf may be fairly inaccurate due to
|
||
|
|
// roundoff errors, get a fresh PDF calculation before proceding:
|
||
|
|
diff = hypergeometric_pdf<T>(x, r, n, N, pol);
|
||
|
|
}
|
||
|
|
while(result + diff / 2 < q)
|
||
|
|
{
|
||
|
|
result += diff;
|
||
|
|
diff = (diff > tools::min_value<T>() * 8)
|
||
|
|
? x * T(N + x - n - r) * diff / (T(1 + n - x) * T(1 + r - x))
|
||
|
|
: hypergeometric_pdf<T>(x - 1, r, n, N, pol);
|
||
|
|
--x;
|
||
|
|
#ifdef BOOST_MATH_INSTRUMENT
|
||
|
|
if(diff != 0)
|
||
|
|
{
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(x);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(diff);
|
||
|
|
BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
||
|
|
}
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
return round_x_from_q(x, q, result, fudge_factor, base, lim, discrete_quantile_type());
|
||
|
|
}
|
||
|
|
#ifdef BOOST_MSVC
|
||
|
|
# pragma warning(pop)
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
|
||
|
|
template <class T, class Policy>
|
||
|
|
inline unsigned hypergeometric_quantile(T p, T q, unsigned r, unsigned n, unsigned N, const Policy&)
|
||
|
|
{
|
||
|
|
BOOST_FPU_EXCEPTION_GUARD
|
||
|
|
typedef typename tools::promote_args<T>::type result_type;
|
||
|
|
typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
||
|
|
typedef typename policies::normalise<
|
||
|
|
Policy,
|
||
|
|
policies::promote_float<false>,
|
||
|
|
policies::promote_double<false>,
|
||
|
|
policies::assert_undefined<> >::type forwarding_policy;
|
||
|
|
|
||
|
|
return detail::hypergeometric_quantile_imp<value_type>(p, q, r, n, N, forwarding_policy());
|
||
|
|
}
|
||
|
|
|
||
|
|
}}} // namespaces
|
||
|
|
|
||
|
|
#endif
|
||
|
|
|