| 1 | // (C) Copyright John Maddock 2006. |
| 2 | // Use, modification and distribution are subject to the |
| 3 | // Boost Software License, Version 1.0. (See accompanying file |
| 4 | // LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) |
| 5 | |
| 6 | // |
| 7 | // This is not a complete header file, it is included by beta.hpp |
| 8 | // after it has defined it's definitions. This inverts the incomplete |
| 9 | // beta functions ibeta and ibetac on the first parameters "a" |
| 10 | // and "b" using a generic root finding algorithm (TOMS Algorithm 748). |
| 11 | // |
| 12 | |
| 13 | #ifndef BOOST_MATH_SP_DETAIL_BETA_INV_AB |
| 14 | #define BOOST_MATH_SP_DETAIL_BETA_INV_AB |
| 15 | |
| 16 | #ifdef _MSC_VER |
| 17 | #pragma once |
| 18 | #endif |
| 19 | |
| 20 | #include <boost/math/tools/toms748_solve.hpp> |
| 21 | #include <boost/cstdint.hpp> |
| 22 | |
| 23 | namespace boost{ namespace math{ namespace detail{ |
| 24 | |
| 25 | template <class T, class Policy> |
| 26 | struct beta_inv_ab_t |
| 27 | { |
| 28 | beta_inv_ab_t(T b_, T z_, T p_, bool invert_, bool swap_ab_) : b(b_), z(z_), p(p_), invert(invert_), swap_ab(swap_ab_) {} |
| 29 | T operator()(T a) |
| 30 | { |
| 31 | return invert ? |
| 32 | p - boost::math::ibetac(swap_ab ? b : a, swap_ab ? a : b, z, Policy()) |
| 33 | : boost::math::ibeta(swap_ab ? b : a, swap_ab ? a : b, z, Policy()) - p; |
| 34 | } |
| 35 | private: |
| 36 | T b, z, p; |
| 37 | bool invert, swap_ab; |
| 38 | }; |
| 39 | |
| 40 | template <class T, class Policy> |
| 41 | T inverse_negative_binomial_cornish_fisher(T n, T sf, T sfc, T p, T q, const Policy& pol) |
| 42 | { |
| 43 | BOOST_MATH_STD_USING |
| 44 | // mean: |
| 45 | T m = n * (sfc) / sf; |
| 46 | T t = sqrt(n * (sfc)); |
| 47 | // standard deviation: |
| 48 | T sigma = t / sf; |
| 49 | // skewness |
| 50 | T sk = (1 + sfc) / t; |
| 51 | // kurtosis: |
| 52 | T k = (6 - sf * (5+sfc)) / (n * (sfc)); |
| 53 | // Get the inverse of a std normal distribution: |
| 54 | T x = boost::math::erfc_inv(p > q ? 2 * q : 2 * p, pol) * constants::root_two<T>(); |
| 55 | // Set the sign: |
| 56 | if(p < 0.5) |
| 57 | x = -x; |
| 58 | T x2 = x * x; |
| 59 | // w is correction term due to skewness |
| 60 | T w = x + sk * (x2 - 1) / 6; |
| 61 | // |
| 62 | // Add on correction due to kurtosis. |
| 63 | // |
| 64 | if(n >= 10) |
| 65 | w += k * x * (x2 - 3) / 24 + sk * sk * x * (2 * x2 - 5) / -36; |
| 66 | |
| 67 | w = m + sigma * w; |
| 68 | if(w < tools::min_value<T>()) |
| 69 | return tools::min_value<T>(); |
| 70 | return w; |
| 71 | } |
| 72 | |
| 73 | template <class T, class Policy> |
| 74 | T ibeta_inv_ab_imp(const T& b, const T& z, const T& p, const T& q, bool swap_ab, const Policy& pol) |
| 75 | { |
| 76 | BOOST_MATH_STD_USING // for ADL of std lib math functions |
| 77 | // |
| 78 | // Special cases first: |
| 79 | // |
| 80 | BOOST_MATH_INSTRUMENT_CODE("b = " << b << " z = " << z << " p = " << p << " q = " << " swap = " << swap_ab); |
| 81 | if(p == 0) |
| 82 | { |
| 83 | return swap_ab ? tools::min_value<T>() : tools::max_value<T>(); |
| 84 | } |
| 85 | if(q == 0) |
| 86 | { |
| 87 | return swap_ab ? tools::max_value<T>() : tools::min_value<T>(); |
| 88 | } |
| 89 | // |
| 90 | // Function object, this is the functor whose root |
| 91 | // we have to solve: |
| 92 | // |
| 93 | beta_inv_ab_t<T, Policy> f(b, z, (p < q) ? p : q, (p < q) ? false : true, swap_ab); |
| 94 | // |
| 95 | // Tolerance: full precision. |
| 96 | // |
| 97 | tools::eps_tolerance<T> tol(policies::digits<T, Policy>()); |
| 98 | // |
| 99 | // Now figure out a starting guess for what a may be, |
| 100 | // we'll start out with a value that'll put p or q |
| 101 | // right bang in the middle of their range, the functions |
| 102 | // are quite sensitive so we should need too many steps |
| 103 | // to bracket the root from there: |
| 104 | // |
| 105 | T guess = 0; |
| 106 | T factor = 5; |
| 107 | // |
| 108 | // Convert variables to parameters of a negative binomial distribution: |
| 109 | // |
| 110 | T n = b; |
| 111 | T sf = swap_ab ? z : 1-z; |
| 112 | T sfc = swap_ab ? 1-z : z; |
| 113 | T u = swap_ab ? p : q; |
| 114 | T v = swap_ab ? q : p; |
| 115 | if(u <= pow(sf, n)) |
| 116 | { |
| 117 | // |
| 118 | // Result is less than 1, negative binomial approximation |
| 119 | // is useless.... |
| 120 | // |
| 121 | if((p < q) != swap_ab) |
| 122 | { |
| 123 | guess = (std::min)(T(b * 2), T(1)); |
| 124 | } |
| 125 | else |
| 126 | { |
| 127 | guess = (std::min)(T(b / 2), T(1)); |
| 128 | } |
| 129 | } |
| 130 | if(n * n * n * u * sf > 0.005) |
| 131 | guess = 1 + inverse_negative_binomial_cornish_fisher(n, sf, sfc, u, v, pol); |
| 132 | |
| 133 | if(guess < 10) |
| 134 | { |
| 135 | // |
| 136 | // Negative binomial approximation not accurate in this area: |
| 137 | // |
| 138 | if((p < q) != swap_ab) |
| 139 | { |
| 140 | guess = (std::min)(T(b * 2), T(10)); |
| 141 | } |
| 142 | else |
| 143 | { |
| 144 | guess = (std::min)(T(b / 2), T(10)); |
| 145 | } |
| 146 | } |
| 147 | else |
| 148 | factor = (v < sqrt(tools::epsilon<T>())) ? 2 : (guess < 20 ? 1.2f : 1.1f); |
| 149 | BOOST_MATH_INSTRUMENT_CODE("guess = " << guess); |
| 150 | // |
| 151 | // Max iterations permitted: |
| 152 | // |
| 153 | boost::uintmax_t max_iter = policies::get_max_root_iterations<Policy>(); |
| 154 | std::pair<T, T> r = bracket_and_solve_root(f, guess, factor, swap_ab ? true : false, tol, max_iter, pol); |
| 155 | if(max_iter >= policies::get_max_root_iterations<Policy>()) |
| 156 | return policies::raise_evaluation_error<T>("boost::math::ibeta_invab_imp<%1%>(%1%,%1%,%1%)" , "Unable to locate the root within a reasonable number of iterations, closest approximation so far was %1%" , r.first, pol); |
| 157 | return (r.first + r.second) / 2; |
| 158 | } |
| 159 | |
| 160 | } // namespace detail |
| 161 | |
| 162 | template <class RT1, class RT2, class RT3, class Policy> |
| 163 | typename tools::promote_args<RT1, RT2, RT3>::type |
| 164 | ibeta_inva(RT1 b, RT2 x, RT3 p, const Policy& pol) |
| 165 | { |
| 166 | typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type; |
| 167 | typedef typename policies::evaluation<result_type, Policy>::type value_type; |
| 168 | typedef typename policies::normalise< |
| 169 | Policy, |
| 170 | policies::promote_float<false>, |
| 171 | policies::promote_double<false>, |
| 172 | policies::discrete_quantile<>, |
| 173 | policies::assert_undefined<> >::type forwarding_policy; |
| 174 | |
| 175 | static const char* function = "boost::math::ibeta_inva<%1%>(%1%,%1%,%1%)" ; |
| 176 | if(p == 0) |
| 177 | { |
| 178 | return policies::raise_overflow_error<result_type>(function, 0, Policy()); |
| 179 | } |
| 180 | if(p == 1) |
| 181 | { |
| 182 | return tools::min_value<result_type>(); |
| 183 | } |
| 184 | |
| 185 | return policies::checked_narrowing_cast<result_type, forwarding_policy>( |
| 186 | detail::ibeta_inv_ab_imp( |
| 187 | static_cast<value_type>(b), |
| 188 | static_cast<value_type>(x), |
| 189 | static_cast<value_type>(p), |
| 190 | static_cast<value_type>(1 - static_cast<value_type>(p)), |
| 191 | false, pol), |
| 192 | function); |
| 193 | } |
| 194 | |
| 195 | template <class RT1, class RT2, class RT3, class Policy> |
| 196 | typename tools::promote_args<RT1, RT2, RT3>::type |
| 197 | ibetac_inva(RT1 b, RT2 x, RT3 q, const Policy& pol) |
| 198 | { |
| 199 | typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type; |
| 200 | typedef typename policies::evaluation<result_type, Policy>::type value_type; |
| 201 | typedef typename policies::normalise< |
| 202 | Policy, |
| 203 | policies::promote_float<false>, |
| 204 | policies::promote_double<false>, |
| 205 | policies::discrete_quantile<>, |
| 206 | policies::assert_undefined<> >::type forwarding_policy; |
| 207 | |
| 208 | static const char* function = "boost::math::ibetac_inva<%1%>(%1%,%1%,%1%)" ; |
| 209 | if(q == 1) |
| 210 | { |
| 211 | return policies::raise_overflow_error<result_type>(function, 0, Policy()); |
| 212 | } |
| 213 | if(q == 0) |
| 214 | { |
| 215 | return tools::min_value<result_type>(); |
| 216 | } |
| 217 | |
| 218 | return policies::checked_narrowing_cast<result_type, forwarding_policy>( |
| 219 | detail::ibeta_inv_ab_imp( |
| 220 | static_cast<value_type>(b), |
| 221 | static_cast<value_type>(x), |
| 222 | static_cast<value_type>(1 - static_cast<value_type>(q)), |
| 223 | static_cast<value_type>(q), |
| 224 | false, pol), |
| 225 | function); |
| 226 | } |
| 227 | |
| 228 | template <class RT1, class RT2, class RT3, class Policy> |
| 229 | typename tools::promote_args<RT1, RT2, RT3>::type |
| 230 | ibeta_invb(RT1 a, RT2 x, RT3 p, const Policy& pol) |
| 231 | { |
| 232 | typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type; |
| 233 | typedef typename policies::evaluation<result_type, Policy>::type value_type; |
| 234 | typedef typename policies::normalise< |
| 235 | Policy, |
| 236 | policies::promote_float<false>, |
| 237 | policies::promote_double<false>, |
| 238 | policies::discrete_quantile<>, |
| 239 | policies::assert_undefined<> >::type forwarding_policy; |
| 240 | |
| 241 | static const char* function = "boost::math::ibeta_invb<%1%>(%1%,%1%,%1%)" ; |
| 242 | if(p == 0) |
| 243 | { |
| 244 | return tools::min_value<result_type>(); |
| 245 | } |
| 246 | if(p == 1) |
| 247 | { |
| 248 | return policies::raise_overflow_error<result_type>(function, 0, Policy()); |
| 249 | } |
| 250 | |
| 251 | return policies::checked_narrowing_cast<result_type, forwarding_policy>( |
| 252 | detail::ibeta_inv_ab_imp( |
| 253 | static_cast<value_type>(a), |
| 254 | static_cast<value_type>(x), |
| 255 | static_cast<value_type>(p), |
| 256 | static_cast<value_type>(1 - static_cast<value_type>(p)), |
| 257 | true, pol), |
| 258 | function); |
| 259 | } |
| 260 | |
| 261 | template <class RT1, class RT2, class RT3, class Policy> |
| 262 | typename tools::promote_args<RT1, RT2, RT3>::type |
| 263 | ibetac_invb(RT1 a, RT2 x, RT3 q, const Policy& pol) |
| 264 | { |
| 265 | static const char* function = "boost::math::ibeta_invb<%1%>(%1%, %1%, %1%)" ; |
| 266 | typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type; |
| 267 | typedef typename policies::evaluation<result_type, Policy>::type value_type; |
| 268 | typedef typename policies::normalise< |
| 269 | Policy, |
| 270 | policies::promote_float<false>, |
| 271 | policies::promote_double<false>, |
| 272 | policies::discrete_quantile<>, |
| 273 | policies::assert_undefined<> >::type forwarding_policy; |
| 274 | |
| 275 | if(q == 1) |
| 276 | { |
| 277 | return tools::min_value<result_type>(); |
| 278 | } |
| 279 | if(q == 0) |
| 280 | { |
| 281 | return policies::raise_overflow_error<result_type>(function, 0, Policy()); |
| 282 | } |
| 283 | |
| 284 | return policies::checked_narrowing_cast<result_type, forwarding_policy>( |
| 285 | detail::ibeta_inv_ab_imp( |
| 286 | static_cast<value_type>(a), |
| 287 | static_cast<value_type>(x), |
| 288 | static_cast<value_type>(1 - static_cast<value_type>(q)), |
| 289 | static_cast<value_type>(q), |
| 290 | true, pol), |
| 291 | function); |
| 292 | } |
| 293 | |
| 294 | template <class RT1, class RT2, class RT3> |
| 295 | inline typename tools::promote_args<RT1, RT2, RT3>::type |
| 296 | ibeta_inva(RT1 b, RT2 x, RT3 p) |
| 297 | { |
| 298 | return boost::math::ibeta_inva(b, x, p, policies::policy<>()); |
| 299 | } |
| 300 | |
| 301 | template <class RT1, class RT2, class RT3> |
| 302 | inline typename tools::promote_args<RT1, RT2, RT3>::type |
| 303 | ibetac_inva(RT1 b, RT2 x, RT3 q) |
| 304 | { |
| 305 | return boost::math::ibetac_inva(b, x, q, policies::policy<>()); |
| 306 | } |
| 307 | |
| 308 | template <class RT1, class RT2, class RT3> |
| 309 | inline typename tools::promote_args<RT1, RT2, RT3>::type |
| 310 | ibeta_invb(RT1 a, RT2 x, RT3 p) |
| 311 | { |
| 312 | return boost::math::ibeta_invb(a, x, p, policies::policy<>()); |
| 313 | } |
| 314 | |
| 315 | template <class RT1, class RT2, class RT3> |
| 316 | inline typename tools::promote_args<RT1, RT2, RT3>::type |
| 317 | ibetac_invb(RT1 a, RT2 x, RT3 q) |
| 318 | { |
| 319 | return boost::math::ibetac_invb(a, x, q, policies::policy<>()); |
| 320 | } |
| 321 | |
| 322 | } // namespace math |
| 323 | } // namespace boost |
| 324 | |
| 325 | #endif // BOOST_MATH_SP_DETAIL_BETA_INV_AB |
| 326 | |
| 327 | |
| 328 | |
| 329 | |