Chris@16
|
1 // (C) Copyright John Maddock 2006.
|
Chris@16
|
2 // Use, modification and distribution are subject to the
|
Chris@16
|
3 // Boost Software License, Version 1.0. (See accompanying file
|
Chris@16
|
4 // LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
|
Chris@16
|
5
|
Chris@16
|
6 #ifndef BOOST_MATH_SPECIAL_BETA_HPP
|
Chris@16
|
7 #define BOOST_MATH_SPECIAL_BETA_HPP
|
Chris@16
|
8
|
Chris@16
|
9 #ifdef _MSC_VER
|
Chris@16
|
10 #pragma once
|
Chris@16
|
11 #endif
|
Chris@16
|
12
|
Chris@16
|
13 #include <boost/math/special_functions/math_fwd.hpp>
|
Chris@16
|
14 #include <boost/math/tools/config.hpp>
|
Chris@16
|
15 #include <boost/math/special_functions/gamma.hpp>
|
Chris@101
|
16 #include <boost/math/special_functions/binomial.hpp>
|
Chris@16
|
17 #include <boost/math/special_functions/factorials.hpp>
|
Chris@16
|
18 #include <boost/math/special_functions/erf.hpp>
|
Chris@16
|
19 #include <boost/math/special_functions/log1p.hpp>
|
Chris@16
|
20 #include <boost/math/special_functions/expm1.hpp>
|
Chris@16
|
21 #include <boost/math/special_functions/trunc.hpp>
|
Chris@16
|
22 #include <boost/math/tools/roots.hpp>
|
Chris@16
|
23 #include <boost/static_assert.hpp>
|
Chris@16
|
24 #include <boost/config/no_tr1/cmath.hpp>
|
Chris@16
|
25
|
Chris@16
|
26 namespace boost{ namespace math{
|
Chris@16
|
27
|
Chris@16
|
28 namespace detail{
|
Chris@16
|
29
|
Chris@16
|
30 //
|
Chris@16
|
31 // Implementation of Beta(a,b) using the Lanczos approximation:
|
Chris@16
|
32 //
|
Chris@16
|
33 template <class T, class Lanczos, class Policy>
|
Chris@16
|
34 T beta_imp(T a, T b, const Lanczos&, const Policy& pol)
|
Chris@16
|
35 {
|
Chris@16
|
36 BOOST_MATH_STD_USING // for ADL of std names
|
Chris@16
|
37
|
Chris@16
|
38 if(a <= 0)
|
Chris@101
|
39 return policies::raise_domain_error<T>("boost::math::beta<%1%>(%1%,%1%)", "The arguments to the beta function must be greater than zero (got a=%1%).", a, pol);
|
Chris@16
|
40 if(b <= 0)
|
Chris@101
|
41 return policies::raise_domain_error<T>("boost::math::beta<%1%>(%1%,%1%)", "The arguments to the beta function must be greater than zero (got b=%1%).", b, pol);
|
Chris@16
|
42
|
Chris@16
|
43 T result;
|
Chris@16
|
44
|
Chris@16
|
45 T prefix = 1;
|
Chris@16
|
46 T c = a + b;
|
Chris@16
|
47
|
Chris@16
|
48 // Special cases:
|
Chris@16
|
49 if((c == a) && (b < tools::epsilon<T>()))
|
Chris@16
|
50 return boost::math::tgamma(b, pol);
|
Chris@16
|
51 else if((c == b) && (a < tools::epsilon<T>()))
|
Chris@16
|
52 return boost::math::tgamma(a, pol);
|
Chris@16
|
53 if(b == 1)
|
Chris@16
|
54 return 1/a;
|
Chris@16
|
55 else if(a == 1)
|
Chris@16
|
56 return 1/b;
|
Chris@16
|
57
|
Chris@16
|
58 /*
|
Chris@16
|
59 //
|
Chris@16
|
60 // This code appears to be no longer necessary: it was
|
Chris@16
|
61 // used to offset errors introduced from the Lanczos
|
Chris@16
|
62 // approximation, but the current Lanczos approximations
|
Chris@16
|
63 // are sufficiently accurate for all z that we can ditch
|
Chris@16
|
64 // this. It remains in the file for future reference...
|
Chris@16
|
65 //
|
Chris@16
|
66 // If a or b are less than 1, shift to greater than 1:
|
Chris@16
|
67 if(a < 1)
|
Chris@16
|
68 {
|
Chris@16
|
69 prefix *= c / a;
|
Chris@16
|
70 c += 1;
|
Chris@16
|
71 a += 1;
|
Chris@16
|
72 }
|
Chris@16
|
73 if(b < 1)
|
Chris@16
|
74 {
|
Chris@16
|
75 prefix *= c / b;
|
Chris@16
|
76 c += 1;
|
Chris@16
|
77 b += 1;
|
Chris@16
|
78 }
|
Chris@16
|
79 */
|
Chris@16
|
80
|
Chris@16
|
81 if(a < b)
|
Chris@16
|
82 std::swap(a, b);
|
Chris@16
|
83
|
Chris@16
|
84 // Lanczos calculation:
|
Chris@16
|
85 T agh = a + Lanczos::g() - T(0.5);
|
Chris@16
|
86 T bgh = b + Lanczos::g() - T(0.5);
|
Chris@16
|
87 T cgh = c + Lanczos::g() - T(0.5);
|
Chris@16
|
88 result = Lanczos::lanczos_sum_expG_scaled(a) * Lanczos::lanczos_sum_expG_scaled(b) / Lanczos::lanczos_sum_expG_scaled(c);
|
Chris@16
|
89 T ambh = a - T(0.5) - b;
|
Chris@16
|
90 if((fabs(b * ambh) < (cgh * 100)) && (a > 100))
|
Chris@16
|
91 {
|
Chris@16
|
92 // Special case where the base of the power term is close to 1
|
Chris@16
|
93 // compute (1+x)^y instead:
|
Chris@16
|
94 result *= exp(ambh * boost::math::log1p(-b / cgh, pol));
|
Chris@16
|
95 }
|
Chris@16
|
96 else
|
Chris@16
|
97 {
|
Chris@16
|
98 result *= pow(agh / cgh, a - T(0.5) - b);
|
Chris@16
|
99 }
|
Chris@16
|
100 if(cgh > 1e10f)
|
Chris@16
|
101 // this avoids possible overflow, but appears to be marginally less accurate:
|
Chris@16
|
102 result *= pow((agh / cgh) * (bgh / cgh), b);
|
Chris@16
|
103 else
|
Chris@16
|
104 result *= pow((agh * bgh) / (cgh * cgh), b);
|
Chris@16
|
105 result *= sqrt(boost::math::constants::e<T>() / bgh);
|
Chris@16
|
106
|
Chris@16
|
107 // If a and b were originally less than 1 we need to scale the result:
|
Chris@16
|
108 result *= prefix;
|
Chris@16
|
109
|
Chris@16
|
110 return result;
|
Chris@16
|
111 } // template <class T, class Lanczos> beta_imp(T a, T b, const Lanczos&)
|
Chris@16
|
112
|
Chris@16
|
113 //
|
Chris@16
|
114 // Generic implementation of Beta(a,b) without Lanczos approximation support
|
Chris@16
|
115 // (Caution this is slow!!!):
|
Chris@16
|
116 //
|
Chris@16
|
117 template <class T, class Policy>
|
Chris@16
|
118 T beta_imp(T a, T b, const lanczos::undefined_lanczos& /* l */, const Policy& pol)
|
Chris@16
|
119 {
|
Chris@16
|
120 BOOST_MATH_STD_USING
|
Chris@16
|
121
|
Chris@16
|
122 if(a <= 0)
|
Chris@101
|
123 return policies::raise_domain_error<T>("boost::math::beta<%1%>(%1%,%1%)", "The arguments to the beta function must be greater than zero (got a=%1%).", a, pol);
|
Chris@16
|
124 if(b <= 0)
|
Chris@101
|
125 return policies::raise_domain_error<T>("boost::math::beta<%1%>(%1%,%1%)", "The arguments to the beta function must be greater than zero (got b=%1%).", b, pol);
|
Chris@16
|
126
|
Chris@16
|
127 T result;
|
Chris@16
|
128
|
Chris@16
|
129 T prefix = 1;
|
Chris@16
|
130 T c = a + b;
|
Chris@16
|
131
|
Chris@16
|
132 // special cases:
|
Chris@16
|
133 if((c == a) && (b < tools::epsilon<T>()))
|
Chris@16
|
134 return boost::math::tgamma(b, pol);
|
Chris@16
|
135 else if((c == b) && (a < tools::epsilon<T>()))
|
Chris@16
|
136 return boost::math::tgamma(a, pol);
|
Chris@16
|
137 if(b == 1)
|
Chris@16
|
138 return 1/a;
|
Chris@16
|
139 else if(a == 1)
|
Chris@16
|
140 return 1/b;
|
Chris@16
|
141
|
Chris@16
|
142 // shift to a and b > 1 if required:
|
Chris@16
|
143 if(a < 1)
|
Chris@16
|
144 {
|
Chris@16
|
145 prefix *= c / a;
|
Chris@16
|
146 c += 1;
|
Chris@16
|
147 a += 1;
|
Chris@16
|
148 }
|
Chris@16
|
149 if(b < 1)
|
Chris@16
|
150 {
|
Chris@16
|
151 prefix *= c / b;
|
Chris@16
|
152 c += 1;
|
Chris@16
|
153 b += 1;
|
Chris@16
|
154 }
|
Chris@16
|
155 if(a < b)
|
Chris@16
|
156 std::swap(a, b);
|
Chris@16
|
157
|
Chris@16
|
158 // set integration limits:
|
Chris@16
|
159 T la = (std::max)(T(10), a);
|
Chris@16
|
160 T lb = (std::max)(T(10), b);
|
Chris@16
|
161 T lc = (std::max)(T(10), T(a+b));
|
Chris@16
|
162
|
Chris@16
|
163 // calculate the fraction parts:
|
Chris@16
|
164 T sa = detail::lower_gamma_series(a, la, pol) / a;
|
Chris@16
|
165 sa += detail::upper_gamma_fraction(a, la, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
166 T sb = detail::lower_gamma_series(b, lb, pol) / b;
|
Chris@16
|
167 sb += detail::upper_gamma_fraction(b, lb, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
168 T sc = detail::lower_gamma_series(c, lc, pol) / c;
|
Chris@16
|
169 sc += detail::upper_gamma_fraction(c, lc, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
170
|
Chris@16
|
171 // and the exponent part:
|
Chris@16
|
172 result = exp(lc - la - lb) * pow(la/lc, a) * pow(lb/lc, b);
|
Chris@16
|
173
|
Chris@16
|
174 // and combine:
|
Chris@16
|
175 result *= sa * sb / sc;
|
Chris@16
|
176
|
Chris@16
|
177 // if a and b were originally less than 1 we need to scale the result:
|
Chris@16
|
178 result *= prefix;
|
Chris@16
|
179
|
Chris@16
|
180 return result;
|
Chris@16
|
181 } // template <class T>T beta_imp(T a, T b, const lanczos::undefined_lanczos& l)
|
Chris@16
|
182
|
Chris@16
|
183
|
Chris@16
|
184 //
|
Chris@16
|
185 // Compute the leading power terms in the incomplete Beta:
|
Chris@16
|
186 //
|
Chris@16
|
187 // (x^a)(y^b)/Beta(a,b) when normalised, and
|
Chris@16
|
188 // (x^a)(y^b) otherwise.
|
Chris@16
|
189 //
|
Chris@16
|
190 // Almost all of the error in the incomplete beta comes from this
|
Chris@16
|
191 // function: particularly when a and b are large. Computing large
|
Chris@16
|
192 // powers are *hard* though, and using logarithms just leads to
|
Chris@16
|
193 // horrendous cancellation errors.
|
Chris@16
|
194 //
|
Chris@16
|
195 template <class T, class Lanczos, class Policy>
|
Chris@16
|
196 T ibeta_power_terms(T a,
|
Chris@16
|
197 T b,
|
Chris@16
|
198 T x,
|
Chris@16
|
199 T y,
|
Chris@16
|
200 const Lanczos&,
|
Chris@16
|
201 bool normalised,
|
Chris@16
|
202 const Policy& pol)
|
Chris@16
|
203 {
|
Chris@16
|
204 BOOST_MATH_STD_USING
|
Chris@16
|
205
|
Chris@16
|
206 if(!normalised)
|
Chris@16
|
207 {
|
Chris@16
|
208 // can we do better here?
|
Chris@16
|
209 return pow(x, a) * pow(y, b);
|
Chris@16
|
210 }
|
Chris@16
|
211
|
Chris@16
|
212 T result;
|
Chris@16
|
213
|
Chris@16
|
214 T prefix = 1;
|
Chris@16
|
215 T c = a + b;
|
Chris@16
|
216
|
Chris@16
|
217 // combine power terms with Lanczos approximation:
|
Chris@16
|
218 T agh = a + Lanczos::g() - T(0.5);
|
Chris@16
|
219 T bgh = b + Lanczos::g() - T(0.5);
|
Chris@16
|
220 T cgh = c + Lanczos::g() - T(0.5);
|
Chris@16
|
221 result = Lanczos::lanczos_sum_expG_scaled(c) / (Lanczos::lanczos_sum_expG_scaled(a) * Lanczos::lanczos_sum_expG_scaled(b));
|
Chris@16
|
222
|
Chris@16
|
223 // l1 and l2 are the base of the exponents minus one:
|
Chris@16
|
224 T l1 = (x * b - y * agh) / agh;
|
Chris@16
|
225 T l2 = (y * a - x * bgh) / bgh;
|
Chris@16
|
226 if(((std::min)(fabs(l1), fabs(l2)) < 0.2))
|
Chris@16
|
227 {
|
Chris@16
|
228 // when the base of the exponent is very near 1 we get really
|
Chris@16
|
229 // gross errors unless extra care is taken:
|
Chris@16
|
230 if((l1 * l2 > 0) || ((std::min)(a, b) < 1))
|
Chris@16
|
231 {
|
Chris@16
|
232 //
|
Chris@16
|
233 // This first branch handles the simple cases where either:
|
Chris@16
|
234 //
|
Chris@16
|
235 // * The two power terms both go in the same direction
|
Chris@16
|
236 // (towards zero or towards infinity). In this case if either
|
Chris@16
|
237 // term overflows or underflows, then the product of the two must
|
Chris@16
|
238 // do so also.
|
Chris@16
|
239 // *Alternatively if one exponent is less than one, then we
|
Chris@16
|
240 // can't productively use it to eliminate overflow or underflow
|
Chris@16
|
241 // from the other term. Problems with spurious overflow/underflow
|
Chris@16
|
242 // can't be ruled out in this case, but it is *very* unlikely
|
Chris@16
|
243 // since one of the power terms will evaluate to a number close to 1.
|
Chris@16
|
244 //
|
Chris@16
|
245 if(fabs(l1) < 0.1)
|
Chris@16
|
246 {
|
Chris@16
|
247 result *= exp(a * boost::math::log1p(l1, pol));
|
Chris@16
|
248 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
249 }
|
Chris@16
|
250 else
|
Chris@16
|
251 {
|
Chris@16
|
252 result *= pow((x * cgh) / agh, a);
|
Chris@16
|
253 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
254 }
|
Chris@16
|
255 if(fabs(l2) < 0.1)
|
Chris@16
|
256 {
|
Chris@16
|
257 result *= exp(b * boost::math::log1p(l2, pol));
|
Chris@16
|
258 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
259 }
|
Chris@16
|
260 else
|
Chris@16
|
261 {
|
Chris@16
|
262 result *= pow((y * cgh) / bgh, b);
|
Chris@16
|
263 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
264 }
|
Chris@16
|
265 }
|
Chris@16
|
266 else if((std::max)(fabs(l1), fabs(l2)) < 0.5)
|
Chris@16
|
267 {
|
Chris@16
|
268 //
|
Chris@16
|
269 // Both exponents are near one and both the exponents are
|
Chris@16
|
270 // greater than one and further these two
|
Chris@16
|
271 // power terms tend in opposite directions (one towards zero,
|
Chris@16
|
272 // the other towards infinity), so we have to combine the terms
|
Chris@16
|
273 // to avoid any risk of overflow or underflow.
|
Chris@16
|
274 //
|
Chris@16
|
275 // We do this by moving one power term inside the other, we have:
|
Chris@16
|
276 //
|
Chris@16
|
277 // (1 + l1)^a * (1 + l2)^b
|
Chris@16
|
278 // = ((1 + l1)*(1 + l2)^(b/a))^a
|
Chris@16
|
279 // = (1 + l1 + l3 + l1*l3)^a ; l3 = (1 + l2)^(b/a) - 1
|
Chris@16
|
280 // = exp((b/a) * log(1 + l2)) - 1
|
Chris@16
|
281 //
|
Chris@16
|
282 // The tricky bit is deciding which term to move inside :-)
|
Chris@16
|
283 // By preference we move the larger term inside, so that the
|
Chris@16
|
284 // size of the largest exponent is reduced. However, that can
|
Chris@16
|
285 // only be done as long as l3 (see above) is also small.
|
Chris@16
|
286 //
|
Chris@16
|
287 bool small_a = a < b;
|
Chris@16
|
288 T ratio = b / a;
|
Chris@16
|
289 if((small_a && (ratio * l2 < 0.1)) || (!small_a && (l1 / ratio > 0.1)))
|
Chris@16
|
290 {
|
Chris@16
|
291 T l3 = boost::math::expm1(ratio * boost::math::log1p(l2, pol), pol);
|
Chris@16
|
292 l3 = l1 + l3 + l3 * l1;
|
Chris@16
|
293 l3 = a * boost::math::log1p(l3, pol);
|
Chris@16
|
294 result *= exp(l3);
|
Chris@16
|
295 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
296 }
|
Chris@16
|
297 else
|
Chris@16
|
298 {
|
Chris@16
|
299 T l3 = boost::math::expm1(boost::math::log1p(l1, pol) / ratio, pol);
|
Chris@16
|
300 l3 = l2 + l3 + l3 * l2;
|
Chris@16
|
301 l3 = b * boost::math::log1p(l3, pol);
|
Chris@16
|
302 result *= exp(l3);
|
Chris@16
|
303 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
304 }
|
Chris@16
|
305 }
|
Chris@16
|
306 else if(fabs(l1) < fabs(l2))
|
Chris@16
|
307 {
|
Chris@16
|
308 // First base near 1 only:
|
Chris@16
|
309 T l = a * boost::math::log1p(l1, pol)
|
Chris@16
|
310 + b * log((y * cgh) / bgh);
|
Chris@16
|
311 result *= exp(l);
|
Chris@16
|
312 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
313 }
|
Chris@16
|
314 else
|
Chris@16
|
315 {
|
Chris@16
|
316 // Second base near 1 only:
|
Chris@16
|
317 T l = b * boost::math::log1p(l2, pol)
|
Chris@16
|
318 + a * log((x * cgh) / agh);
|
Chris@16
|
319 result *= exp(l);
|
Chris@16
|
320 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
321 }
|
Chris@16
|
322 }
|
Chris@16
|
323 else
|
Chris@16
|
324 {
|
Chris@16
|
325 // general case:
|
Chris@16
|
326 T b1 = (x * cgh) / agh;
|
Chris@16
|
327 T b2 = (y * cgh) / bgh;
|
Chris@16
|
328 l1 = a * log(b1);
|
Chris@16
|
329 l2 = b * log(b2);
|
Chris@16
|
330 BOOST_MATH_INSTRUMENT_VARIABLE(b1);
|
Chris@16
|
331 BOOST_MATH_INSTRUMENT_VARIABLE(b2);
|
Chris@16
|
332 BOOST_MATH_INSTRUMENT_VARIABLE(l1);
|
Chris@16
|
333 BOOST_MATH_INSTRUMENT_VARIABLE(l2);
|
Chris@16
|
334 if((l1 >= tools::log_max_value<T>())
|
Chris@16
|
335 || (l1 <= tools::log_min_value<T>())
|
Chris@16
|
336 || (l2 >= tools::log_max_value<T>())
|
Chris@16
|
337 || (l2 <= tools::log_min_value<T>())
|
Chris@16
|
338 )
|
Chris@16
|
339 {
|
Chris@16
|
340 // Oops, overflow, sidestep:
|
Chris@16
|
341 if(a < b)
|
Chris@16
|
342 result *= pow(pow(b2, b/a) * b1, a);
|
Chris@16
|
343 else
|
Chris@16
|
344 result *= pow(pow(b1, a/b) * b2, b);
|
Chris@16
|
345 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
346 }
|
Chris@16
|
347 else
|
Chris@16
|
348 {
|
Chris@16
|
349 // finally the normal case:
|
Chris@16
|
350 result *= pow(b1, a) * pow(b2, b);
|
Chris@16
|
351 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
352 }
|
Chris@16
|
353 }
|
Chris@16
|
354 // combine with the leftover terms from the Lanczos approximation:
|
Chris@16
|
355 result *= sqrt(bgh / boost::math::constants::e<T>());
|
Chris@16
|
356 result *= sqrt(agh / cgh);
|
Chris@16
|
357 result *= prefix;
|
Chris@16
|
358
|
Chris@16
|
359 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
360
|
Chris@16
|
361 return result;
|
Chris@16
|
362 }
|
Chris@16
|
363 //
|
Chris@16
|
364 // Compute the leading power terms in the incomplete Beta:
|
Chris@16
|
365 //
|
Chris@16
|
366 // (x^a)(y^b)/Beta(a,b) when normalised, and
|
Chris@16
|
367 // (x^a)(y^b) otherwise.
|
Chris@16
|
368 //
|
Chris@16
|
369 // Almost all of the error in the incomplete beta comes from this
|
Chris@16
|
370 // function: particularly when a and b are large. Computing large
|
Chris@16
|
371 // powers are *hard* though, and using logarithms just leads to
|
Chris@16
|
372 // horrendous cancellation errors.
|
Chris@16
|
373 //
|
Chris@16
|
374 // This version is generic, slow, and does not use the Lanczos approximation.
|
Chris@16
|
375 //
|
Chris@16
|
376 template <class T, class Policy>
|
Chris@16
|
377 T ibeta_power_terms(T a,
|
Chris@16
|
378 T b,
|
Chris@16
|
379 T x,
|
Chris@16
|
380 T y,
|
Chris@16
|
381 const boost::math::lanczos::undefined_lanczos&,
|
Chris@16
|
382 bool normalised,
|
Chris@16
|
383 const Policy& pol)
|
Chris@16
|
384 {
|
Chris@16
|
385 BOOST_MATH_STD_USING
|
Chris@16
|
386
|
Chris@16
|
387 if(!normalised)
|
Chris@16
|
388 {
|
Chris@16
|
389 return pow(x, a) * pow(y, b);
|
Chris@16
|
390 }
|
Chris@16
|
391
|
Chris@16
|
392 T result= 0; // assignment here silences warnings later
|
Chris@16
|
393
|
Chris@16
|
394 T c = a + b;
|
Chris@16
|
395
|
Chris@16
|
396 // integration limits for the gamma functions:
|
Chris@16
|
397 //T la = (std::max)(T(10), a);
|
Chris@16
|
398 //T lb = (std::max)(T(10), b);
|
Chris@16
|
399 //T lc = (std::max)(T(10), a+b);
|
Chris@16
|
400 T la = a + 5;
|
Chris@16
|
401 T lb = b + 5;
|
Chris@16
|
402 T lc = a + b + 5;
|
Chris@16
|
403 // gamma function partials:
|
Chris@16
|
404 T sa = detail::lower_gamma_series(a, la, pol) / a;
|
Chris@16
|
405 sa += detail::upper_gamma_fraction(a, la, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
406 T sb = detail::lower_gamma_series(b, lb, pol) / b;
|
Chris@16
|
407 sb += detail::upper_gamma_fraction(b, lb, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
408 T sc = detail::lower_gamma_series(c, lc, pol) / c;
|
Chris@16
|
409 sc += detail::upper_gamma_fraction(c, lc, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
410 // gamma function powers combined with incomplete beta powers:
|
Chris@16
|
411
|
Chris@16
|
412 T b1 = (x * lc) / la;
|
Chris@16
|
413 T b2 = (y * lc) / lb;
|
Chris@16
|
414 T e1 = lc - la - lb;
|
Chris@16
|
415 T lb1 = a * log(b1);
|
Chris@16
|
416 T lb2 = b * log(b2);
|
Chris@16
|
417
|
Chris@16
|
418 if((lb1 >= tools::log_max_value<T>())
|
Chris@16
|
419 || (lb1 <= tools::log_min_value<T>())
|
Chris@16
|
420 || (lb2 >= tools::log_max_value<T>())
|
Chris@16
|
421 || (lb2 <= tools::log_min_value<T>())
|
Chris@16
|
422 || (e1 >= tools::log_max_value<T>())
|
Chris@16
|
423 || (e1 <= tools::log_min_value<T>())
|
Chris@16
|
424 )
|
Chris@16
|
425 {
|
Chris@16
|
426 result = exp(lb1 + lb2 - e1);
|
Chris@16
|
427 }
|
Chris@16
|
428 else
|
Chris@16
|
429 {
|
Chris@16
|
430 T p1, p2;
|
Chris@16
|
431 if((fabs(b1 - 1) * a < 10) && (a > 1))
|
Chris@16
|
432 p1 = exp(a * boost::math::log1p((x * b - y * la) / la, pol));
|
Chris@16
|
433 else
|
Chris@16
|
434 p1 = pow(b1, a);
|
Chris@16
|
435 if((fabs(b2 - 1) * b < 10) && (b > 1))
|
Chris@16
|
436 p2 = exp(b * boost::math::log1p((y * a - x * lb) / lb, pol));
|
Chris@16
|
437 else
|
Chris@16
|
438 p2 = pow(b2, b);
|
Chris@16
|
439 T p3 = exp(e1);
|
Chris@16
|
440 result = p1 * p2 / p3;
|
Chris@16
|
441 }
|
Chris@16
|
442 // and combine with the remaining gamma function components:
|
Chris@16
|
443 result /= sa * sb / sc;
|
Chris@16
|
444
|
Chris@16
|
445 return result;
|
Chris@16
|
446 }
|
Chris@16
|
447 //
|
Chris@16
|
448 // Series approximation to the incomplete beta:
|
Chris@16
|
449 //
|
Chris@16
|
450 template <class T>
|
Chris@16
|
451 struct ibeta_series_t
|
Chris@16
|
452 {
|
Chris@16
|
453 typedef T result_type;
|
Chris@16
|
454 ibeta_series_t(T a_, T b_, T x_, T mult) : result(mult), x(x_), apn(a_), poch(1-b_), n(1) {}
|
Chris@16
|
455 T operator()()
|
Chris@16
|
456 {
|
Chris@16
|
457 T r = result / apn;
|
Chris@16
|
458 apn += 1;
|
Chris@16
|
459 result *= poch * x / n;
|
Chris@16
|
460 ++n;
|
Chris@16
|
461 poch += 1;
|
Chris@16
|
462 return r;
|
Chris@16
|
463 }
|
Chris@16
|
464 private:
|
Chris@16
|
465 T result, x, apn, poch;
|
Chris@16
|
466 int n;
|
Chris@16
|
467 };
|
Chris@16
|
468
|
Chris@16
|
469 template <class T, class Lanczos, class Policy>
|
Chris@16
|
470 T ibeta_series(T a, T b, T x, T s0, const Lanczos&, bool normalised, T* p_derivative, T y, const Policy& pol)
|
Chris@16
|
471 {
|
Chris@16
|
472 BOOST_MATH_STD_USING
|
Chris@16
|
473
|
Chris@16
|
474 T result;
|
Chris@16
|
475
|
Chris@16
|
476 BOOST_ASSERT((p_derivative == 0) || normalised);
|
Chris@16
|
477
|
Chris@16
|
478 if(normalised)
|
Chris@16
|
479 {
|
Chris@16
|
480 T c = a + b;
|
Chris@16
|
481
|
Chris@16
|
482 // incomplete beta power term, combined with the Lanczos approximation:
|
Chris@16
|
483 T agh = a + Lanczos::g() - T(0.5);
|
Chris@16
|
484 T bgh = b + Lanczos::g() - T(0.5);
|
Chris@16
|
485 T cgh = c + Lanczos::g() - T(0.5);
|
Chris@16
|
486 result = Lanczos::lanczos_sum_expG_scaled(c) / (Lanczos::lanczos_sum_expG_scaled(a) * Lanczos::lanczos_sum_expG_scaled(b));
|
Chris@16
|
487 if(a * b < bgh * 10)
|
Chris@16
|
488 result *= exp((b - 0.5f) * boost::math::log1p(a / bgh, pol));
|
Chris@16
|
489 else
|
Chris@16
|
490 result *= pow(cgh / bgh, b - 0.5f);
|
Chris@16
|
491 result *= pow(x * cgh / agh, a);
|
Chris@16
|
492 result *= sqrt(agh / boost::math::constants::e<T>());
|
Chris@16
|
493
|
Chris@16
|
494 if(p_derivative)
|
Chris@16
|
495 {
|
Chris@16
|
496 *p_derivative = result * pow(y, b);
|
Chris@16
|
497 BOOST_ASSERT(*p_derivative >= 0);
|
Chris@16
|
498 }
|
Chris@16
|
499 }
|
Chris@16
|
500 else
|
Chris@16
|
501 {
|
Chris@16
|
502 // Non-normalised, just compute the power:
|
Chris@16
|
503 result = pow(x, a);
|
Chris@16
|
504 }
|
Chris@16
|
505 if(result < tools::min_value<T>())
|
Chris@16
|
506 return s0; // Safeguard: series can't cope with denorms.
|
Chris@16
|
507 ibeta_series_t<T> s(a, b, x, result);
|
Chris@16
|
508 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
|
Chris@16
|
509 result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<T, Policy>(), max_iter, s0);
|
Chris@16
|
510 policies::check_series_iterations<T>("boost::math::ibeta<%1%>(%1%, %1%, %1%) in ibeta_series (with lanczos)", max_iter, pol);
|
Chris@16
|
511 return result;
|
Chris@16
|
512 }
|
Chris@16
|
513 //
|
Chris@16
|
514 // Incomplete Beta series again, this time without Lanczos support:
|
Chris@16
|
515 //
|
Chris@16
|
516 template <class T, class Policy>
|
Chris@16
|
517 T ibeta_series(T a, T b, T x, T s0, const boost::math::lanczos::undefined_lanczos&, bool normalised, T* p_derivative, T y, const Policy& pol)
|
Chris@16
|
518 {
|
Chris@16
|
519 BOOST_MATH_STD_USING
|
Chris@16
|
520
|
Chris@16
|
521 T result;
|
Chris@16
|
522 BOOST_ASSERT((p_derivative == 0) || normalised);
|
Chris@16
|
523
|
Chris@16
|
524 if(normalised)
|
Chris@16
|
525 {
|
Chris@16
|
526 T c = a + b;
|
Chris@16
|
527
|
Chris@16
|
528 // figure out integration limits for the gamma function:
|
Chris@16
|
529 //T la = (std::max)(T(10), a);
|
Chris@16
|
530 //T lb = (std::max)(T(10), b);
|
Chris@16
|
531 //T lc = (std::max)(T(10), a+b);
|
Chris@16
|
532 T la = a + 5;
|
Chris@16
|
533 T lb = b + 5;
|
Chris@16
|
534 T lc = a + b + 5;
|
Chris@16
|
535
|
Chris@16
|
536 // calculate the gamma parts:
|
Chris@16
|
537 T sa = detail::lower_gamma_series(a, la, pol) / a;
|
Chris@16
|
538 sa += detail::upper_gamma_fraction(a, la, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
539 T sb = detail::lower_gamma_series(b, lb, pol) / b;
|
Chris@16
|
540 sb += detail::upper_gamma_fraction(b, lb, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
541 T sc = detail::lower_gamma_series(c, lc, pol) / c;
|
Chris@16
|
542 sc += detail::upper_gamma_fraction(c, lc, ::boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
543
|
Chris@16
|
544 // and their combined power-terms:
|
Chris@16
|
545 T b1 = (x * lc) / la;
|
Chris@16
|
546 T b2 = lc/lb;
|
Chris@16
|
547 T e1 = lc - la - lb;
|
Chris@16
|
548 T lb1 = a * log(b1);
|
Chris@16
|
549 T lb2 = b * log(b2);
|
Chris@16
|
550
|
Chris@16
|
551 if((lb1 >= tools::log_max_value<T>())
|
Chris@16
|
552 || (lb1 <= tools::log_min_value<T>())
|
Chris@16
|
553 || (lb2 >= tools::log_max_value<T>())
|
Chris@16
|
554 || (lb2 <= tools::log_min_value<T>())
|
Chris@16
|
555 || (e1 >= tools::log_max_value<T>())
|
Chris@16
|
556 || (e1 <= tools::log_min_value<T>()) )
|
Chris@16
|
557 {
|
Chris@16
|
558 T p = lb1 + lb2 - e1;
|
Chris@16
|
559 result = exp(p);
|
Chris@16
|
560 }
|
Chris@16
|
561 else
|
Chris@16
|
562 {
|
Chris@16
|
563 result = pow(b1, a);
|
Chris@16
|
564 if(a * b < lb * 10)
|
Chris@16
|
565 result *= exp(b * boost::math::log1p(a / lb, pol));
|
Chris@16
|
566 else
|
Chris@16
|
567 result *= pow(b2, b);
|
Chris@16
|
568 result /= exp(e1);
|
Chris@16
|
569 }
|
Chris@16
|
570 // and combine the results:
|
Chris@16
|
571 result /= sa * sb / sc;
|
Chris@16
|
572
|
Chris@16
|
573 if(p_derivative)
|
Chris@16
|
574 {
|
Chris@16
|
575 *p_derivative = result * pow(y, b);
|
Chris@16
|
576 BOOST_ASSERT(*p_derivative >= 0);
|
Chris@16
|
577 }
|
Chris@16
|
578 }
|
Chris@16
|
579 else
|
Chris@16
|
580 {
|
Chris@16
|
581 // Non-normalised, just compute the power:
|
Chris@16
|
582 result = pow(x, a);
|
Chris@16
|
583 }
|
Chris@16
|
584 if(result < tools::min_value<T>())
|
Chris@16
|
585 return s0; // Safeguard: series can't cope with denorms.
|
Chris@16
|
586 ibeta_series_t<T> s(a, b, x, result);
|
Chris@16
|
587 boost::uintmax_t max_iter = policies::get_max_series_iterations<Policy>();
|
Chris@16
|
588 result = boost::math::tools::sum_series(s, boost::math::policies::get_epsilon<T, Policy>(), max_iter, s0);
|
Chris@16
|
589 policies::check_series_iterations<T>("boost::math::ibeta<%1%>(%1%, %1%, %1%) in ibeta_series (without lanczos)", max_iter, pol);
|
Chris@16
|
590 return result;
|
Chris@16
|
591 }
|
Chris@16
|
592
|
Chris@16
|
593 //
|
Chris@16
|
594 // Continued fraction for the incomplete beta:
|
Chris@16
|
595 //
|
Chris@16
|
596 template <class T>
|
Chris@16
|
597 struct ibeta_fraction2_t
|
Chris@16
|
598 {
|
Chris@16
|
599 typedef std::pair<T, T> result_type;
|
Chris@16
|
600
|
Chris@16
|
601 ibeta_fraction2_t(T a_, T b_, T x_, T y_) : a(a_), b(b_), x(x_), y(y_), m(0) {}
|
Chris@16
|
602
|
Chris@16
|
603 result_type operator()()
|
Chris@16
|
604 {
|
Chris@16
|
605 T aN = (a + m - 1) * (a + b + m - 1) * m * (b - m) * x * x;
|
Chris@16
|
606 T denom = (a + 2 * m - 1);
|
Chris@16
|
607 aN /= denom * denom;
|
Chris@16
|
608
|
Chris@16
|
609 T bN = m;
|
Chris@16
|
610 bN += (m * (b - m) * x) / (a + 2*m - 1);
|
Chris@16
|
611 bN += ((a + m) * (a * y - b * x + 1 + m *(2 - x))) / (a + 2*m + 1);
|
Chris@16
|
612
|
Chris@16
|
613 ++m;
|
Chris@16
|
614
|
Chris@16
|
615 return std::make_pair(aN, bN);
|
Chris@16
|
616 }
|
Chris@16
|
617
|
Chris@16
|
618 private:
|
Chris@16
|
619 T a, b, x, y;
|
Chris@16
|
620 int m;
|
Chris@16
|
621 };
|
Chris@16
|
622 //
|
Chris@16
|
623 // Evaluate the incomplete beta via the continued fraction representation:
|
Chris@16
|
624 //
|
Chris@16
|
625 template <class T, class Policy>
|
Chris@16
|
626 inline T ibeta_fraction2(T a, T b, T x, T y, const Policy& pol, bool normalised, T* p_derivative)
|
Chris@16
|
627 {
|
Chris@16
|
628 typedef typename lanczos::lanczos<T, Policy>::type lanczos_type;
|
Chris@16
|
629 BOOST_MATH_STD_USING
|
Chris@16
|
630 T result = ibeta_power_terms(a, b, x, y, lanczos_type(), normalised, pol);
|
Chris@16
|
631 if(p_derivative)
|
Chris@16
|
632 {
|
Chris@16
|
633 *p_derivative = result;
|
Chris@16
|
634 BOOST_ASSERT(*p_derivative >= 0);
|
Chris@16
|
635 }
|
Chris@16
|
636 if(result == 0)
|
Chris@16
|
637 return result;
|
Chris@16
|
638
|
Chris@16
|
639 ibeta_fraction2_t<T> f(a, b, x, y);
|
Chris@16
|
640 T fract = boost::math::tools::continued_fraction_b(f, boost::math::policies::get_epsilon<T, Policy>());
|
Chris@16
|
641 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
642 BOOST_MATH_INSTRUMENT_VARIABLE(result);
|
Chris@16
|
643 return result / fract;
|
Chris@16
|
644 }
|
Chris@16
|
645 //
|
Chris@16
|
646 // Computes the difference between ibeta(a,b,x) and ibeta(a+k,b,x):
|
Chris@16
|
647 //
|
Chris@16
|
648 template <class T, class Policy>
|
Chris@16
|
649 T ibeta_a_step(T a, T b, T x, T y, int k, const Policy& pol, bool normalised, T* p_derivative)
|
Chris@16
|
650 {
|
Chris@16
|
651 typedef typename lanczos::lanczos<T, Policy>::type lanczos_type;
|
Chris@16
|
652
|
Chris@16
|
653 BOOST_MATH_INSTRUMENT_VARIABLE(k);
|
Chris@16
|
654
|
Chris@16
|
655 T prefix = ibeta_power_terms(a, b, x, y, lanczos_type(), normalised, pol);
|
Chris@16
|
656 if(p_derivative)
|
Chris@16
|
657 {
|
Chris@16
|
658 *p_derivative = prefix;
|
Chris@16
|
659 BOOST_ASSERT(*p_derivative >= 0);
|
Chris@16
|
660 }
|
Chris@16
|
661 prefix /= a;
|
Chris@16
|
662 if(prefix == 0)
|
Chris@16
|
663 return prefix;
|
Chris@16
|
664 T sum = 1;
|
Chris@16
|
665 T term = 1;
|
Chris@16
|
666 // series summation from 0 to k-1:
|
Chris@16
|
667 for(int i = 0; i < k-1; ++i)
|
Chris@16
|
668 {
|
Chris@16
|
669 term *= (a+b+i) * x / (a+i+1);
|
Chris@16
|
670 sum += term;
|
Chris@16
|
671 }
|
Chris@16
|
672 prefix *= sum;
|
Chris@16
|
673
|
Chris@16
|
674 return prefix;
|
Chris@16
|
675 }
|
Chris@16
|
676 //
|
Chris@16
|
677 // This function is only needed for the non-regular incomplete beta,
|
Chris@16
|
678 // it computes the delta in:
|
Chris@16
|
679 // beta(a,b,x) = prefix + delta * beta(a+k,b,x)
|
Chris@16
|
680 // it is currently only called for small k.
|
Chris@16
|
681 //
|
Chris@16
|
682 template <class T>
|
Chris@16
|
683 inline T rising_factorial_ratio(T a, T b, int k)
|
Chris@16
|
684 {
|
Chris@16
|
685 // calculate:
|
Chris@16
|
686 // (a)(a+1)(a+2)...(a+k-1)
|
Chris@16
|
687 // _______________________
|
Chris@16
|
688 // (b)(b+1)(b+2)...(b+k-1)
|
Chris@16
|
689
|
Chris@16
|
690 // This is only called with small k, for large k
|
Chris@16
|
691 // it is grossly inefficient, do not use outside it's
|
Chris@16
|
692 // intended purpose!!!
|
Chris@16
|
693 BOOST_MATH_INSTRUMENT_VARIABLE(k);
|
Chris@16
|
694 if(k == 0)
|
Chris@16
|
695 return 1;
|
Chris@16
|
696 T result = 1;
|
Chris@16
|
697 for(int i = 0; i < k; ++i)
|
Chris@16
|
698 result *= (a+i) / (b+i);
|
Chris@16
|
699 return result;
|
Chris@16
|
700 }
|
Chris@16
|
701 //
|
Chris@16
|
702 // Routine for a > 15, b < 1
|
Chris@16
|
703 //
|
Chris@16
|
704 // Begin by figuring out how large our table of Pn's should be,
|
Chris@16
|
705 // quoted accuracies are "guestimates" based on empiracal observation.
|
Chris@16
|
706 // Note that the table size should never exceed the size of our
|
Chris@16
|
707 // tables of factorials.
|
Chris@16
|
708 //
|
Chris@16
|
709 template <class T>
|
Chris@16
|
710 struct Pn_size
|
Chris@16
|
711 {
|
Chris@16
|
712 // This is likely to be enough for ~35-50 digit accuracy
|
Chris@16
|
713 // but it's hard to quantify exactly:
|
Chris@16
|
714 BOOST_STATIC_CONSTANT(unsigned, value = 50);
|
Chris@16
|
715 BOOST_STATIC_ASSERT(::boost::math::max_factorial<T>::value >= 100);
|
Chris@16
|
716 };
|
Chris@16
|
717 template <>
|
Chris@16
|
718 struct Pn_size<float>
|
Chris@16
|
719 {
|
Chris@16
|
720 BOOST_STATIC_CONSTANT(unsigned, value = 15); // ~8-15 digit accuracy
|
Chris@16
|
721 BOOST_STATIC_ASSERT(::boost::math::max_factorial<float>::value >= 30);
|
Chris@16
|
722 };
|
Chris@16
|
723 template <>
|
Chris@16
|
724 struct Pn_size<double>
|
Chris@16
|
725 {
|
Chris@16
|
726 BOOST_STATIC_CONSTANT(unsigned, value = 30); // 16-20 digit accuracy
|
Chris@16
|
727 BOOST_STATIC_ASSERT(::boost::math::max_factorial<double>::value >= 60);
|
Chris@16
|
728 };
|
Chris@16
|
729 template <>
|
Chris@16
|
730 struct Pn_size<long double>
|
Chris@16
|
731 {
|
Chris@16
|
732 BOOST_STATIC_CONSTANT(unsigned, value = 50); // ~35-50 digit accuracy
|
Chris@16
|
733 BOOST_STATIC_ASSERT(::boost::math::max_factorial<long double>::value >= 100);
|
Chris@16
|
734 };
|
Chris@16
|
735
|
Chris@16
|
736 template <class T, class Policy>
|
Chris@16
|
737 T beta_small_b_large_a_series(T a, T b, T x, T y, T s0, T mult, const Policy& pol, bool normalised)
|
Chris@16
|
738 {
|
Chris@16
|
739 typedef typename lanczos::lanczos<T, Policy>::type lanczos_type;
|
Chris@16
|
740 BOOST_MATH_STD_USING
|
Chris@16
|
741 //
|
Chris@16
|
742 // This is DiDonato and Morris's BGRAT routine, see Eq's 9 through 9.6.
|
Chris@16
|
743 //
|
Chris@16
|
744 // Some values we'll need later, these are Eq 9.1:
|
Chris@16
|
745 //
|
Chris@16
|
746 T bm1 = b - 1;
|
Chris@16
|
747 T t = a + bm1 / 2;
|
Chris@16
|
748 T lx, u;
|
Chris@16
|
749 if(y < 0.35)
|
Chris@16
|
750 lx = boost::math::log1p(-y, pol);
|
Chris@16
|
751 else
|
Chris@16
|
752 lx = log(x);
|
Chris@16
|
753 u = -t * lx;
|
Chris@16
|
754 // and from from 9.2:
|
Chris@16
|
755 T prefix;
|
Chris@16
|
756 T h = regularised_gamma_prefix(b, u, pol, lanczos_type());
|
Chris@16
|
757 if(h <= tools::min_value<T>())
|
Chris@16
|
758 return s0;
|
Chris@16
|
759 if(normalised)
|
Chris@16
|
760 {
|
Chris@16
|
761 prefix = h / boost::math::tgamma_delta_ratio(a, b, pol);
|
Chris@16
|
762 prefix /= pow(t, b);
|
Chris@16
|
763 }
|
Chris@16
|
764 else
|
Chris@16
|
765 {
|
Chris@16
|
766 prefix = full_igamma_prefix(b, u, pol) / pow(t, b);
|
Chris@16
|
767 }
|
Chris@16
|
768 prefix *= mult;
|
Chris@16
|
769 //
|
Chris@16
|
770 // now we need the quantity Pn, unfortunatately this is computed
|
Chris@16
|
771 // recursively, and requires a full history of all the previous values
|
Chris@16
|
772 // so no choice but to declare a big table and hope it's big enough...
|
Chris@16
|
773 //
|
Chris@16
|
774 T p[ ::boost::math::detail::Pn_size<T>::value ] = { 1 }; // see 9.3.
|
Chris@16
|
775 //
|
Chris@16
|
776 // Now an initial value for J, see 9.6:
|
Chris@16
|
777 //
|
Chris@16
|
778 T j = boost::math::gamma_q(b, u, pol) / h;
|
Chris@16
|
779 //
|
Chris@16
|
780 // Now we can start to pull things together and evaluate the sum in Eq 9:
|
Chris@16
|
781 //
|
Chris@16
|
782 T sum = s0 + prefix * j; // Value at N = 0
|
Chris@16
|
783 // some variables we'll need:
|
Chris@16
|
784 unsigned tnp1 = 1; // 2*N+1
|
Chris@16
|
785 T lx2 = lx / 2;
|
Chris@16
|
786 lx2 *= lx2;
|
Chris@16
|
787 T lxp = 1;
|
Chris@16
|
788 T t4 = 4 * t * t;
|
Chris@16
|
789 T b2n = b;
|
Chris@16
|
790
|
Chris@16
|
791 for(unsigned n = 1; n < sizeof(p)/sizeof(p[0]); ++n)
|
Chris@16
|
792 {
|
Chris@16
|
793 /*
|
Chris@16
|
794 // debugging code, enable this if you want to determine whether
|
Chris@16
|
795 // the table of Pn's is large enough...
|
Chris@16
|
796 //
|
Chris@16
|
797 static int max_count = 2;
|
Chris@16
|
798 if(n > max_count)
|
Chris@16
|
799 {
|
Chris@16
|
800 max_count = n;
|
Chris@16
|
801 std::cerr << "Max iterations in BGRAT was " << n << std::endl;
|
Chris@16
|
802 }
|
Chris@16
|
803 */
|
Chris@16
|
804 //
|
Chris@16
|
805 // begin by evaluating the next Pn from Eq 9.4:
|
Chris@16
|
806 //
|
Chris@16
|
807 tnp1 += 2;
|
Chris@16
|
808 p[n] = 0;
|
Chris@16
|
809 T mbn = b - n;
|
Chris@16
|
810 unsigned tmp1 = 3;
|
Chris@16
|
811 for(unsigned m = 1; m < n; ++m)
|
Chris@16
|
812 {
|
Chris@16
|
813 mbn = m * b - n;
|
Chris@16
|
814 p[n] += mbn * p[n-m] / boost::math::unchecked_factorial<T>(tmp1);
|
Chris@16
|
815 tmp1 += 2;
|
Chris@16
|
816 }
|
Chris@16
|
817 p[n] /= n;
|
Chris@16
|
818 p[n] += bm1 / boost::math::unchecked_factorial<T>(tnp1);
|
Chris@16
|
819 //
|
Chris@16
|
820 // Now we want Jn from Jn-1 using Eq 9.6:
|
Chris@16
|
821 //
|
Chris@16
|
822 j = (b2n * (b2n + 1) * j + (u + b2n + 1) * lxp) / t4;
|
Chris@16
|
823 lxp *= lx2;
|
Chris@16
|
824 b2n += 2;
|
Chris@16
|
825 //
|
Chris@16
|
826 // pull it together with Eq 9:
|
Chris@16
|
827 //
|
Chris@16
|
828 T r = prefix * p[n] * j;
|
Chris@16
|
829 sum += r;
|
Chris@16
|
830 if(r > 1)
|
Chris@16
|
831 {
|
Chris@16
|
832 if(fabs(r) < fabs(tools::epsilon<T>() * sum))
|
Chris@16
|
833 break;
|
Chris@16
|
834 }
|
Chris@16
|
835 else
|
Chris@16
|
836 {
|
Chris@16
|
837 if(fabs(r / tools::epsilon<T>()) < fabs(sum))
|
Chris@16
|
838 break;
|
Chris@16
|
839 }
|
Chris@16
|
840 }
|
Chris@16
|
841 return sum;
|
Chris@16
|
842 } // template <class T, class Lanczos>T beta_small_b_large_a_series(T a, T b, T x, T y, T s0, T mult, const Lanczos& l, bool normalised)
|
Chris@16
|
843
|
Chris@16
|
844 //
|
Chris@16
|
845 // For integer arguments we can relate the incomplete beta to the
|
Chris@16
|
846 // complement of the binomial distribution cdf and use this finite sum.
|
Chris@16
|
847 //
|
Chris@16
|
848 template <class T>
|
Chris@101
|
849 T binomial_ccdf(T n, T k, T x, T y)
|
Chris@16
|
850 {
|
Chris@16
|
851 BOOST_MATH_STD_USING // ADL of std names
|
Chris@101
|
852
|
Chris@16
|
853 T result = pow(x, n);
|
Chris@101
|
854
|
Chris@101
|
855 if(result > tools::min_value<T>())
|
Chris@16
|
856 {
|
Chris@101
|
857 T term = result;
|
Chris@101
|
858 for(unsigned i = itrunc(T(n - 1)); i > k; --i)
|
Chris@101
|
859 {
|
Chris@101
|
860 term *= ((i + 1) * y) / ((n - i) * x);
|
Chris@101
|
861 result += term;
|
Chris@101
|
862 }
|
Chris@101
|
863 }
|
Chris@101
|
864 else
|
Chris@101
|
865 {
|
Chris@101
|
866 // First term underflows so we need to start at the mode of the
|
Chris@101
|
867 // distribution and work outwards:
|
Chris@101
|
868 int start = itrunc(n * x);
|
Chris@101
|
869 if(start <= k + 1)
|
Chris@101
|
870 start = itrunc(k + 2);
|
Chris@101
|
871 result = pow(x, start) * pow(y, n - start) * boost::math::binomial_coefficient<T>(itrunc(n), itrunc(start));
|
Chris@101
|
872 if(result == 0)
|
Chris@101
|
873 {
|
Chris@101
|
874 // OK, starting slightly above the mode didn't work,
|
Chris@101
|
875 // we'll have to sum the terms the old fashioned way:
|
Chris@101
|
876 for(unsigned i = start - 1; i > k; --i)
|
Chris@101
|
877 {
|
Chris@101
|
878 result += pow(x, (int)i) * pow(y, n - i) * boost::math::binomial_coefficient<T>(itrunc(n), itrunc(i));
|
Chris@101
|
879 }
|
Chris@101
|
880 }
|
Chris@101
|
881 else
|
Chris@101
|
882 {
|
Chris@101
|
883 T term = result;
|
Chris@101
|
884 T start_term = result;
|
Chris@101
|
885 for(unsigned i = start - 1; i > k; --i)
|
Chris@101
|
886 {
|
Chris@101
|
887 term *= ((i + 1) * y) / ((n - i) * x);
|
Chris@101
|
888 result += term;
|
Chris@101
|
889 }
|
Chris@101
|
890 term = start_term;
|
Chris@101
|
891 for(unsigned i = start + 1; i <= n; ++i)
|
Chris@101
|
892 {
|
Chris@101
|
893 term *= (n - i + 1) * x / (i * y);
|
Chris@101
|
894 result += term;
|
Chris@101
|
895 }
|
Chris@101
|
896 }
|
Chris@16
|
897 }
|
Chris@16
|
898
|
Chris@16
|
899 return result;
|
Chris@16
|
900 }
|
Chris@16
|
901
|
Chris@16
|
902
|
Chris@16
|
903 //
|
Chris@16
|
904 // The incomplete beta function implementation:
|
Chris@16
|
905 // This is just a big bunch of spagetti code to divide up the
|
Chris@16
|
906 // input range and select the right implementation method for
|
Chris@16
|
907 // each domain:
|
Chris@16
|
908 //
|
Chris@16
|
909 template <class T, class Policy>
|
Chris@16
|
910 T ibeta_imp(T a, T b, T x, const Policy& pol, bool inv, bool normalised, T* p_derivative)
|
Chris@16
|
911 {
|
Chris@16
|
912 static const char* function = "boost::math::ibeta<%1%>(%1%, %1%, %1%)";
|
Chris@16
|
913 typedef typename lanczos::lanczos<T, Policy>::type lanczos_type;
|
Chris@16
|
914 BOOST_MATH_STD_USING // for ADL of std math functions.
|
Chris@16
|
915
|
Chris@16
|
916 BOOST_MATH_INSTRUMENT_VARIABLE(a);
|
Chris@16
|
917 BOOST_MATH_INSTRUMENT_VARIABLE(b);
|
Chris@16
|
918 BOOST_MATH_INSTRUMENT_VARIABLE(x);
|
Chris@16
|
919 BOOST_MATH_INSTRUMENT_VARIABLE(inv);
|
Chris@16
|
920 BOOST_MATH_INSTRUMENT_VARIABLE(normalised);
|
Chris@16
|
921
|
Chris@16
|
922 bool invert = inv;
|
Chris@16
|
923 T fract;
|
Chris@16
|
924 T y = 1 - x;
|
Chris@16
|
925
|
Chris@16
|
926 BOOST_ASSERT((p_derivative == 0) || normalised);
|
Chris@16
|
927
|
Chris@16
|
928 if(p_derivative)
|
Chris@16
|
929 *p_derivative = -1; // value not set.
|
Chris@16
|
930
|
Chris@16
|
931 if((x < 0) || (x > 1))
|
Chris@101
|
932 return policies::raise_domain_error<T>(function, "Parameter x outside the range [0,1] in the incomplete beta function (got x=%1%).", x, pol);
|
Chris@16
|
933
|
Chris@16
|
934 if(normalised)
|
Chris@16
|
935 {
|
Chris@16
|
936 if(a < 0)
|
Chris@101
|
937 return policies::raise_domain_error<T>(function, "The argument a to the incomplete beta function must be >= zero (got a=%1%).", a, pol);
|
Chris@16
|
938 if(b < 0)
|
Chris@101
|
939 return policies::raise_domain_error<T>(function, "The argument b to the incomplete beta function must be >= zero (got b=%1%).", b, pol);
|
Chris@16
|
940 // extend to a few very special cases:
|
Chris@16
|
941 if(a == 0)
|
Chris@16
|
942 {
|
Chris@16
|
943 if(b == 0)
|
Chris@101
|
944 return policies::raise_domain_error<T>(function, "The arguments a and b to the incomplete beta function cannot both be zero, with x=%1%.", x, pol);
|
Chris@16
|
945 if(b > 0)
|
Chris@16
|
946 return inv ? 0 : 1;
|
Chris@16
|
947 }
|
Chris@16
|
948 else if(b == 0)
|
Chris@16
|
949 {
|
Chris@16
|
950 if(a > 0)
|
Chris@16
|
951 return inv ? 1 : 0;
|
Chris@16
|
952 }
|
Chris@16
|
953 }
|
Chris@16
|
954 else
|
Chris@16
|
955 {
|
Chris@16
|
956 if(a <= 0)
|
Chris@101
|
957 return policies::raise_domain_error<T>(function, "The argument a to the incomplete beta function must be greater than zero (got a=%1%).", a, pol);
|
Chris@16
|
958 if(b <= 0)
|
Chris@101
|
959 return policies::raise_domain_error<T>(function, "The argument b to the incomplete beta function must be greater than zero (got b=%1%).", b, pol);
|
Chris@16
|
960 }
|
Chris@16
|
961
|
Chris@16
|
962 if(x == 0)
|
Chris@16
|
963 {
|
Chris@16
|
964 if(p_derivative)
|
Chris@16
|
965 {
|
Chris@16
|
966 *p_derivative = (a == 1) ? (T)1 : (a < 1) ? T(tools::max_value<T>() / 2) : T(tools::min_value<T>() * 2);
|
Chris@16
|
967 }
|
Chris@16
|
968 return (invert ? (normalised ? T(1) : boost::math::beta(a, b, pol)) : T(0));
|
Chris@16
|
969 }
|
Chris@16
|
970 if(x == 1)
|
Chris@16
|
971 {
|
Chris@16
|
972 if(p_derivative)
|
Chris@16
|
973 {
|
Chris@16
|
974 *p_derivative = (b == 1) ? T(1) : (b < 1) ? T(tools::max_value<T>() / 2) : T(tools::min_value<T>() * 2);
|
Chris@16
|
975 }
|
Chris@16
|
976 return (invert == 0 ? (normalised ? 1 : boost::math::beta(a, b, pol)) : 0);
|
Chris@16
|
977 }
|
Chris@16
|
978 if((a == 0.5f) && (b == 0.5f))
|
Chris@16
|
979 {
|
Chris@16
|
980 // We have an arcsine distribution:
|
Chris@16
|
981 if(p_derivative)
|
Chris@16
|
982 {
|
Chris@101
|
983 *p_derivative = 1 / constants::pi<T>() * sqrt(y * x);
|
Chris@16
|
984 }
|
Chris@16
|
985 T p = invert ? asin(sqrt(y)) / constants::half_pi<T>() : asin(sqrt(x)) / constants::half_pi<T>();
|
Chris@16
|
986 if(!normalised)
|
Chris@16
|
987 p *= constants::pi<T>();
|
Chris@16
|
988 return p;
|
Chris@16
|
989 }
|
Chris@16
|
990 if(a == 1)
|
Chris@16
|
991 {
|
Chris@16
|
992 std::swap(a, b);
|
Chris@16
|
993 std::swap(x, y);
|
Chris@16
|
994 invert = !invert;
|
Chris@16
|
995 }
|
Chris@16
|
996 if(b == 1)
|
Chris@16
|
997 {
|
Chris@16
|
998 //
|
Chris@16
|
999 // Special case see: http://functions.wolfram.com/GammaBetaErf/BetaRegularized/03/01/01/
|
Chris@16
|
1000 //
|
Chris@16
|
1001 if(a == 1)
|
Chris@16
|
1002 {
|
Chris@16
|
1003 if(p_derivative)
|
Chris@101
|
1004 *p_derivative = 1;
|
Chris@16
|
1005 return invert ? y : x;
|
Chris@16
|
1006 }
|
Chris@16
|
1007
|
Chris@16
|
1008 if(p_derivative)
|
Chris@16
|
1009 {
|
Chris@101
|
1010 *p_derivative = a * pow(x, a - 1);
|
Chris@16
|
1011 }
|
Chris@16
|
1012 T p;
|
Chris@16
|
1013 if(y < 0.5)
|
Chris@101
|
1014 p = invert ? T(-boost::math::expm1(a * boost::math::log1p(-y, pol), pol)) : T(exp(a * boost::math::log1p(-y, pol)));
|
Chris@16
|
1015 else
|
Chris@101
|
1016 p = invert ? T(-boost::math::powm1(x, a, pol)) : T(pow(x, a));
|
Chris@16
|
1017 if(!normalised)
|
Chris@16
|
1018 p /= a;
|
Chris@16
|
1019 return p;
|
Chris@16
|
1020 }
|
Chris@16
|
1021
|
Chris@16
|
1022 if((std::min)(a, b) <= 1)
|
Chris@16
|
1023 {
|
Chris@16
|
1024 if(x > 0.5)
|
Chris@16
|
1025 {
|
Chris@16
|
1026 std::swap(a, b);
|
Chris@16
|
1027 std::swap(x, y);
|
Chris@16
|
1028 invert = !invert;
|
Chris@16
|
1029 BOOST_MATH_INSTRUMENT_VARIABLE(invert);
|
Chris@16
|
1030 }
|
Chris@16
|
1031 if((std::max)(a, b) <= 1)
|
Chris@16
|
1032 {
|
Chris@16
|
1033 // Both a,b < 1:
|
Chris@16
|
1034 if((a >= (std::min)(T(0.2), b)) || (pow(x, a) <= 0.9))
|
Chris@16
|
1035 {
|
Chris@16
|
1036 if(!invert)
|
Chris@16
|
1037 {
|
Chris@16
|
1038 fract = ibeta_series(a, b, x, T(0), lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1039 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1040 }
|
Chris@16
|
1041 else
|
Chris@16
|
1042 {
|
Chris@16
|
1043 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1044 invert = false;
|
Chris@16
|
1045 fract = -ibeta_series(a, b, x, fract, lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1046 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1047 }
|
Chris@16
|
1048 }
|
Chris@16
|
1049 else
|
Chris@16
|
1050 {
|
Chris@16
|
1051 std::swap(a, b);
|
Chris@16
|
1052 std::swap(x, y);
|
Chris@16
|
1053 invert = !invert;
|
Chris@16
|
1054 if(y >= 0.3)
|
Chris@16
|
1055 {
|
Chris@16
|
1056 if(!invert)
|
Chris@16
|
1057 {
|
Chris@16
|
1058 fract = ibeta_series(a, b, x, T(0), lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1059 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1060 }
|
Chris@16
|
1061 else
|
Chris@16
|
1062 {
|
Chris@16
|
1063 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1064 invert = false;
|
Chris@16
|
1065 fract = -ibeta_series(a, b, x, fract, lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1066 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1067 }
|
Chris@16
|
1068 }
|
Chris@16
|
1069 else
|
Chris@16
|
1070 {
|
Chris@16
|
1071 // Sidestep on a, and then use the series representation:
|
Chris@16
|
1072 T prefix;
|
Chris@16
|
1073 if(!normalised)
|
Chris@16
|
1074 {
|
Chris@16
|
1075 prefix = rising_factorial_ratio(T(a+b), a, 20);
|
Chris@16
|
1076 }
|
Chris@16
|
1077 else
|
Chris@16
|
1078 {
|
Chris@16
|
1079 prefix = 1;
|
Chris@16
|
1080 }
|
Chris@16
|
1081 fract = ibeta_a_step(a, b, x, y, 20, pol, normalised, p_derivative);
|
Chris@16
|
1082 if(!invert)
|
Chris@16
|
1083 {
|
Chris@16
|
1084 fract = beta_small_b_large_a_series(T(a + 20), b, x, y, fract, prefix, pol, normalised);
|
Chris@16
|
1085 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1086 }
|
Chris@16
|
1087 else
|
Chris@16
|
1088 {
|
Chris@16
|
1089 fract -= (normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1090 invert = false;
|
Chris@16
|
1091 fract = -beta_small_b_large_a_series(T(a + 20), b, x, y, fract, prefix, pol, normalised);
|
Chris@16
|
1092 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1093 }
|
Chris@16
|
1094 }
|
Chris@16
|
1095 }
|
Chris@16
|
1096 }
|
Chris@16
|
1097 else
|
Chris@16
|
1098 {
|
Chris@16
|
1099 // One of a, b < 1 only:
|
Chris@16
|
1100 if((b <= 1) || ((x < 0.1) && (pow(b * x, a) <= 0.7)))
|
Chris@16
|
1101 {
|
Chris@16
|
1102 if(!invert)
|
Chris@16
|
1103 {
|
Chris@16
|
1104 fract = ibeta_series(a, b, x, T(0), lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1105 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1106 }
|
Chris@16
|
1107 else
|
Chris@16
|
1108 {
|
Chris@16
|
1109 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1110 invert = false;
|
Chris@16
|
1111 fract = -ibeta_series(a, b, x, fract, lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1112 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1113 }
|
Chris@16
|
1114 }
|
Chris@16
|
1115 else
|
Chris@16
|
1116 {
|
Chris@16
|
1117 std::swap(a, b);
|
Chris@16
|
1118 std::swap(x, y);
|
Chris@16
|
1119 invert = !invert;
|
Chris@16
|
1120
|
Chris@16
|
1121 if(y >= 0.3)
|
Chris@16
|
1122 {
|
Chris@16
|
1123 if(!invert)
|
Chris@16
|
1124 {
|
Chris@16
|
1125 fract = ibeta_series(a, b, x, T(0), lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1126 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1127 }
|
Chris@16
|
1128 else
|
Chris@16
|
1129 {
|
Chris@16
|
1130 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1131 invert = false;
|
Chris@16
|
1132 fract = -ibeta_series(a, b, x, fract, lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1133 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1134 }
|
Chris@16
|
1135 }
|
Chris@16
|
1136 else if(a >= 15)
|
Chris@16
|
1137 {
|
Chris@16
|
1138 if(!invert)
|
Chris@16
|
1139 {
|
Chris@16
|
1140 fract = beta_small_b_large_a_series(a, b, x, y, T(0), T(1), pol, normalised);
|
Chris@16
|
1141 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1142 }
|
Chris@16
|
1143 else
|
Chris@16
|
1144 {
|
Chris@16
|
1145 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1146 invert = false;
|
Chris@16
|
1147 fract = -beta_small_b_large_a_series(a, b, x, y, fract, T(1), pol, normalised);
|
Chris@16
|
1148 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1149 }
|
Chris@16
|
1150 }
|
Chris@16
|
1151 else
|
Chris@16
|
1152 {
|
Chris@16
|
1153 // Sidestep to improve errors:
|
Chris@16
|
1154 T prefix;
|
Chris@16
|
1155 if(!normalised)
|
Chris@16
|
1156 {
|
Chris@16
|
1157 prefix = rising_factorial_ratio(T(a+b), a, 20);
|
Chris@16
|
1158 }
|
Chris@16
|
1159 else
|
Chris@16
|
1160 {
|
Chris@16
|
1161 prefix = 1;
|
Chris@16
|
1162 }
|
Chris@16
|
1163 fract = ibeta_a_step(a, b, x, y, 20, pol, normalised, p_derivative);
|
Chris@16
|
1164 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1165 if(!invert)
|
Chris@16
|
1166 {
|
Chris@16
|
1167 fract = beta_small_b_large_a_series(T(a + 20), b, x, y, fract, prefix, pol, normalised);
|
Chris@16
|
1168 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1169 }
|
Chris@16
|
1170 else
|
Chris@16
|
1171 {
|
Chris@16
|
1172 fract -= (normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1173 invert = false;
|
Chris@16
|
1174 fract = -beta_small_b_large_a_series(T(a + 20), b, x, y, fract, prefix, pol, normalised);
|
Chris@16
|
1175 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1176 }
|
Chris@16
|
1177 }
|
Chris@16
|
1178 }
|
Chris@16
|
1179 }
|
Chris@16
|
1180 }
|
Chris@16
|
1181 else
|
Chris@16
|
1182 {
|
Chris@16
|
1183 // Both a,b >= 1:
|
Chris@16
|
1184 T lambda;
|
Chris@16
|
1185 if(a < b)
|
Chris@16
|
1186 {
|
Chris@16
|
1187 lambda = a - (a + b) * x;
|
Chris@16
|
1188 }
|
Chris@16
|
1189 else
|
Chris@16
|
1190 {
|
Chris@16
|
1191 lambda = (a + b) * y - b;
|
Chris@16
|
1192 }
|
Chris@16
|
1193 if(lambda < 0)
|
Chris@16
|
1194 {
|
Chris@16
|
1195 std::swap(a, b);
|
Chris@16
|
1196 std::swap(x, y);
|
Chris@16
|
1197 invert = !invert;
|
Chris@16
|
1198 BOOST_MATH_INSTRUMENT_VARIABLE(invert);
|
Chris@16
|
1199 }
|
Chris@16
|
1200
|
Chris@16
|
1201 if(b < 40)
|
Chris@16
|
1202 {
|
Chris@16
|
1203 if((floor(a) == a) && (floor(b) == b) && (a < (std::numeric_limits<int>::max)() - 100))
|
Chris@16
|
1204 {
|
Chris@16
|
1205 // relate to the binomial distribution and use a finite sum:
|
Chris@16
|
1206 T k = a - 1;
|
Chris@16
|
1207 T n = b + k;
|
Chris@16
|
1208 fract = binomial_ccdf(n, k, x, y);
|
Chris@16
|
1209 if(!normalised)
|
Chris@16
|
1210 fract *= boost::math::beta(a, b, pol);
|
Chris@16
|
1211 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1212 }
|
Chris@16
|
1213 else if(b * x <= 0.7)
|
Chris@16
|
1214 {
|
Chris@16
|
1215 if(!invert)
|
Chris@16
|
1216 {
|
Chris@16
|
1217 fract = ibeta_series(a, b, x, T(0), lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1218 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1219 }
|
Chris@16
|
1220 else
|
Chris@16
|
1221 {
|
Chris@16
|
1222 fract = -(normalised ? 1 : boost::math::beta(a, b, pol));
|
Chris@16
|
1223 invert = false;
|
Chris@16
|
1224 fract = -ibeta_series(a, b, x, fract, lanczos_type(), normalised, p_derivative, y, pol);
|
Chris@16
|
1225 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1226 }
|
Chris@16
|
1227 }
|
Chris@16
|
1228 else if(a > 15)
|
Chris@16
|
1229 {
|
Chris@16
|
1230 // sidestep so we can use the series representation:
|
Chris@16
|
1231 int n = itrunc(T(floor(b)), pol);
|
Chris@16
|
1232 if(n == b)
|
Chris@16
|
1233 --n;
|
Chris@16
|
1234 T bbar = b - n;
|
Chris@16
|
1235 T prefix;
|
Chris@16
|
1236 if(!normalised)
|
Chris@16
|
1237 {
|
Chris@16
|
1238 prefix = rising_factorial_ratio(T(a+bbar), bbar, n);
|
Chris@16
|
1239 }
|
Chris@16
|
1240 else
|
Chris@16
|
1241 {
|
Chris@16
|
1242 prefix = 1;
|
Chris@16
|
1243 }
|
Chris@16
|
1244 fract = ibeta_a_step(bbar, a, y, x, n, pol, normalised, static_cast<T*>(0));
|
Chris@16
|
1245 fract = beta_small_b_large_a_series(a, bbar, x, y, fract, T(1), pol, normalised);
|
Chris@16
|
1246 fract /= prefix;
|
Chris@16
|
1247 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1248 }
|
Chris@16
|
1249 else if(normalised)
|
Chris@16
|
1250 {
|
Chris@101
|
1251 // The formula here for the non-normalised case is tricky to figure
|
Chris@16
|
1252 // out (for me!!), and requires two pochhammer calculations rather
|
Chris@101
|
1253 // than one, so leave it for now and only use this in the normalized case....
|
Chris@16
|
1254 int n = itrunc(T(floor(b)), pol);
|
Chris@16
|
1255 T bbar = b - n;
|
Chris@16
|
1256 if(bbar <= 0)
|
Chris@16
|
1257 {
|
Chris@16
|
1258 --n;
|
Chris@16
|
1259 bbar += 1;
|
Chris@16
|
1260 }
|
Chris@16
|
1261 fract = ibeta_a_step(bbar, a, y, x, n, pol, normalised, static_cast<T*>(0));
|
Chris@16
|
1262 fract += ibeta_a_step(a, bbar, x, y, 20, pol, normalised, static_cast<T*>(0));
|
Chris@16
|
1263 if(invert)
|
Chris@101
|
1264 fract -= 1; // Note this line would need changing if we ever enable this branch in non-normalized case
|
Chris@16
|
1265 fract = beta_small_b_large_a_series(T(a+20), bbar, x, y, fract, T(1), pol, normalised);
|
Chris@16
|
1266 if(invert)
|
Chris@16
|
1267 {
|
Chris@16
|
1268 fract = -fract;
|
Chris@16
|
1269 invert = false;
|
Chris@16
|
1270 }
|
Chris@16
|
1271 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1272 }
|
Chris@16
|
1273 else
|
Chris@16
|
1274 {
|
Chris@16
|
1275 fract = ibeta_fraction2(a, b, x, y, pol, normalised, p_derivative);
|
Chris@16
|
1276 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1277 }
|
Chris@16
|
1278 }
|
Chris@16
|
1279 else
|
Chris@16
|
1280 {
|
Chris@16
|
1281 fract = ibeta_fraction2(a, b, x, y, pol, normalised, p_derivative);
|
Chris@16
|
1282 BOOST_MATH_INSTRUMENT_VARIABLE(fract);
|
Chris@16
|
1283 }
|
Chris@16
|
1284 }
|
Chris@16
|
1285 if(p_derivative)
|
Chris@16
|
1286 {
|
Chris@16
|
1287 if(*p_derivative < 0)
|
Chris@16
|
1288 {
|
Chris@16
|
1289 *p_derivative = ibeta_power_terms(a, b, x, y, lanczos_type(), true, pol);
|
Chris@16
|
1290 }
|
Chris@16
|
1291 T div = y * x;
|
Chris@16
|
1292
|
Chris@16
|
1293 if(*p_derivative != 0)
|
Chris@16
|
1294 {
|
Chris@16
|
1295 if((tools::max_value<T>() * div < *p_derivative))
|
Chris@16
|
1296 {
|
Chris@16
|
1297 // overflow, return an arbitarily large value:
|
Chris@16
|
1298 *p_derivative = tools::max_value<T>() / 2;
|
Chris@16
|
1299 }
|
Chris@16
|
1300 else
|
Chris@16
|
1301 {
|
Chris@16
|
1302 *p_derivative /= div;
|
Chris@16
|
1303 }
|
Chris@16
|
1304 }
|
Chris@16
|
1305 }
|
Chris@16
|
1306 return invert ? (normalised ? 1 : boost::math::beta(a, b, pol)) - fract : fract;
|
Chris@16
|
1307 } // template <class T, class Lanczos>T ibeta_imp(T a, T b, T x, const Lanczos& l, bool inv, bool normalised)
|
Chris@16
|
1308
|
Chris@16
|
1309 template <class T, class Policy>
|
Chris@16
|
1310 inline T ibeta_imp(T a, T b, T x, const Policy& pol, bool inv, bool normalised)
|
Chris@16
|
1311 {
|
Chris@16
|
1312 return ibeta_imp(a, b, x, pol, inv, normalised, static_cast<T*>(0));
|
Chris@16
|
1313 }
|
Chris@16
|
1314
|
Chris@16
|
1315 template <class T, class Policy>
|
Chris@16
|
1316 T ibeta_derivative_imp(T a, T b, T x, const Policy& pol)
|
Chris@16
|
1317 {
|
Chris@16
|
1318 static const char* function = "ibeta_derivative<%1%>(%1%,%1%,%1%)";
|
Chris@16
|
1319 //
|
Chris@16
|
1320 // start with the usual error checks:
|
Chris@16
|
1321 //
|
Chris@16
|
1322 if(a <= 0)
|
Chris@101
|
1323 return policies::raise_domain_error<T>(function, "The argument a to the incomplete beta function must be greater than zero (got a=%1%).", a, pol);
|
Chris@16
|
1324 if(b <= 0)
|
Chris@101
|
1325 return policies::raise_domain_error<T>(function, "The argument b to the incomplete beta function must be greater than zero (got b=%1%).", b, pol);
|
Chris@16
|
1326 if((x < 0) || (x > 1))
|
Chris@101
|
1327 return policies::raise_domain_error<T>(function, "Parameter x outside the range [0,1] in the incomplete beta function (got x=%1%).", x, pol);
|
Chris@16
|
1328 //
|
Chris@16
|
1329 // Now the corner cases:
|
Chris@16
|
1330 //
|
Chris@16
|
1331 if(x == 0)
|
Chris@16
|
1332 {
|
Chris@16
|
1333 return (a > 1) ? 0 :
|
Chris@16
|
1334 (a == 1) ? 1 / boost::math::beta(a, b, pol) : policies::raise_overflow_error<T>(function, 0, pol);
|
Chris@16
|
1335 }
|
Chris@16
|
1336 else if(x == 1)
|
Chris@16
|
1337 {
|
Chris@16
|
1338 return (b > 1) ? 0 :
|
Chris@16
|
1339 (b == 1) ? 1 / boost::math::beta(a, b, pol) : policies::raise_overflow_error<T>(function, 0, pol);
|
Chris@16
|
1340 }
|
Chris@16
|
1341 //
|
Chris@16
|
1342 // Now the regular cases:
|
Chris@16
|
1343 //
|
Chris@16
|
1344 typedef typename lanczos::lanczos<T, Policy>::type lanczos_type;
|
Chris@16
|
1345 T f1 = ibeta_power_terms<T>(a, b, x, 1 - x, lanczos_type(), true, pol);
|
Chris@16
|
1346 T y = (1 - x) * x;
|
Chris@16
|
1347
|
Chris@16
|
1348 if(f1 == 0)
|
Chris@16
|
1349 return 0;
|
Chris@16
|
1350
|
Chris@16
|
1351 if((tools::max_value<T>() * y < f1))
|
Chris@16
|
1352 {
|
Chris@16
|
1353 // overflow:
|
Chris@16
|
1354 return policies::raise_overflow_error<T>(function, 0, pol);
|
Chris@16
|
1355 }
|
Chris@16
|
1356
|
Chris@16
|
1357 f1 /= y;
|
Chris@16
|
1358
|
Chris@16
|
1359 return f1;
|
Chris@16
|
1360 }
|
Chris@16
|
1361 //
|
Chris@16
|
1362 // Some forwarding functions that dis-ambiguate the third argument type:
|
Chris@16
|
1363 //
|
Chris@16
|
1364 template <class RT1, class RT2, class Policy>
|
Chris@16
|
1365 inline typename tools::promote_args<RT1, RT2>::type
|
Chris@16
|
1366 beta(RT1 a, RT2 b, const Policy&, const mpl::true_*)
|
Chris@16
|
1367 {
|
Chris@16
|
1368 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1369 typedef typename tools::promote_args<RT1, RT2>::type result_type;
|
Chris@16
|
1370 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1371 typedef typename lanczos::lanczos<value_type, Policy>::type evaluation_type;
|
Chris@16
|
1372 typedef typename policies::normalise<
|
Chris@16
|
1373 Policy,
|
Chris@16
|
1374 policies::promote_float<false>,
|
Chris@16
|
1375 policies::promote_double<false>,
|
Chris@16
|
1376 policies::discrete_quantile<>,
|
Chris@16
|
1377 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1378
|
Chris@16
|
1379 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::beta_imp(static_cast<value_type>(a), static_cast<value_type>(b), evaluation_type(), forwarding_policy()), "boost::math::beta<%1%>(%1%,%1%)");
|
Chris@16
|
1380 }
|
Chris@16
|
1381 template <class RT1, class RT2, class RT3>
|
Chris@16
|
1382 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1383 beta(RT1 a, RT2 b, RT3 x, const mpl::false_*)
|
Chris@16
|
1384 {
|
Chris@16
|
1385 return boost::math::beta(a, b, x, policies::policy<>());
|
Chris@16
|
1386 }
|
Chris@16
|
1387 } // namespace detail
|
Chris@16
|
1388
|
Chris@16
|
1389 //
|
Chris@16
|
1390 // The actual function entry-points now follow, these just figure out
|
Chris@16
|
1391 // which Lanczos approximation to use
|
Chris@16
|
1392 // and forward to the implementation functions:
|
Chris@16
|
1393 //
|
Chris@16
|
1394 template <class RT1, class RT2, class A>
|
Chris@16
|
1395 inline typename tools::promote_args<RT1, RT2, A>::type
|
Chris@16
|
1396 beta(RT1 a, RT2 b, A arg)
|
Chris@16
|
1397 {
|
Chris@16
|
1398 typedef typename policies::is_policy<A>::type tag;
|
Chris@16
|
1399 return boost::math::detail::beta(a, b, arg, static_cast<tag*>(0));
|
Chris@16
|
1400 }
|
Chris@16
|
1401
|
Chris@16
|
1402 template <class RT1, class RT2>
|
Chris@16
|
1403 inline typename tools::promote_args<RT1, RT2>::type
|
Chris@16
|
1404 beta(RT1 a, RT2 b)
|
Chris@16
|
1405 {
|
Chris@16
|
1406 return boost::math::beta(a, b, policies::policy<>());
|
Chris@16
|
1407 }
|
Chris@16
|
1408
|
Chris@16
|
1409 template <class RT1, class RT2, class RT3, class Policy>
|
Chris@16
|
1410 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1411 beta(RT1 a, RT2 b, RT3 x, const Policy&)
|
Chris@16
|
1412 {
|
Chris@16
|
1413 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1414 typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type;
|
Chris@16
|
1415 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1416 typedef typename policies::normalise<
|
Chris@16
|
1417 Policy,
|
Chris@16
|
1418 policies::promote_float<false>,
|
Chris@16
|
1419 policies::promote_double<false>,
|
Chris@16
|
1420 policies::discrete_quantile<>,
|
Chris@16
|
1421 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1422
|
Chris@16
|
1423 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::ibeta_imp(static_cast<value_type>(a), static_cast<value_type>(b), static_cast<value_type>(x), forwarding_policy(), false, false), "boost::math::beta<%1%>(%1%,%1%,%1%)");
|
Chris@16
|
1424 }
|
Chris@16
|
1425
|
Chris@16
|
1426 template <class RT1, class RT2, class RT3, class Policy>
|
Chris@16
|
1427 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1428 betac(RT1 a, RT2 b, RT3 x, const Policy&)
|
Chris@16
|
1429 {
|
Chris@16
|
1430 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1431 typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type;
|
Chris@16
|
1432 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1433 typedef typename policies::normalise<
|
Chris@16
|
1434 Policy,
|
Chris@16
|
1435 policies::promote_float<false>,
|
Chris@16
|
1436 policies::promote_double<false>,
|
Chris@16
|
1437 policies::discrete_quantile<>,
|
Chris@16
|
1438 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1439
|
Chris@16
|
1440 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::ibeta_imp(static_cast<value_type>(a), static_cast<value_type>(b), static_cast<value_type>(x), forwarding_policy(), true, false), "boost::math::betac<%1%>(%1%,%1%,%1%)");
|
Chris@16
|
1441 }
|
Chris@16
|
1442 template <class RT1, class RT2, class RT3>
|
Chris@16
|
1443 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1444 betac(RT1 a, RT2 b, RT3 x)
|
Chris@16
|
1445 {
|
Chris@16
|
1446 return boost::math::betac(a, b, x, policies::policy<>());
|
Chris@16
|
1447 }
|
Chris@16
|
1448
|
Chris@16
|
1449 template <class RT1, class RT2, class RT3, class Policy>
|
Chris@16
|
1450 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1451 ibeta(RT1 a, RT2 b, RT3 x, const Policy&)
|
Chris@16
|
1452 {
|
Chris@16
|
1453 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1454 typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type;
|
Chris@16
|
1455 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1456 typedef typename policies::normalise<
|
Chris@16
|
1457 Policy,
|
Chris@16
|
1458 policies::promote_float<false>,
|
Chris@16
|
1459 policies::promote_double<false>,
|
Chris@16
|
1460 policies::discrete_quantile<>,
|
Chris@16
|
1461 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1462
|
Chris@16
|
1463 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::ibeta_imp(static_cast<value_type>(a), static_cast<value_type>(b), static_cast<value_type>(x), forwarding_policy(), false, true), "boost::math::ibeta<%1%>(%1%,%1%,%1%)");
|
Chris@16
|
1464 }
|
Chris@16
|
1465 template <class RT1, class RT2, class RT3>
|
Chris@16
|
1466 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1467 ibeta(RT1 a, RT2 b, RT3 x)
|
Chris@16
|
1468 {
|
Chris@16
|
1469 return boost::math::ibeta(a, b, x, policies::policy<>());
|
Chris@16
|
1470 }
|
Chris@16
|
1471
|
Chris@16
|
1472 template <class RT1, class RT2, class RT3, class Policy>
|
Chris@16
|
1473 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1474 ibetac(RT1 a, RT2 b, RT3 x, const Policy&)
|
Chris@16
|
1475 {
|
Chris@16
|
1476 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1477 typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type;
|
Chris@16
|
1478 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1479 typedef typename policies::normalise<
|
Chris@16
|
1480 Policy,
|
Chris@16
|
1481 policies::promote_float<false>,
|
Chris@16
|
1482 policies::promote_double<false>,
|
Chris@16
|
1483 policies::discrete_quantile<>,
|
Chris@16
|
1484 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1485
|
Chris@16
|
1486 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::ibeta_imp(static_cast<value_type>(a), static_cast<value_type>(b), static_cast<value_type>(x), forwarding_policy(), true, true), "boost::math::ibetac<%1%>(%1%,%1%,%1%)");
|
Chris@16
|
1487 }
|
Chris@16
|
1488 template <class RT1, class RT2, class RT3>
|
Chris@16
|
1489 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1490 ibetac(RT1 a, RT2 b, RT3 x)
|
Chris@16
|
1491 {
|
Chris@16
|
1492 return boost::math::ibetac(a, b, x, policies::policy<>());
|
Chris@16
|
1493 }
|
Chris@16
|
1494
|
Chris@16
|
1495 template <class RT1, class RT2, class RT3, class Policy>
|
Chris@16
|
1496 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1497 ibeta_derivative(RT1 a, RT2 b, RT3 x, const Policy&)
|
Chris@16
|
1498 {
|
Chris@16
|
1499 BOOST_FPU_EXCEPTION_GUARD
|
Chris@16
|
1500 typedef typename tools::promote_args<RT1, RT2, RT3>::type result_type;
|
Chris@16
|
1501 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1502 typedef typename policies::normalise<
|
Chris@16
|
1503 Policy,
|
Chris@16
|
1504 policies::promote_float<false>,
|
Chris@16
|
1505 policies::promote_double<false>,
|
Chris@16
|
1506 policies::discrete_quantile<>,
|
Chris@16
|
1507 policies::assert_undefined<> >::type forwarding_policy;
|
Chris@16
|
1508
|
Chris@16
|
1509 return policies::checked_narrowing_cast<result_type, forwarding_policy>(detail::ibeta_derivative_imp(static_cast<value_type>(a), static_cast<value_type>(b), static_cast<value_type>(x), forwarding_policy()), "boost::math::ibeta_derivative<%1%>(%1%,%1%,%1%)");
|
Chris@16
|
1510 }
|
Chris@16
|
1511 template <class RT1, class RT2, class RT3>
|
Chris@16
|
1512 inline typename tools::promote_args<RT1, RT2, RT3>::type
|
Chris@16
|
1513 ibeta_derivative(RT1 a, RT2 b, RT3 x)
|
Chris@16
|
1514 {
|
Chris@16
|
1515 return boost::math::ibeta_derivative(a, b, x, policies::policy<>());
|
Chris@16
|
1516 }
|
Chris@16
|
1517
|
Chris@16
|
1518 } // namespace math
|
Chris@16
|
1519 } // namespace boost
|
Chris@16
|
1520
|
Chris@16
|
1521 #include <boost/math/special_functions/detail/ibeta_inverse.hpp>
|
Chris@16
|
1522 #include <boost/math/special_functions/detail/ibeta_inv_ab.hpp>
|
Chris@16
|
1523
|
Chris@16
|
1524 #endif // BOOST_MATH_SPECIAL_BETA_HPP
|
Chris@16
|
1525
|
Chris@16
|
1526
|
Chris@16
|
1527
|
Chris@16
|
1528
|
Chris@16
|
1529
|