annotate DEPENDENCIES/generic/include/boost/math/distributions/non_central_beta.hpp @ 125:34e428693f5d vext

Vext -> Repoint
author Chris Cannam
date Thu, 14 Jun 2018 11:15:39 +0100
parents 2665513ce2d3
children
rev   line source
Chris@16 1 // boost\math\distributions\non_central_beta.hpp
Chris@16 2
Chris@16 3 // Copyright John Maddock 2008.
Chris@16 4
Chris@16 5 // Use, modification and distribution are subject to the
Chris@16 6 // Boost Software License, Version 1.0.
Chris@16 7 // (See accompanying file LICENSE_1_0.txt
Chris@16 8 // or copy at http://www.boost.org/LICENSE_1_0.txt)
Chris@16 9
Chris@16 10 #ifndef BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16 11 #define BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16 12
Chris@16 13 #include <boost/math/distributions/fwd.hpp>
Chris@16 14 #include <boost/math/special_functions/beta.hpp> // for incomplete gamma. gamma_q
Chris@16 15 #include <boost/math/distributions/complement.hpp> // complements
Chris@16 16 #include <boost/math/distributions/beta.hpp> // central distribution
Chris@16 17 #include <boost/math/distributions/detail/generic_mode.hpp>
Chris@16 18 #include <boost/math/distributions/detail/common_error_handling.hpp> // error checks
Chris@16 19 #include <boost/math/special_functions/fpclassify.hpp> // isnan.
Chris@16 20 #include <boost/math/tools/roots.hpp> // for root finding.
Chris@16 21 #include <boost/math/tools/series.hpp>
Chris@16 22
Chris@16 23 namespace boost
Chris@16 24 {
Chris@16 25 namespace math
Chris@16 26 {
Chris@16 27
Chris@16 28 template <class RealType, class Policy>
Chris@16 29 class non_central_beta_distribution;
Chris@16 30
Chris@16 31 namespace detail{
Chris@16 32
Chris@16 33 template <class T, class Policy>
Chris@16 34 T non_central_beta_p(T a, T b, T lam, T x, T y, const Policy& pol, T init_val = 0)
Chris@16 35 {
Chris@16 36 BOOST_MATH_STD_USING
Chris@16 37 using namespace boost::math;
Chris@16 38 //
Chris@16 39 // Variables come first:
Chris@16 40 //
Chris@16 41 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16 42 T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16 43 T l2 = lam / 2;
Chris@16 44 //
Chris@16 45 // k is the starting point for iteration, and is the
Chris@16 46 // maximum of the poisson weighting term,
Chris@16 47 // note that unlike other similar code, we do not set
Chris@16 48 // k to zero, when l2 is small, as forward iteration
Chris@16 49 // is unstable:
Chris@16 50 //
Chris@16 51 int k = itrunc(l2);
Chris@16 52 if(k == 0)
Chris@16 53 k = 1;
Chris@16 54 // Starting Poisson weight:
Chris@16 55 T pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16 56 if(pois == 0)
Chris@16 57 return init_val;
Chris@16 58 // recurance term:
Chris@16 59 T xterm;
Chris@16 60 // Starting beta term:
Chris@16 61 T beta = x < y
Chris@16 62 ? detail::ibeta_imp(T(a + k), b, x, pol, false, true, &xterm)
Chris@16 63 : detail::ibeta_imp(b, T(a + k), y, pol, true, true, &xterm);
Chris@16 64
Chris@16 65 xterm *= y / (a + b + k - 1);
Chris@16 66 T poisf(pois), betaf(beta), xtermf(xterm);
Chris@16 67 T sum = init_val;
Chris@16 68
Chris@16 69 if((beta == 0) && (xterm == 0))
Chris@16 70 return init_val;
Chris@16 71
Chris@16 72 //
Chris@16 73 // Backwards recursion first, this is the stable
Chris@16 74 // direction for recursion:
Chris@16 75 //
Chris@16 76 T last_term = 0;
Chris@16 77 boost::uintmax_t count = k;
Chris@16 78 for(int i = k; i >= 0; --i)
Chris@16 79 {
Chris@16 80 T term = beta * pois;
Chris@16 81 sum += term;
Chris@16 82 if(((fabs(term/sum) < errtol) && (last_term >= term)) || (term == 0))
Chris@16 83 {
Chris@16 84 count = k - i;
Chris@16 85 break;
Chris@16 86 }
Chris@16 87 pois *= i / l2;
Chris@16 88 beta += xterm;
Chris@16 89 xterm *= (a + i - 1) / (x * (a + b + i - 2));
Chris@16 90 last_term = term;
Chris@16 91 }
Chris@16 92 for(int i = k + 1; ; ++i)
Chris@16 93 {
Chris@16 94 poisf *= l2 / i;
Chris@16 95 xtermf *= (x * (a + b + i - 2)) / (a + i - 1);
Chris@16 96 betaf -= xtermf;
Chris@16 97
Chris@16 98 T term = poisf * betaf;
Chris@16 99 sum += term;
Chris@16 100 if((fabs(term/sum) < errtol) || (term == 0))
Chris@16 101 {
Chris@16 102 break;
Chris@16 103 }
Chris@16 104 if(static_cast<boost::uintmax_t>(count + i - k) > max_iter)
Chris@16 105 {
Chris@16 106 return policies::raise_evaluation_error(
Chris@16 107 "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16 108 "Series did not converge, closest value was %1%", sum, pol);
Chris@16 109 }
Chris@16 110 }
Chris@16 111 return sum;
Chris@16 112 }
Chris@16 113
Chris@16 114 template <class T, class Policy>
Chris@16 115 T non_central_beta_q(T a, T b, T lam, T x, T y, const Policy& pol, T init_val = 0)
Chris@16 116 {
Chris@16 117 BOOST_MATH_STD_USING
Chris@16 118 using namespace boost::math;
Chris@16 119 //
Chris@16 120 // Variables come first:
Chris@16 121 //
Chris@16 122 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16 123 T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16 124 T l2 = lam / 2;
Chris@16 125 //
Chris@16 126 // k is the starting point for iteration, and is the
Chris@16 127 // maximum of the poisson weighting term:
Chris@16 128 //
Chris@16 129 int k = itrunc(l2);
Chris@16 130 T pois;
Chris@16 131 if(k <= 30)
Chris@16 132 {
Chris@16 133 //
Chris@16 134 // Might as well start at 0 since we'll likely have this number of terms anyway:
Chris@16 135 //
Chris@16 136 if(a + b > 1)
Chris@16 137 k = 0;
Chris@16 138 else if(k == 0)
Chris@16 139 k = 1;
Chris@16 140 }
Chris@16 141 if(k == 0)
Chris@16 142 {
Chris@16 143 // Starting Poisson weight:
Chris@16 144 pois = exp(-l2);
Chris@16 145 }
Chris@16 146 else
Chris@16 147 {
Chris@16 148 // Starting Poisson weight:
Chris@16 149 pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16 150 }
Chris@16 151 if(pois == 0)
Chris@16 152 return init_val;
Chris@16 153 // recurance term:
Chris@16 154 T xterm;
Chris@16 155 // Starting beta term:
Chris@16 156 T beta = x < y
Chris@16 157 ? detail::ibeta_imp(T(a + k), b, x, pol, true, true, &xterm)
Chris@16 158 : detail::ibeta_imp(b, T(a + k), y, pol, false, true, &xterm);
Chris@16 159
Chris@16 160 xterm *= y / (a + b + k - 1);
Chris@16 161 T poisf(pois), betaf(beta), xtermf(xterm);
Chris@16 162 T sum = init_val;
Chris@16 163 if((beta == 0) && (xterm == 0))
Chris@16 164 return init_val;
Chris@16 165 //
Chris@16 166 // Forwards recursion first, this is the stable
Chris@16 167 // direction for recursion, and the location
Chris@16 168 // of the bulk of the sum:
Chris@16 169 //
Chris@16 170 T last_term = 0;
Chris@16 171 boost::uintmax_t count = 0;
Chris@16 172 for(int i = k + 1; ; ++i)
Chris@16 173 {
Chris@16 174 poisf *= l2 / i;
Chris@16 175 xtermf *= (x * (a + b + i - 2)) / (a + i - 1);
Chris@16 176 betaf += xtermf;
Chris@16 177
Chris@16 178 T term = poisf * betaf;
Chris@16 179 sum += term;
Chris@16 180 if((fabs(term/sum) < errtol) && (last_term >= term))
Chris@16 181 {
Chris@16 182 count = i - k;
Chris@16 183 break;
Chris@16 184 }
Chris@16 185 if(static_cast<boost::uintmax_t>(i - k) > max_iter)
Chris@16 186 {
Chris@16 187 return policies::raise_evaluation_error(
Chris@16 188 "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16 189 "Series did not converge, closest value was %1%", sum, pol);
Chris@16 190 }
Chris@16 191 last_term = term;
Chris@16 192 }
Chris@16 193 for(int i = k; i >= 0; --i)
Chris@16 194 {
Chris@16 195 T term = beta * pois;
Chris@16 196 sum += term;
Chris@16 197 if(fabs(term/sum) < errtol)
Chris@16 198 {
Chris@16 199 break;
Chris@16 200 }
Chris@16 201 if(static_cast<boost::uintmax_t>(count + k - i) > max_iter)
Chris@16 202 {
Chris@16 203 return policies::raise_evaluation_error(
Chris@16 204 "cdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16 205 "Series did not converge, closest value was %1%", sum, pol);
Chris@16 206 }
Chris@16 207 pois *= i / l2;
Chris@16 208 beta -= xterm;
Chris@16 209 xterm *= (a + i - 1) / (x * (a + b + i - 2));
Chris@16 210 }
Chris@16 211 return sum;
Chris@16 212 }
Chris@16 213
Chris@16 214 template <class RealType, class Policy>
Chris@16 215 inline RealType non_central_beta_cdf(RealType x, RealType y, RealType a, RealType b, RealType l, bool invert, const Policy&)
Chris@16 216 {
Chris@16 217 typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16 218 typedef typename policies::normalise<
Chris@16 219 Policy,
Chris@16 220 policies::promote_float<false>,
Chris@16 221 policies::promote_double<false>,
Chris@16 222 policies::discrete_quantile<>,
Chris@16 223 policies::assert_undefined<> >::type forwarding_policy;
Chris@16 224
Chris@16 225 BOOST_MATH_STD_USING
Chris@16 226
Chris@16 227 if(x == 0)
Chris@16 228 return invert ? 1.0f : 0.0f;
Chris@16 229 if(y == 0)
Chris@16 230 return invert ? 0.0f : 1.0f;
Chris@16 231 value_type result;
Chris@16 232 value_type c = a + b + l / 2;
Chris@16 233 value_type cross = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16 234 if(l == 0)
Chris@16 235 result = cdf(boost::math::beta_distribution<RealType, Policy>(a, b), x);
Chris@16 236 else if(x > cross)
Chris@16 237 {
Chris@16 238 // Complement is the smaller of the two:
Chris@16 239 result = detail::non_central_beta_q(
Chris@16 240 static_cast<value_type>(a),
Chris@16 241 static_cast<value_type>(b),
Chris@16 242 static_cast<value_type>(l),
Chris@16 243 static_cast<value_type>(x),
Chris@16 244 static_cast<value_type>(y),
Chris@16 245 forwarding_policy(),
Chris@16 246 static_cast<value_type>(invert ? 0 : -1));
Chris@16 247 invert = !invert;
Chris@16 248 }
Chris@16 249 else
Chris@16 250 {
Chris@16 251 result = detail::non_central_beta_p(
Chris@16 252 static_cast<value_type>(a),
Chris@16 253 static_cast<value_type>(b),
Chris@16 254 static_cast<value_type>(l),
Chris@16 255 static_cast<value_type>(x),
Chris@16 256 static_cast<value_type>(y),
Chris@16 257 forwarding_policy(),
Chris@16 258 static_cast<value_type>(invert ? -1 : 0));
Chris@16 259 }
Chris@16 260 if(invert)
Chris@16 261 result = -result;
Chris@16 262 return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16 263 result,
Chris@16 264 "boost::math::non_central_beta_cdf<%1%>(%1%, %1%, %1%)");
Chris@16 265 }
Chris@16 266
Chris@16 267 template <class T, class Policy>
Chris@16 268 struct nc_beta_quantile_functor
Chris@16 269 {
Chris@16 270 nc_beta_quantile_functor(const non_central_beta_distribution<T,Policy>& d, T t, bool c)
Chris@16 271 : dist(d), target(t), comp(c) {}
Chris@16 272
Chris@16 273 T operator()(const T& x)
Chris@16 274 {
Chris@16 275 return comp ?
Chris@16 276 T(target - cdf(complement(dist, x)))
Chris@16 277 : T(cdf(dist, x) - target);
Chris@16 278 }
Chris@16 279
Chris@16 280 private:
Chris@16 281 non_central_beta_distribution<T,Policy> dist;
Chris@16 282 T target;
Chris@16 283 bool comp;
Chris@16 284 };
Chris@16 285
Chris@16 286 //
Chris@16 287 // This is more or less a copy of bracket_and_solve_root, but
Chris@16 288 // modified to search only the interval [0,1] using similar
Chris@16 289 // heuristics.
Chris@16 290 //
Chris@16 291 template <class F, class T, class Tol, class Policy>
Chris@16 292 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 293 {
Chris@16 294 BOOST_MATH_STD_USING
Chris@16 295 static const char* function = "boost::math::tools::bracket_and_solve_root_01<%1%>";
Chris@16 296 //
Chris@16 297 // Set up inital brackets:
Chris@16 298 //
Chris@16 299 T a = guess;
Chris@16 300 T b = a;
Chris@16 301 T fa = f(a);
Chris@16 302 T fb = fa;
Chris@16 303 //
Chris@16 304 // Set up invocation count:
Chris@16 305 //
Chris@16 306 boost::uintmax_t count = max_iter - 1;
Chris@16 307
Chris@16 308 if((fa < 0) == (guess < 0 ? !rising : rising))
Chris@16 309 {
Chris@16 310 //
Chris@16 311 // Zero is to the right of b, so walk upwards
Chris@16 312 // until we find it:
Chris@16 313 //
Chris@16 314 while((boost::math::sign)(fb) == (boost::math::sign)(fa))
Chris@16 315 {
Chris@16 316 if(count == 0)
Chris@16 317 {
Chris@16 318 b = policies::raise_evaluation_error(function, "Unable to bracket root, last nearest value was %1%", b, pol);
Chris@16 319 return std::make_pair(a, b);
Chris@16 320 }
Chris@16 321 //
Chris@16 322 // Heuristic: every 20 iterations we double the growth factor in case the
Chris@16 323 // initial guess was *really* bad !
Chris@16 324 //
Chris@16 325 if((max_iter - count) % 20 == 0)
Chris@16 326 factor *= 2;
Chris@16 327 //
Chris@16 328 // Now go ahead and move are guess by "factor",
Chris@16 329 // we do this by reducing 1-guess by factor:
Chris@16 330 //
Chris@16 331 a = b;
Chris@16 332 fa = fb;
Chris@16 333 b = 1 - ((1 - b) / factor);
Chris@16 334 fb = f(b);
Chris@16 335 --count;
Chris@16 336 BOOST_MATH_INSTRUMENT_CODE("a = " << a << " b = " << b << " fa = " << fa << " fb = " << fb << " count = " << count);
Chris@16 337 }
Chris@16 338 }
Chris@16 339 else
Chris@16 340 {
Chris@16 341 //
Chris@16 342 // Zero is to the left of a, so walk downwards
Chris@16 343 // until we find it:
Chris@16 344 //
Chris@16 345 while((boost::math::sign)(fb) == (boost::math::sign)(fa))
Chris@16 346 {
Chris@16 347 if(fabs(a) < tools::min_value<T>())
Chris@16 348 {
Chris@16 349 // Escape route just in case the answer is zero!
Chris@16 350 max_iter -= count;
Chris@16 351 max_iter += 1;
Chris@16 352 return a > 0 ? std::make_pair(T(0), T(a)) : std::make_pair(T(a), T(0));
Chris@16 353 }
Chris@16 354 if(count == 0)
Chris@16 355 {
Chris@16 356 a = policies::raise_evaluation_error(function, "Unable to bracket root, last nearest value was %1%", a, pol);
Chris@16 357 return std::make_pair(a, b);
Chris@16 358 }
Chris@16 359 //
Chris@16 360 // Heuristic: every 20 iterations we double the growth factor in case the
Chris@16 361 // initial guess was *really* bad !
Chris@16 362 //
Chris@16 363 if((max_iter - count) % 20 == 0)
Chris@16 364 factor *= 2;
Chris@16 365 //
Chris@16 366 // Now go ahead and move are guess by "factor":
Chris@16 367 //
Chris@16 368 b = a;
Chris@16 369 fb = fa;
Chris@16 370 a /= factor;
Chris@16 371 fa = f(a);
Chris@16 372 --count;
Chris@16 373 BOOST_MATH_INSTRUMENT_CODE("a = " << a << " b = " << b << " fa = " << fa << " fb = " << fb << " count = " << count);
Chris@16 374 }
Chris@16 375 }
Chris@16 376 max_iter -= count;
Chris@16 377 max_iter += 1;
Chris@16 378 std::pair<T, T> r = toms748_solve(
Chris@16 379 f,
Chris@16 380 (a < 0 ? b : a),
Chris@16 381 (a < 0 ? a : b),
Chris@16 382 (a < 0 ? fb : fa),
Chris@16 383 (a < 0 ? fa : fb),
Chris@16 384 tol,
Chris@16 385 count,
Chris@16 386 pol);
Chris@16 387 max_iter += count;
Chris@16 388 BOOST_MATH_INSTRUMENT_CODE("max_iter = " << max_iter << " count = " << count);
Chris@16 389 return r;
Chris@16 390 }
Chris@16 391
Chris@16 392 template <class RealType, class Policy>
Chris@16 393 RealType nc_beta_quantile(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& p, bool comp)
Chris@16 394 {
Chris@16 395 static const char* function = "quantile(non_central_beta_distribution<%1%>, %1%)";
Chris@16 396 typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16 397 typedef typename policies::normalise<
Chris@16 398 Policy,
Chris@16 399 policies::promote_float<false>,
Chris@16 400 policies::promote_double<false>,
Chris@16 401 policies::discrete_quantile<>,
Chris@16 402 policies::assert_undefined<> >::type forwarding_policy;
Chris@16 403
Chris@16 404 value_type a = dist.alpha();
Chris@16 405 value_type b = dist.beta();
Chris@16 406 value_type l = dist.non_centrality();
Chris@16 407 value_type r;
Chris@16 408 if(!beta_detail::check_alpha(
Chris@16 409 function,
Chris@16 410 a, &r, Policy())
Chris@16 411 ||
Chris@16 412 !beta_detail::check_beta(
Chris@16 413 function,
Chris@16 414 b, &r, Policy())
Chris@16 415 ||
Chris@16 416 !detail::check_non_centrality(
Chris@16 417 function,
Chris@16 418 l,
Chris@16 419 &r,
Chris@16 420 Policy())
Chris@16 421 ||
Chris@16 422 !detail::check_probability(
Chris@16 423 function,
Chris@16 424 static_cast<value_type>(p),
Chris@16 425 &r,
Chris@16 426 Policy()))
Chris@16 427 return (RealType)r;
Chris@16 428 //
Chris@16 429 // Special cases first:
Chris@16 430 //
Chris@16 431 if(p == 0)
Chris@16 432 return comp
Chris@16 433 ? 1.0f
Chris@16 434 : 0.0f;
Chris@16 435 if(p == 1)
Chris@16 436 return !comp
Chris@16 437 ? 1.0f
Chris@16 438 : 0.0f;
Chris@16 439
Chris@16 440 value_type c = a + b + l / 2;
Chris@16 441 value_type mean = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16 442 /*
Chris@16 443 //
Chris@16 444 // Calculate a normal approximation to the quantile,
Chris@16 445 // uses mean and variance approximations from:
Chris@16 446 // Algorithm AS 310:
Chris@16 447 // Computing the Non-Central Beta Distribution Function
Chris@16 448 // R. Chattamvelli; R. Shanmugam
Chris@16 449 // Applied Statistics, Vol. 46, No. 1. (1997), pp. 146-156.
Chris@16 450 //
Chris@16 451 // Unfortunately, when this is wrong it tends to be *very*
Chris@16 452 // wrong, so it's disabled for now, even though it often
Chris@16 453 // gets the initial guess quite close. Probably we could
Chris@16 454 // do much better by factoring in the skewness if only
Chris@16 455 // we could calculate it....
Chris@16 456 //
Chris@16 457 value_type delta = l / 2;
Chris@16 458 value_type delta2 = delta * delta;
Chris@16 459 value_type delta3 = delta * delta2;
Chris@16 460 value_type delta4 = delta2 * delta2;
Chris@16 461 value_type G = c * (c + 1) + delta;
Chris@16 462 value_type alpha = a + b;
Chris@16 463 value_type alpha2 = alpha * alpha;
Chris@16 464 value_type eta = (2 * alpha + 1) * (2 * alpha + 1) + 1;
Chris@16 465 value_type H = 3 * alpha2 + 5 * alpha + 2;
Chris@16 466 value_type F = alpha2 * (alpha + 1) + H * delta
Chris@16 467 + (2 * alpha + 4) * delta2 + delta3;
Chris@16 468 value_type P = (3 * alpha + 1) * (9 * alpha + 17)
Chris@16 469 + 2 * alpha * (3 * alpha + 2) * (3 * alpha + 4) + 15;
Chris@16 470 value_type Q = 54 * alpha2 + 162 * alpha + 130;
Chris@16 471 value_type R = 6 * (6 * alpha + 11);
Chris@16 472 value_type D = delta
Chris@16 473 * (H * H + 2 * P * delta + Q * delta2 + R * delta3 + 9 * delta4);
Chris@16 474 value_type variance = (b / G)
Chris@16 475 * (1 + delta * (l * l + 3 * l + eta) / (G * G))
Chris@16 476 - (b * b / F) * (1 + D / (F * F));
Chris@16 477 value_type sd = sqrt(variance);
Chris@16 478
Chris@16 479 value_type guess = comp
Chris@16 480 ? quantile(complement(normal_distribution<RealType, Policy>(static_cast<RealType>(mean), static_cast<RealType>(sd)), p))
Chris@16 481 : quantile(normal_distribution<RealType, Policy>(static_cast<RealType>(mean), static_cast<RealType>(sd)), p);
Chris@16 482
Chris@16 483 if(guess >= 1)
Chris@16 484 guess = mean;
Chris@16 485 if(guess <= tools::min_value<value_type>())
Chris@16 486 guess = mean;
Chris@16 487 */
Chris@16 488 value_type guess = mean;
Chris@16 489 detail::nc_beta_quantile_functor<value_type, Policy>
Chris@16 490 f(non_central_beta_distribution<value_type, Policy>(a, b, l), p, comp);
Chris@16 491 tools::eps_tolerance<value_type> tol(policies::digits<RealType, Policy>());
Chris@16 492 boost::uintmax_t max_iter = policies::get_max_root_iterations<Policy>();
Chris@16 493
Chris@16 494 std::pair<value_type, value_type> ir
Chris@16 495 = bracket_and_solve_root_01(
Chris@16 496 f, guess, value_type(2.5), true, tol,
Chris@16 497 max_iter, Policy());
Chris@16 498 value_type result = ir.first + (ir.second - ir.first) / 2;
Chris@16 499
Chris@16 500 if(max_iter >= policies::get_max_root_iterations<Policy>())
Chris@16 501 {
Chris@16 502 return policies::raise_evaluation_error<RealType>(function, "Unable to locate solution in a reasonable time:"
Chris@16 503 " either there is no answer to quantile of the non central beta distribution"
Chris@16 504 " or the answer is infinite. Current best guess is %1%",
Chris@16 505 policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16 506 result,
Chris@16 507 function), Policy());
Chris@16 508 }
Chris@16 509 return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16 510 result,
Chris@16 511 function);
Chris@16 512 }
Chris@16 513
Chris@16 514 template <class T, class Policy>
Chris@16 515 T non_central_beta_pdf(T a, T b, T lam, T x, T y, const Policy& pol)
Chris@16 516 {
Chris@16 517 BOOST_MATH_STD_USING
Chris@16 518 using namespace boost::math;
Chris@16 519 //
Chris@16 520 // Variables come first:
Chris@16 521 //
Chris@16 522 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16 523 T errtol = boost::math::policies::get_epsilon<T, Policy>();
Chris@16 524 T l2 = lam / 2;
Chris@16 525 //
Chris@16 526 // k is the starting point for iteration, and is the
Chris@16 527 // maximum of the poisson weighting term:
Chris@16 528 //
Chris@16 529 int k = itrunc(l2);
Chris@16 530 // Starting Poisson weight:
Chris@16 531 T pois = gamma_p_derivative(T(k+1), l2, pol);
Chris@16 532 // Starting beta term:
Chris@16 533 T beta = x < y ?
Chris@16 534 ibeta_derivative(a + k, b, x, pol)
Chris@16 535 : ibeta_derivative(b, a + k, y, pol);
Chris@16 536 T sum = 0;
Chris@16 537 T poisf(pois);
Chris@16 538 T betaf(beta);
Chris@16 539
Chris@16 540 //
Chris@16 541 // Stable backwards recursion first:
Chris@16 542 //
Chris@16 543 boost::uintmax_t count = k;
Chris@16 544 for(int i = k; i >= 0; --i)
Chris@16 545 {
Chris@16 546 T term = beta * pois;
Chris@16 547 sum += term;
Chris@16 548 if((fabs(term/sum) < errtol) || (term == 0))
Chris@16 549 {
Chris@16 550 count = k - i;
Chris@16 551 break;
Chris@16 552 }
Chris@16 553 pois *= i / l2;
Chris@16 554 beta *= (a + i - 1) / (x * (a + i + b - 1));
Chris@16 555 }
Chris@16 556 for(int i = k + 1; ; ++i)
Chris@16 557 {
Chris@16 558 poisf *= l2 / i;
Chris@16 559 betaf *= x * (a + b + i - 1) / (a + i - 1);
Chris@16 560
Chris@16 561 T term = poisf * betaf;
Chris@16 562 sum += term;
Chris@16 563 if((fabs(term/sum) < errtol) || (term == 0))
Chris@16 564 {
Chris@16 565 break;
Chris@16 566 }
Chris@16 567 if(static_cast<boost::uintmax_t>(count + i - k) > max_iter)
Chris@16 568 {
Chris@16 569 return policies::raise_evaluation_error(
Chris@16 570 "pdf(non_central_beta_distribution<%1%>, %1%)",
Chris@16 571 "Series did not converge, closest value was %1%", sum, pol);
Chris@16 572 }
Chris@16 573 }
Chris@16 574 return sum;
Chris@16 575 }
Chris@16 576
Chris@16 577 template <class RealType, class Policy>
Chris@16 578 RealType nc_beta_pdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16 579 {
Chris@16 580 BOOST_MATH_STD_USING
Chris@16 581 static const char* function = "pdf(non_central_beta_distribution<%1%>, %1%)";
Chris@16 582 typedef typename policies::evaluation<RealType, Policy>::type value_type;
Chris@16 583 typedef typename policies::normalise<
Chris@16 584 Policy,
Chris@16 585 policies::promote_float<false>,
Chris@16 586 policies::promote_double<false>,
Chris@16 587 policies::discrete_quantile<>,
Chris@16 588 policies::assert_undefined<> >::type forwarding_policy;
Chris@16 589
Chris@16 590 value_type a = dist.alpha();
Chris@16 591 value_type b = dist.beta();
Chris@16 592 value_type l = dist.non_centrality();
Chris@16 593 value_type r;
Chris@16 594 if(!beta_detail::check_alpha(
Chris@16 595 function,
Chris@16 596 a, &r, Policy())
Chris@16 597 ||
Chris@16 598 !beta_detail::check_beta(
Chris@16 599 function,
Chris@16 600 b, &r, Policy())
Chris@16 601 ||
Chris@16 602 !detail::check_non_centrality(
Chris@16 603 function,
Chris@16 604 l,
Chris@16 605 &r,
Chris@16 606 Policy())
Chris@16 607 ||
Chris@16 608 !beta_detail::check_x(
Chris@16 609 function,
Chris@16 610 static_cast<value_type>(x),
Chris@16 611 &r,
Chris@16 612 Policy()))
Chris@16 613 return (RealType)r;
Chris@16 614
Chris@16 615 if(l == 0)
Chris@16 616 return pdf(boost::math::beta_distribution<RealType, Policy>(dist.alpha(), dist.beta()), x);
Chris@16 617 return policies::checked_narrowing_cast<RealType, forwarding_policy>(
Chris@16 618 non_central_beta_pdf(a, b, l, static_cast<value_type>(x), value_type(1 - static_cast<value_type>(x)), forwarding_policy()),
Chris@16 619 "function");
Chris@16 620 }
Chris@16 621
Chris@16 622 template <class T>
Chris@16 623 struct hypergeometric_2F2_sum
Chris@16 624 {
Chris@16 625 typedef T result_type;
Chris@16 626 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 627 T operator()()
Chris@16 628 {
Chris@16 629 T result = term;
Chris@16 630 term *= a1 * a2 / (b1 * b2);
Chris@16 631 a1 += 1;
Chris@16 632 a2 += 1;
Chris@16 633 b1 += 1;
Chris@16 634 b2 += 1;
Chris@16 635 k += 1;
Chris@16 636 term /= k;
Chris@16 637 term *= z;
Chris@16 638 return result;
Chris@16 639 }
Chris@16 640 T a1, a2, b1, b2, z, term, k;
Chris@16 641 };
Chris@16 642
Chris@16 643 template <class T, class Policy>
Chris@16 644 T hypergeometric_2F2(T a1, T a2, T b1, T b2, T z, const Policy& pol)
Chris@16 645 {
Chris@16 646 typedef typename policies::evaluation<T, Policy>::type value_type;
Chris@16 647
Chris@16 648 const char* function = "boost::math::detail::hypergeometric_2F2<%1%>(%1%,%1%,%1%,%1%,%1%)";
Chris@16 649
Chris@16 650 hypergeometric_2F2_sum<value_type> s(a1, a2, b1, b2, z);
Chris@16 651 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
Chris@16 652 #if BOOST_WORKAROUND(__BORLANDC__, BOOST_TESTED_AT(0x582))
Chris@16 653 value_type zero = 0;
Chris@16 654 value_type result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<value_type, Policy>(), max_iter, zero);
Chris@16 655 #else
Chris@16 656 value_type result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<value_type, Policy>(), max_iter);
Chris@16 657 #endif
Chris@16 658 policies::check_series_iterations<T>(function, max_iter, pol);
Chris@16 659 return policies::checked_narrowing_cast<T, Policy>(result, function);
Chris@16 660 }
Chris@16 661
Chris@16 662 } // namespace detail
Chris@16 663
Chris@16 664 template <class RealType = double, class Policy = policies::policy<> >
Chris@16 665 class non_central_beta_distribution
Chris@16 666 {
Chris@16 667 public:
Chris@16 668 typedef RealType value_type;
Chris@16 669 typedef Policy policy_type;
Chris@16 670
Chris@16 671 non_central_beta_distribution(RealType a_, RealType b_, RealType lambda) : a(a_), b(b_), ncp(lambda)
Chris@16 672 {
Chris@16 673 const char* function = "boost::math::non_central_beta_distribution<%1%>::non_central_beta_distribution(%1%,%1%)";
Chris@16 674 RealType r;
Chris@16 675 beta_detail::check_alpha(
Chris@16 676 function,
Chris@16 677 a, &r, Policy());
Chris@16 678 beta_detail::check_beta(
Chris@16 679 function,
Chris@16 680 b, &r, Policy());
Chris@16 681 detail::check_non_centrality(
Chris@16 682 function,
Chris@16 683 lambda,
Chris@16 684 &r,
Chris@16 685 Policy());
Chris@16 686 } // non_central_beta_distribution constructor.
Chris@16 687
Chris@16 688 RealType alpha() const
Chris@16 689 { // Private data getter function.
Chris@16 690 return a;
Chris@16 691 }
Chris@16 692 RealType beta() const
Chris@16 693 { // Private data getter function.
Chris@16 694 return b;
Chris@16 695 }
Chris@16 696 RealType non_centrality() const
Chris@16 697 { // Private data getter function.
Chris@16 698 return ncp;
Chris@16 699 }
Chris@16 700 private:
Chris@16 701 // Data member, initialized by constructor.
Chris@16 702 RealType a; // alpha.
Chris@16 703 RealType b; // beta.
Chris@16 704 RealType ncp; // non-centrality parameter
Chris@16 705 }; // template <class RealType, class Policy> class non_central_beta_distribution
Chris@16 706
Chris@16 707 typedef non_central_beta_distribution<double> non_central_beta; // Reserved name of type double.
Chris@16 708
Chris@16 709 // Non-member functions to give properties of the distribution.
Chris@16 710
Chris@16 711 template <class RealType, class Policy>
Chris@16 712 inline const std::pair<RealType, RealType> range(const non_central_beta_distribution<RealType, Policy>& /* dist */)
Chris@16 713 { // Range of permissible values for random variable k.
Chris@16 714 using boost::math::tools::max_value;
Chris@16 715 return std::pair<RealType, RealType>(static_cast<RealType>(0), static_cast<RealType>(1));
Chris@16 716 }
Chris@16 717
Chris@16 718 template <class RealType, class Policy>
Chris@16 719 inline const std::pair<RealType, RealType> support(const non_central_beta_distribution<RealType, Policy>& /* dist */)
Chris@16 720 { // Range of supported values for random variable k.
Chris@16 721 // This is range where cdf rises from 0 to 1, and outside it, the pdf is zero.
Chris@16 722 using boost::math::tools::max_value;
Chris@16 723 return std::pair<RealType, RealType>(static_cast<RealType>(0), static_cast<RealType>(1));
Chris@16 724 }
Chris@16 725
Chris@16 726 template <class RealType, class Policy>
Chris@16 727 inline RealType mode(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16 728 { // mode.
Chris@16 729 static const char* function = "mode(non_central_beta_distribution<%1%> const&)";
Chris@16 730
Chris@16 731 RealType a = dist.alpha();
Chris@16 732 RealType b = dist.beta();
Chris@16 733 RealType l = dist.non_centrality();
Chris@16 734 RealType r;
Chris@16 735 if(!beta_detail::check_alpha(
Chris@16 736 function,
Chris@16 737 a, &r, Policy())
Chris@16 738 ||
Chris@16 739 !beta_detail::check_beta(
Chris@16 740 function,
Chris@16 741 b, &r, Policy())
Chris@16 742 ||
Chris@16 743 !detail::check_non_centrality(
Chris@16 744 function,
Chris@16 745 l,
Chris@16 746 &r,
Chris@16 747 Policy()))
Chris@16 748 return (RealType)r;
Chris@16 749 RealType c = a + b + l / 2;
Chris@16 750 RealType mean = 1 - (b / c) * (1 + l / (2 * c * c));
Chris@16 751 return detail::generic_find_mode_01(
Chris@16 752 dist,
Chris@16 753 mean,
Chris@16 754 function);
Chris@16 755 }
Chris@16 756
Chris@16 757 //
Chris@16 758 // We don't have the necessary information to implement
Chris@16 759 // these at present. These are just disabled for now,
Chris@16 760 // prototypes retained so we can fill in the blanks
Chris@16 761 // later:
Chris@16 762 //
Chris@16 763 template <class RealType, class Policy>
Chris@16 764 inline RealType mean(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16 765 {
Chris@16 766 BOOST_MATH_STD_USING
Chris@16 767 RealType a = dist.alpha();
Chris@16 768 RealType b = dist.beta();
Chris@16 769 RealType d = dist.non_centrality();
Chris@16 770 RealType apb = a + b;
Chris@16 771 return exp(-d / 2) * a * detail::hypergeometric_2F2<RealType, Policy>(1 + a, apb, a, 1 + apb, d / 2, Policy()) / apb;
Chris@16 772 } // mean
Chris@16 773
Chris@16 774 template <class RealType, class Policy>
Chris@16 775 inline RealType variance(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16 776 {
Chris@16 777 //
Chris@16 778 // Relative error of this function may be arbitarily large... absolute
Chris@16 779 // error will be small however... that's the best we can do for now.
Chris@16 780 //
Chris@16 781 BOOST_MATH_STD_USING
Chris@16 782 RealType a = dist.alpha();
Chris@16 783 RealType b = dist.beta();
Chris@16 784 RealType d = dist.non_centrality();
Chris@16 785 RealType apb = a + b;
Chris@16 786 RealType result = detail::hypergeometric_2F2(RealType(1 + a), apb, a, RealType(1 + apb), RealType(d / 2), Policy());
Chris@16 787 result *= result * -exp(-d) * a * a / (apb * apb);
Chris@16 788 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 789 return result;
Chris@16 790 }
Chris@16 791
Chris@16 792 // RealType standard_deviation(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16 793 // standard_deviation provided by derived accessors.
Chris@16 794 template <class RealType, class Policy>
Chris@16 795 inline RealType skewness(const non_central_beta_distribution<RealType, Policy>& /*dist*/)
Chris@16 796 { // skewness = sqrt(l).
Chris@16 797 const char* function = "boost::math::non_central_beta_distribution<%1%>::skewness()";
Chris@16 798 typedef typename Policy::assert_undefined_type assert_type;
Chris@16 799 BOOST_STATIC_ASSERT(assert_type::value == 0);
Chris@16 800
Chris@16 801 return policies::raise_evaluation_error<RealType>(
Chris@16 802 function,
Chris@16 803 "This function is not yet implemented, the only sensible result is %1%.",
Chris@16 804 std::numeric_limits<RealType>::quiet_NaN(), Policy()); // infinity?
Chris@16 805 }
Chris@16 806
Chris@16 807 template <class RealType, class Policy>
Chris@16 808 inline RealType kurtosis_excess(const non_central_beta_distribution<RealType, Policy>& /*dist*/)
Chris@16 809 {
Chris@16 810 const char* function = "boost::math::non_central_beta_distribution<%1%>::kurtosis_excess()";
Chris@16 811 typedef typename Policy::assert_undefined_type assert_type;
Chris@16 812 BOOST_STATIC_ASSERT(assert_type::value == 0);
Chris@16 813
Chris@16 814 return policies::raise_evaluation_error<RealType>(
Chris@16 815 function,
Chris@16 816 "This function is not yet implemented, the only sensible result is %1%.",
Chris@16 817 std::numeric_limits<RealType>::quiet_NaN(), Policy()); // infinity?
Chris@16 818 } // kurtosis_excess
Chris@16 819
Chris@16 820 template <class RealType, class Policy>
Chris@16 821 inline RealType kurtosis(const non_central_beta_distribution<RealType, Policy>& dist)
Chris@16 822 {
Chris@16 823 return kurtosis_excess(dist) + 3;
Chris@16 824 }
Chris@16 825
Chris@16 826 template <class RealType, class Policy>
Chris@16 827 inline RealType pdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16 828 { // Probability Density/Mass Function.
Chris@16 829 return detail::nc_beta_pdf(dist, x);
Chris@16 830 } // pdf
Chris@16 831
Chris@16 832 template <class RealType, class Policy>
Chris@16 833 RealType cdf(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& x)
Chris@16 834 {
Chris@16 835 const char* function = "boost::math::non_central_beta_distribution<%1%>::cdf(%1%)";
Chris@16 836 RealType a = dist.alpha();
Chris@16 837 RealType b = dist.beta();
Chris@16 838 RealType l = dist.non_centrality();
Chris@16 839 RealType r;
Chris@16 840 if(!beta_detail::check_alpha(
Chris@16 841 function,
Chris@16 842 a, &r, Policy())
Chris@16 843 ||
Chris@16 844 !beta_detail::check_beta(
Chris@16 845 function,
Chris@16 846 b, &r, Policy())
Chris@16 847 ||
Chris@16 848 !detail::check_non_centrality(
Chris@16 849 function,
Chris@16 850 l,
Chris@16 851 &r,
Chris@16 852 Policy())
Chris@16 853 ||
Chris@16 854 !beta_detail::check_x(
Chris@16 855 function,
Chris@16 856 x,
Chris@16 857 &r,
Chris@16 858 Policy()))
Chris@16 859 return (RealType)r;
Chris@16 860
Chris@16 861 if(l == 0)
Chris@16 862 return cdf(beta_distribution<RealType, Policy>(a, b), x);
Chris@16 863
Chris@16 864 return detail::non_central_beta_cdf(x, RealType(1 - x), a, b, l, false, Policy());
Chris@16 865 } // cdf
Chris@16 866
Chris@16 867 template <class RealType, class Policy>
Chris@16 868 RealType cdf(const complemented2_type<non_central_beta_distribution<RealType, Policy>, RealType>& c)
Chris@16 869 { // Complemented Cumulative Distribution Function
Chris@16 870 const char* function = "boost::math::non_central_beta_distribution<%1%>::cdf(%1%)";
Chris@16 871 non_central_beta_distribution<RealType, Policy> const& dist = c.dist;
Chris@16 872 RealType a = dist.alpha();
Chris@16 873 RealType b = dist.beta();
Chris@16 874 RealType l = dist.non_centrality();
Chris@16 875 RealType x = c.param;
Chris@16 876 RealType r;
Chris@16 877 if(!beta_detail::check_alpha(
Chris@16 878 function,
Chris@16 879 a, &r, Policy())
Chris@16 880 ||
Chris@16 881 !beta_detail::check_beta(
Chris@16 882 function,
Chris@16 883 b, &r, Policy())
Chris@16 884 ||
Chris@16 885 !detail::check_non_centrality(
Chris@16 886 function,
Chris@16 887 l,
Chris@16 888 &r,
Chris@16 889 Policy())
Chris@16 890 ||
Chris@16 891 !beta_detail::check_x(
Chris@16 892 function,
Chris@16 893 x,
Chris@16 894 &r,
Chris@16 895 Policy()))
Chris@16 896 return (RealType)r;
Chris@16 897
Chris@16 898 if(l == 0)
Chris@16 899 return cdf(complement(beta_distribution<RealType, Policy>(a, b), x));
Chris@16 900
Chris@16 901 return detail::non_central_beta_cdf(x, RealType(1 - x), a, b, l, true, Policy());
Chris@16 902 } // ccdf
Chris@16 903
Chris@16 904 template <class RealType, class Policy>
Chris@16 905 inline RealType quantile(const non_central_beta_distribution<RealType, Policy>& dist, const RealType& p)
Chris@16 906 { // Quantile (or Percent Point) function.
Chris@16 907 return detail::nc_beta_quantile(dist, p, false);
Chris@16 908 } // quantile
Chris@16 909
Chris@16 910 template <class RealType, class Policy>
Chris@16 911 inline RealType quantile(const complemented2_type<non_central_beta_distribution<RealType, Policy>, RealType>& c)
Chris@16 912 { // Quantile (or Percent Point) function.
Chris@16 913 return detail::nc_beta_quantile(c.dist, c.param, true);
Chris@16 914 } // quantile complement.
Chris@16 915
Chris@16 916 } // namespace math
Chris@16 917 } // namespace boost
Chris@16 918
Chris@16 919 // This include must be at the end, *after* the accessors
Chris@16 920 // for this distribution have been defined, in order to
Chris@16 921 // keep compilers that support two-phase lookup happy.
Chris@16 922 #include <boost/math/distributions/detail/derived_accessors.hpp>
Chris@16 923
Chris@16 924 #endif // BOOST_MATH_SPECIAL_NON_CENTRAL_BETA_HPP
Chris@16 925