Chris@16
|
1 // Copyright Benjamin Sobotta 2012
|
Chris@16
|
2
|
Chris@16
|
3 // Use, modification and distribution are subject to the
|
Chris@16
|
4 // Boost Software License, Version 1.0. (See accompanying file
|
Chris@16
|
5 // LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
|
Chris@16
|
6
|
Chris@16
|
7 #ifndef BOOST_OWENS_T_HPP
|
Chris@16
|
8 #define BOOST_OWENS_T_HPP
|
Chris@16
|
9
|
Chris@16
|
10 // Reference:
|
Chris@16
|
11 // Mike Patefield, David Tandy
|
Chris@16
|
12 // FAST AND ACCURATE CALCULATION OF OWEN'S T-FUNCTION
|
Chris@16
|
13 // Journal of Statistical Software, 5 (5), 1-25
|
Chris@16
|
14
|
Chris@16
|
15 #ifdef _MSC_VER
|
Chris@16
|
16 # pragma once
|
Chris@16
|
17 #endif
|
Chris@16
|
18
|
Chris@101
|
19 #include <boost/math/special_functions/math_fwd.hpp>
|
Chris@16
|
20 #include <boost/config/no_tr1/cmath.hpp>
|
Chris@16
|
21 #include <boost/math/special_functions/erf.hpp>
|
Chris@16
|
22 #include <boost/math/special_functions/expm1.hpp>
|
Chris@16
|
23 #include <boost/throw_exception.hpp>
|
Chris@16
|
24 #include <boost/assert.hpp>
|
Chris@16
|
25 #include <boost/math/constants/constants.hpp>
|
Chris@16
|
26 #include <boost/math/tools/big_constant.hpp>
|
Chris@16
|
27
|
Chris@16
|
28 #include <stdexcept>
|
Chris@16
|
29
|
Chris@101
|
30 #ifdef BOOST_MSVC
|
Chris@101
|
31 #pragma warning(push)
|
Chris@101
|
32 #pragma warning(disable:4127)
|
Chris@101
|
33 #endif
|
Chris@101
|
34
|
Chris@16
|
35 namespace boost
|
Chris@16
|
36 {
|
Chris@16
|
37 namespace math
|
Chris@16
|
38 {
|
Chris@16
|
39 namespace detail
|
Chris@16
|
40 {
|
Chris@16
|
41 // owens_t_znorm1(x) = P(-oo<Z<=x)-0.5 with Z being normally distributed.
|
Chris@16
|
42 template<typename RealType>
|
Chris@16
|
43 inline RealType owens_t_znorm1(const RealType x)
|
Chris@16
|
44 {
|
Chris@16
|
45 using namespace boost::math::constants;
|
Chris@16
|
46 return erf(x*one_div_root_two<RealType>())*half<RealType>();
|
Chris@16
|
47 } // RealType owens_t_znorm1(const RealType x)
|
Chris@16
|
48
|
Chris@16
|
49 // owens_t_znorm2(x) = P(x<=Z<oo) with Z being normally distributed.
|
Chris@16
|
50 template<typename RealType>
|
Chris@16
|
51 inline RealType owens_t_znorm2(const RealType x)
|
Chris@16
|
52 {
|
Chris@16
|
53 using namespace boost::math::constants;
|
Chris@16
|
54 return erfc(x*one_div_root_two<RealType>())*half<RealType>();
|
Chris@16
|
55 } // RealType owens_t_znorm2(const RealType x)
|
Chris@16
|
56
|
Chris@16
|
57 // Auxiliary function, it computes an array key that is used to determine
|
Chris@16
|
58 // the specific computation method for Owen's T and the order thereof
|
Chris@16
|
59 // used in owens_t_dispatch.
|
Chris@16
|
60 template<typename RealType>
|
Chris@16
|
61 inline unsigned short owens_t_compute_code(const RealType h, const RealType a)
|
Chris@16
|
62 {
|
Chris@16
|
63 static const RealType hrange[] =
|
Chris@16
|
64 {0.02, 0.06, 0.09, 0.125, 0.26, 0.4, 0.6, 1.6, 1.7, 2.33, 2.4, 3.36, 3.4, 4.8};
|
Chris@16
|
65
|
Chris@16
|
66 static const RealType arange[] = {0.025, 0.09, 0.15, 0.36, 0.5, 0.9, 0.99999};
|
Chris@16
|
67 /*
|
Chris@16
|
68 original select array from paper:
|
Chris@16
|
69 1, 1, 2,13,13,13,13,13,13,13,13,16,16,16, 9
|
Chris@16
|
70 1, 2, 2, 3, 3, 5, 5,14,14,15,15,16,16,16, 9
|
Chris@16
|
71 2, 2, 3, 3, 3, 5, 5,15,15,15,15,16,16,16,10
|
Chris@16
|
72 2, 2, 3, 5, 5, 5, 5, 7, 7,16,16,16,16,16,10
|
Chris@16
|
73 2, 3, 3, 5, 5, 6, 6, 8, 8,17,17,17,12,12,11
|
Chris@16
|
74 2, 3, 5, 5, 5, 6, 6, 8, 8,17,17,17,12,12,12
|
Chris@16
|
75 2, 3, 4, 4, 6, 6, 8, 8,17,17,17,17,17,12,12
|
Chris@16
|
76 2, 3, 4, 4, 6, 6,18,18,18,18,17,17,17,12,12
|
Chris@16
|
77 */
|
Chris@16
|
78 // subtract one because the array is written in FORTRAN in mind - in C arrays start @ zero
|
Chris@16
|
79 static const unsigned short select[] =
|
Chris@16
|
80 {
|
Chris@16
|
81 0, 0 , 1 , 12 ,12 , 12 , 12 , 12 , 12 , 12 , 12 , 15 , 15 , 15 , 8,
|
Chris@16
|
82 0 , 1 , 1 , 2 , 2 , 4 , 4 , 13 , 13 , 14 , 14 , 15 , 15 , 15 , 8,
|
Chris@16
|
83 1 , 1 , 2 , 2 , 2 , 4 , 4 , 14 , 14 , 14 , 14 , 15 , 15 , 15 , 9,
|
Chris@16
|
84 1 , 1 , 2 , 4 , 4 , 4 , 4 , 6 , 6 , 15 , 15 , 15 , 15 , 15 , 9,
|
Chris@16
|
85 1 , 2 , 2 , 4 , 4 , 5 , 5 , 7 , 7 , 16 ,16 , 16 , 11 , 11 , 10,
|
Chris@16
|
86 1 , 2 , 4 , 4 , 4 , 5 , 5 , 7 , 7 , 16 , 16 , 16 , 11 , 11 , 11,
|
Chris@16
|
87 1 , 2 , 3 , 3 , 5 , 5 , 7 , 7 , 16 , 16 , 16 , 16 , 16 , 11 , 11,
|
Chris@16
|
88 1 , 2 , 3 , 3 , 5 , 5 , 17 , 17 , 17 , 17 , 16 , 16 , 16 , 11 , 11
|
Chris@16
|
89 };
|
Chris@16
|
90
|
Chris@16
|
91 unsigned short ihint = 14, iaint = 7;
|
Chris@16
|
92 for(unsigned short i = 0; i != 14; i++)
|
Chris@16
|
93 {
|
Chris@16
|
94 if( h <= hrange[i] )
|
Chris@16
|
95 {
|
Chris@16
|
96 ihint = i;
|
Chris@16
|
97 break;
|
Chris@16
|
98 }
|
Chris@16
|
99 } // for(unsigned short i = 0; i != 14; i++)
|
Chris@16
|
100
|
Chris@16
|
101 for(unsigned short i = 0; i != 7; i++)
|
Chris@16
|
102 {
|
Chris@16
|
103 if( a <= arange[i] )
|
Chris@16
|
104 {
|
Chris@16
|
105 iaint = i;
|
Chris@16
|
106 break;
|
Chris@16
|
107 }
|
Chris@16
|
108 } // for(unsigned short i = 0; i != 7; i++)
|
Chris@16
|
109
|
Chris@16
|
110 // interprete select array as 8x15 matrix
|
Chris@16
|
111 return select[iaint*15 + ihint];
|
Chris@16
|
112
|
Chris@16
|
113 } // unsigned short owens_t_compute_code(const RealType h, const RealType a)
|
Chris@16
|
114
|
Chris@16
|
115 template<typename RealType>
|
Chris@16
|
116 inline unsigned short owens_t_get_order_imp(const unsigned short icode, RealType, const mpl::int_<53>&)
|
Chris@16
|
117 {
|
Chris@16
|
118 static const unsigned short ord[] = {2, 3, 4, 5, 7, 10, 12, 18, 10, 20, 30, 0, 4, 7, 8, 20, 0, 0}; // 18 entries
|
Chris@16
|
119
|
Chris@16
|
120 BOOST_ASSERT(icode<18);
|
Chris@16
|
121
|
Chris@16
|
122 return ord[icode];
|
Chris@16
|
123 } // unsigned short owens_t_get_order(const unsigned short icode, RealType, mpl::int<53> const&)
|
Chris@16
|
124
|
Chris@16
|
125 template<typename RealType>
|
Chris@16
|
126 inline unsigned short owens_t_get_order_imp(const unsigned short icode, RealType, const mpl::int_<64>&)
|
Chris@16
|
127 {
|
Chris@16
|
128 // method ================>>> {1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6}
|
Chris@16
|
129 static const unsigned short ord[] = {3, 4, 5, 6, 8, 11, 13, 19, 10, 20, 30, 0, 7, 10, 11, 23, 0, 0}; // 18 entries
|
Chris@16
|
130
|
Chris@16
|
131 BOOST_ASSERT(icode<18);
|
Chris@16
|
132
|
Chris@16
|
133 return ord[icode];
|
Chris@16
|
134 } // unsigned short owens_t_get_order(const unsigned short icode, RealType, mpl::int<64> const&)
|
Chris@16
|
135
|
Chris@16
|
136 template<typename RealType, typename Policy>
|
Chris@16
|
137 inline unsigned short owens_t_get_order(const unsigned short icode, RealType r, const Policy&)
|
Chris@16
|
138 {
|
Chris@16
|
139 typedef typename policies::precision<RealType, Policy>::type precision_type;
|
Chris@16
|
140 typedef typename mpl::if_<
|
Chris@16
|
141 mpl::or_<
|
Chris@16
|
142 mpl::less_equal<precision_type, mpl::int_<0> >,
|
Chris@16
|
143 mpl::greater<precision_type, mpl::int_<53> >
|
Chris@16
|
144 >,
|
Chris@16
|
145 mpl::int_<64>,
|
Chris@16
|
146 mpl::int_<53>
|
Chris@16
|
147 >::type tag_type;
|
Chris@16
|
148
|
Chris@16
|
149 return owens_t_get_order_imp(icode, r, tag_type());
|
Chris@16
|
150 }
|
Chris@16
|
151
|
Chris@16
|
152 // compute the value of Owen's T function with method T1 from the reference paper
|
Chris@101
|
153 template<typename RealType, typename Policy>
|
Chris@101
|
154 inline RealType owens_t_T1(const RealType h, const RealType a, const unsigned short m, const Policy& pol)
|
Chris@16
|
155 {
|
Chris@16
|
156 BOOST_MATH_STD_USING
|
Chris@16
|
157 using namespace boost::math::constants;
|
Chris@16
|
158
|
Chris@16
|
159 const RealType hs = -h*h*half<RealType>();
|
Chris@16
|
160 const RealType dhs = exp( hs );
|
Chris@16
|
161 const RealType as = a*a;
|
Chris@16
|
162
|
Chris@16
|
163 unsigned short j=1;
|
Chris@16
|
164 RealType jj = 1;
|
Chris@16
|
165 RealType aj = a * one_div_two_pi<RealType>();
|
Chris@101
|
166 RealType dj = boost::math::expm1( hs, pol);
|
Chris@16
|
167 RealType gj = hs*dhs;
|
Chris@16
|
168
|
Chris@16
|
169 RealType val = atan( a ) * one_div_two_pi<RealType>();
|
Chris@16
|
170
|
Chris@16
|
171 while( true )
|
Chris@16
|
172 {
|
Chris@16
|
173 val += dj*aj/jj;
|
Chris@16
|
174
|
Chris@16
|
175 if( m <= j )
|
Chris@16
|
176 break;
|
Chris@16
|
177
|
Chris@16
|
178 j++;
|
Chris@16
|
179 jj += static_cast<RealType>(2);
|
Chris@16
|
180 aj *= as;
|
Chris@16
|
181 dj = gj - dj;
|
Chris@16
|
182 gj *= hs / static_cast<RealType>(j);
|
Chris@16
|
183 } // while( true )
|
Chris@16
|
184
|
Chris@16
|
185 return val;
|
Chris@16
|
186 } // RealType owens_t_T1(const RealType h, const RealType a, const unsigned short m)
|
Chris@16
|
187
|
Chris@16
|
188 // compute the value of Owen's T function with method T2 from the reference paper
|
Chris@16
|
189 template<typename RealType, class Policy>
|
Chris@16
|
190 inline RealType owens_t_T2(const RealType h, const RealType a, const unsigned short m, const RealType ah, const Policy&, const mpl::false_&)
|
Chris@16
|
191 {
|
Chris@16
|
192 BOOST_MATH_STD_USING
|
Chris@16
|
193 using namespace boost::math::constants;
|
Chris@16
|
194
|
Chris@16
|
195 const unsigned short maxii = m+m+1;
|
Chris@16
|
196 const RealType hs = h*h;
|
Chris@16
|
197 const RealType as = -a*a;
|
Chris@16
|
198 const RealType y = static_cast<RealType>(1) / hs;
|
Chris@16
|
199
|
Chris@16
|
200 unsigned short ii = 1;
|
Chris@16
|
201 RealType val = 0;
|
Chris@16
|
202 RealType vi = a * exp( -ah*ah*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
203 RealType z = owens_t_znorm1(ah)/h;
|
Chris@16
|
204
|
Chris@16
|
205 while( true )
|
Chris@16
|
206 {
|
Chris@16
|
207 val += z;
|
Chris@16
|
208 if( maxii <= ii )
|
Chris@16
|
209 {
|
Chris@16
|
210 val *= exp( -hs*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
211 break;
|
Chris@16
|
212 } // if( maxii <= ii )
|
Chris@16
|
213 z = y * ( vi - static_cast<RealType>(ii) * z );
|
Chris@16
|
214 vi *= as;
|
Chris@16
|
215 ii += 2;
|
Chris@16
|
216 } // while( true )
|
Chris@16
|
217
|
Chris@16
|
218 return val;
|
Chris@16
|
219 } // RealType owens_t_T2(const RealType h, const RealType a, const unsigned short m, const RealType ah)
|
Chris@16
|
220
|
Chris@16
|
221 // compute the value of Owen's T function with method T3 from the reference paper
|
Chris@16
|
222 template<typename RealType>
|
Chris@16
|
223 inline RealType owens_t_T3_imp(const RealType h, const RealType a, const RealType ah, const mpl::int_<53>&)
|
Chris@16
|
224 {
|
Chris@16
|
225 BOOST_MATH_STD_USING
|
Chris@16
|
226 using namespace boost::math::constants;
|
Chris@16
|
227
|
Chris@16
|
228 const unsigned short m = 20;
|
Chris@16
|
229
|
Chris@16
|
230 static const RealType c2[] =
|
Chris@16
|
231 {
|
Chris@16
|
232 0.99999999999999987510,
|
Chris@16
|
233 -0.99999999999988796462, 0.99999999998290743652,
|
Chris@16
|
234 -0.99999999896282500134, 0.99999996660459362918,
|
Chris@16
|
235 -0.99999933986272476760, 0.99999125611136965852,
|
Chris@16
|
236 -0.99991777624463387686, 0.99942835555870132569,
|
Chris@16
|
237 -0.99697311720723000295, 0.98751448037275303682,
|
Chris@16
|
238 -0.95915857980572882813, 0.89246305511006708555,
|
Chris@16
|
239 -0.76893425990463999675, 0.58893528468484693250,
|
Chris@16
|
240 -0.38380345160440256652, 0.20317601701045299653,
|
Chris@16
|
241 -0.82813631607004984866E-01, 0.24167984735759576523E-01,
|
Chris@16
|
242 -0.44676566663971825242E-02, 0.39141169402373836468E-03
|
Chris@16
|
243 };
|
Chris@16
|
244
|
Chris@16
|
245 const RealType as = a*a;
|
Chris@16
|
246 const RealType hs = h*h;
|
Chris@16
|
247 const RealType y = static_cast<RealType>(1)/hs;
|
Chris@16
|
248
|
Chris@16
|
249 RealType ii = 1;
|
Chris@16
|
250 unsigned short i = 0;
|
Chris@16
|
251 RealType vi = a * exp( -ah*ah*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
252 RealType zi = owens_t_znorm1(ah)/h;
|
Chris@16
|
253 RealType val = 0;
|
Chris@16
|
254
|
Chris@16
|
255 while( true )
|
Chris@16
|
256 {
|
Chris@16
|
257 BOOST_ASSERT(i < 21);
|
Chris@16
|
258 val += zi*c2[i];
|
Chris@16
|
259 if( m <= i ) // if( m < i+1 )
|
Chris@16
|
260 {
|
Chris@16
|
261 val *= exp( -hs*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
262 break;
|
Chris@16
|
263 } // if( m < i )
|
Chris@16
|
264 zi = y * (ii*zi - vi);
|
Chris@16
|
265 vi *= as;
|
Chris@16
|
266 ii += 2;
|
Chris@16
|
267 i++;
|
Chris@16
|
268 } // while( true )
|
Chris@16
|
269
|
Chris@16
|
270 return val;
|
Chris@16
|
271 } // RealType owens_t_T3(const RealType h, const RealType a, const RealType ah)
|
Chris@16
|
272
|
Chris@16
|
273 // compute the value of Owen's T function with method T3 from the reference paper
|
Chris@16
|
274 template<class RealType>
|
Chris@16
|
275 inline RealType owens_t_T3_imp(const RealType h, const RealType a, const RealType ah, const mpl::int_<64>&)
|
Chris@16
|
276 {
|
Chris@16
|
277 BOOST_MATH_STD_USING
|
Chris@16
|
278 using namespace boost::math::constants;
|
Chris@16
|
279
|
Chris@16
|
280 const unsigned short m = 30;
|
Chris@16
|
281
|
Chris@16
|
282 static const RealType c2[] =
|
Chris@16
|
283 {
|
Chris@16
|
284 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.99999999999999999999999729978162447266851932041876728736094298092917625009873),
|
Chris@16
|
285 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.99999999999999999999467056379678391810626533251885323416799874878563998732905968),
|
Chris@16
|
286 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.99999999999999999824849349313270659391127814689133077036298754586814091034842536),
|
Chris@16
|
287 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.9999999999999997703859616213643405880166422891953033591551179153879839440241685),
|
Chris@16
|
288 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.99999999999998394883415238173334565554173013941245103172035286759201504179038147),
|
Chris@16
|
289 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.9999999999993063616095509371081203145247992197457263066869044528823599399470977),
|
Chris@16
|
290 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.9999999999797336340409464429599229870590160411238245275855903767652432017766116267),
|
Chris@16
|
291 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.999999999574958412069046680119051639753412378037565521359444170241346845522403274),
|
Chris@16
|
292 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.9999999933226234193375324943920160947158239076786103108097456617750134812033362048),
|
Chris@16
|
293 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.9999999188923242461073033481053037468263536806742737922476636768006622772762168467),
|
Chris@16
|
294 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.9999992195143483674402853783549420883055129680082932629160081128947764415749728967),
|
Chris@16
|
295 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.999993935137206712830997921913316971472227199741857386575097250553105958772041501),
|
Chris@16
|
296 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.99996135597690552745362392866517133091672395614263398912807169603795088421057688716),
|
Chris@16
|
297 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.99979556366513946026406788969630293820987757758641211293079784585126692672425362469),
|
Chris@16
|
298 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.999092789629617100153486251423850590051366661947344315423226082520411961968929483),
|
Chris@16
|
299 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.996593837411918202119308620432614600338157335862888580671450938858935084316004769854),
|
Chris@16
|
300 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.98910017138386127038463510314625339359073956513420458166238478926511821146316469589567),
|
Chris@16
|
301 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.970078558040693314521331982203762771512160168582494513347846407314584943870399016019),
|
Chris@16
|
302 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.92911438683263187495758525500033707204091967947532160289872782771388170647150321633673),
|
Chris@16
|
303 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.8542058695956156057286980736842905011429254735181323743367879525470479126968822863),
|
Chris@16
|
304 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.73796526033030091233118357742803709382964420335559408722681794195743240930748630755),
|
Chris@16
|
305 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.58523469882837394570128599003785154144164680587615878645171632791404210655891158),
|
Chris@16
|
306 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.415997776145676306165661663581868460503874205343014196580122174949645271353372263),
|
Chris@16
|
307 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.2588210875241943574388730510317252236407805082485246378222935376279663808416534365),
|
Chris@16
|
308 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.1375535825163892648504646951500265585055789019410617565727090346559210218472356689),
|
Chris@16
|
309 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.0607952766325955730493900985022020434830339794955745989150270485056436844239206648),
|
Chris@16
|
310 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.0216337683299871528059836483840390514275488679530797294557060229266785853764115),
|
Chris@16
|
311 BOOST_MATH_BIG_CONSTANT(RealType, 260, -0.00593405693455186729876995814181203900550014220428843483927218267309209471516256),
|
Chris@16
|
312 BOOST_MATH_BIG_CONSTANT(RealType, 260, 0.0011743414818332946510474576182739210553333860106811865963485870668929503649964142),
|
Chris@16
|
313 BOOST_MATH_BIG_CONSTANT(RealType, 260, -1.489155613350368934073453260689881330166342484405529981510694514036264969925132e-4),
|
Chris@16
|
314 BOOST_MATH_BIG_CONSTANT(RealType, 260, 9.072354320794357587710929507988814669454281514268844884841547607134260303118208e-6)
|
Chris@16
|
315 };
|
Chris@16
|
316
|
Chris@16
|
317 const RealType as = a*a;
|
Chris@16
|
318 const RealType hs = h*h;
|
Chris@16
|
319 const RealType y = 1 / hs;
|
Chris@16
|
320
|
Chris@16
|
321 RealType ii = 1;
|
Chris@16
|
322 unsigned short i = 0;
|
Chris@16
|
323 RealType vi = a * exp( -ah*ah*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
324 RealType zi = owens_t_znorm1(ah)/h;
|
Chris@16
|
325 RealType val = 0;
|
Chris@16
|
326
|
Chris@16
|
327 while( true )
|
Chris@16
|
328 {
|
Chris@16
|
329 BOOST_ASSERT(i < 31);
|
Chris@16
|
330 val += zi*c2[i];
|
Chris@16
|
331 if( m <= i ) // if( m < i+1 )
|
Chris@16
|
332 {
|
Chris@16
|
333 val *= exp( -hs*half<RealType>() ) * one_div_root_two_pi<RealType>();
|
Chris@16
|
334 break;
|
Chris@16
|
335 } // if( m < i )
|
Chris@16
|
336 zi = y * (ii*zi - vi);
|
Chris@16
|
337 vi *= as;
|
Chris@16
|
338 ii += 2;
|
Chris@16
|
339 i++;
|
Chris@16
|
340 } // while( true )
|
Chris@16
|
341
|
Chris@16
|
342 return val;
|
Chris@16
|
343 } // RealType owens_t_T3(const RealType h, const RealType a, const RealType ah)
|
Chris@16
|
344
|
Chris@16
|
345 template<class RealType, class Policy>
|
Chris@16
|
346 inline RealType owens_t_T3(const RealType h, const RealType a, const RealType ah, const Policy&)
|
Chris@16
|
347 {
|
Chris@16
|
348 typedef typename policies::precision<RealType, Policy>::type precision_type;
|
Chris@16
|
349 typedef typename mpl::if_<
|
Chris@16
|
350 mpl::or_<
|
Chris@16
|
351 mpl::less_equal<precision_type, mpl::int_<0> >,
|
Chris@16
|
352 mpl::greater<precision_type, mpl::int_<53> >
|
Chris@16
|
353 >,
|
Chris@16
|
354 mpl::int_<64>,
|
Chris@16
|
355 mpl::int_<53>
|
Chris@16
|
356 >::type tag_type;
|
Chris@16
|
357
|
Chris@16
|
358 return owens_t_T3_imp(h, a, ah, tag_type());
|
Chris@16
|
359 }
|
Chris@16
|
360
|
Chris@16
|
361 // compute the value of Owen's T function with method T4 from the reference paper
|
Chris@16
|
362 template<typename RealType>
|
Chris@16
|
363 inline RealType owens_t_T4(const RealType h, const RealType a, const unsigned short m)
|
Chris@16
|
364 {
|
Chris@16
|
365 BOOST_MATH_STD_USING
|
Chris@16
|
366 using namespace boost::math::constants;
|
Chris@16
|
367
|
Chris@16
|
368 const unsigned short maxii = m+m+1;
|
Chris@16
|
369 const RealType hs = h*h;
|
Chris@16
|
370 const RealType as = -a*a;
|
Chris@16
|
371
|
Chris@16
|
372 unsigned short ii = 1;
|
Chris@16
|
373 RealType ai = a * exp( -hs*(static_cast<RealType>(1)-as)*half<RealType>() ) * one_div_two_pi<RealType>();
|
Chris@16
|
374 RealType yi = 1;
|
Chris@16
|
375 RealType val = 0;
|
Chris@16
|
376
|
Chris@16
|
377 while( true )
|
Chris@16
|
378 {
|
Chris@16
|
379 val += ai*yi;
|
Chris@16
|
380 if( maxii <= ii )
|
Chris@16
|
381 break;
|
Chris@16
|
382 ii += 2;
|
Chris@16
|
383 yi = (static_cast<RealType>(1)-hs*yi) / static_cast<RealType>(ii);
|
Chris@16
|
384 ai *= as;
|
Chris@16
|
385 } // while( true )
|
Chris@16
|
386
|
Chris@16
|
387 return val;
|
Chris@16
|
388 } // RealType owens_t_T4(const RealType h, const RealType a, const unsigned short m)
|
Chris@16
|
389
|
Chris@16
|
390 // compute the value of Owen's T function with method T5 from the reference paper
|
Chris@16
|
391 template<typename RealType>
|
Chris@16
|
392 inline RealType owens_t_T5_imp(const RealType h, const RealType a, const mpl::int_<53>&)
|
Chris@16
|
393 {
|
Chris@16
|
394 BOOST_MATH_STD_USING
|
Chris@16
|
395 /*
|
Chris@16
|
396 NOTICE:
|
Chris@16
|
397 - The pts[] array contains the squares (!) of the abscissas, i.e. the roots of the Legendre
|
Chris@16
|
398 polynomial P_n(x), instead of the plain roots as required in Gauss-Legendre
|
Chris@16
|
399 quadrature, because T5(h,a,m) contains only x^2 terms.
|
Chris@16
|
400 - The wts[] array contains the weights for Gauss-Legendre quadrature scaled with a factor
|
Chris@16
|
401 of 1/(2*pi) according to T5(h,a,m).
|
Chris@16
|
402 */
|
Chris@16
|
403
|
Chris@16
|
404 const unsigned short m = 13;
|
Chris@16
|
405 static const RealType pts[] = {0.35082039676451715489E-02,
|
Chris@16
|
406 0.31279042338030753740E-01, 0.85266826283219451090E-01,
|
Chris@16
|
407 0.16245071730812277011, 0.25851196049125434828,
|
Chris@16
|
408 0.36807553840697533536, 0.48501092905604697475,
|
Chris@16
|
409 0.60277514152618576821, 0.71477884217753226516,
|
Chris@16
|
410 0.81475510988760098605, 0.89711029755948965867,
|
Chris@16
|
411 0.95723808085944261843, 0.99178832974629703586};
|
Chris@16
|
412 static const RealType wts[] = { 0.18831438115323502887E-01,
|
Chris@16
|
413 0.18567086243977649478E-01, 0.18042093461223385584E-01,
|
Chris@16
|
414 0.17263829606398753364E-01, 0.16243219975989856730E-01,
|
Chris@16
|
415 0.14994592034116704829E-01, 0.13535474469662088392E-01,
|
Chris@16
|
416 0.11886351605820165233E-01, 0.10070377242777431897E-01,
|
Chris@16
|
417 0.81130545742299586629E-02, 0.60419009528470238773E-02,
|
Chris@16
|
418 0.38862217010742057883E-02, 0.16793031084546090448E-02};
|
Chris@16
|
419
|
Chris@16
|
420 const RealType as = a*a;
|
Chris@16
|
421 const RealType hs = -h*h*boost::math::constants::half<RealType>();
|
Chris@16
|
422
|
Chris@16
|
423 RealType val = 0;
|
Chris@16
|
424 for(unsigned short i = 0; i < m; ++i)
|
Chris@16
|
425 {
|
Chris@16
|
426 BOOST_ASSERT(i < 13);
|
Chris@16
|
427 const RealType r = static_cast<RealType>(1) + as*pts[i];
|
Chris@16
|
428 val += wts[i] * exp( hs*r ) / r;
|
Chris@16
|
429 } // for(unsigned short i = 0; i < m; ++i)
|
Chris@16
|
430
|
Chris@16
|
431 return val*a;
|
Chris@16
|
432 } // RealType owens_t_T5(const RealType h, const RealType a)
|
Chris@16
|
433
|
Chris@16
|
434 // compute the value of Owen's T function with method T5 from the reference paper
|
Chris@16
|
435 template<typename RealType>
|
Chris@16
|
436 inline RealType owens_t_T5_imp(const RealType h, const RealType a, const mpl::int_<64>&)
|
Chris@16
|
437 {
|
Chris@16
|
438 BOOST_MATH_STD_USING
|
Chris@16
|
439 /*
|
Chris@16
|
440 NOTICE:
|
Chris@16
|
441 - The pts[] array contains the squares (!) of the abscissas, i.e. the roots of the Legendre
|
Chris@16
|
442 polynomial P_n(x), instead of the plain roots as required in Gauss-Legendre
|
Chris@16
|
443 quadrature, because T5(h,a,m) contains only x^2 terms.
|
Chris@16
|
444 - The wts[] array contains the weights for Gauss-Legendre quadrature scaled with a factor
|
Chris@16
|
445 of 1/(2*pi) according to T5(h,a,m).
|
Chris@16
|
446 */
|
Chris@16
|
447
|
Chris@16
|
448 const unsigned short m = 19;
|
Chris@16
|
449 static const RealType pts[] = {
|
Chris@16
|
450 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0016634282895983227941),
|
Chris@16
|
451 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.014904509242697054183),
|
Chris@16
|
452 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.04103478879005817919),
|
Chris@16
|
453 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.079359853513391511008),
|
Chris@16
|
454 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.1288612130237615133),
|
Chris@16
|
455 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.18822336642448518856),
|
Chris@16
|
456 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.25586876186122962384),
|
Chris@16
|
457 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.32999972011807857222),
|
Chris@16
|
458 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.40864620815774761438),
|
Chris@16
|
459 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.48971819306044782365),
|
Chris@16
|
460 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.57106118513245543894),
|
Chris@16
|
461 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.6505134942981533829),
|
Chris@16
|
462 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.72596367859928091618),
|
Chris@16
|
463 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.79540665919549865924),
|
Chris@16
|
464 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.85699701386308739244),
|
Chris@16
|
465 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.90909804422384697594),
|
Chris@16
|
466 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.95032536436570154409),
|
Chris@16
|
467 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.97958418733152273717),
|
Chris@16
|
468 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.99610366384229088321)
|
Chris@16
|
469 };
|
Chris@16
|
470 static const RealType wts[] = {
|
Chris@16
|
471 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.012975111395684900835),
|
Chris@16
|
472 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.012888764187499150078),
|
Chris@16
|
473 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.012716644398857307844),
|
Chris@16
|
474 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.012459897461364705691),
|
Chris@16
|
475 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.012120231988292330388),
|
Chris@16
|
476 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.011699908404856841158),
|
Chris@16
|
477 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.011201723906897224448),
|
Chris@16
|
478 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.010628993848522759853),
|
Chris@16
|
479 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0099855296835573320047),
|
Chris@16
|
480 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0092756136096132857933),
|
Chris@16
|
481 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0085039700881139589055),
|
Chris@16
|
482 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0076757344408814561254),
|
Chris@16
|
483 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0067964187616556459109),
|
Chris@16
|
484 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.005871875456524750363),
|
Chris@16
|
485 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0049082589542498110071),
|
Chris@16
|
486 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0039119870792519721409),
|
Chris@16
|
487 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0028897090921170700834),
|
Chris@16
|
488 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.0018483371329504443947),
|
Chris@16
|
489 BOOST_MATH_BIG_CONSTANT(RealType, 64, 0.00079623320100438873578)
|
Chris@16
|
490 };
|
Chris@16
|
491
|
Chris@16
|
492 const RealType as = a*a;
|
Chris@16
|
493 const RealType hs = -h*h*boost::math::constants::half<RealType>();
|
Chris@16
|
494
|
Chris@16
|
495 RealType val = 0;
|
Chris@16
|
496 for(unsigned short i = 0; i < m; ++i)
|
Chris@16
|
497 {
|
Chris@16
|
498 BOOST_ASSERT(i < 19);
|
Chris@16
|
499 const RealType r = 1 + as*pts[i];
|
Chris@16
|
500 val += wts[i] * exp( hs*r ) / r;
|
Chris@16
|
501 } // for(unsigned short i = 0; i < m; ++i)
|
Chris@16
|
502
|
Chris@16
|
503 return val*a;
|
Chris@16
|
504 } // RealType owens_t_T5(const RealType h, const RealType a)
|
Chris@16
|
505
|
Chris@16
|
506 template<class RealType, class Policy>
|
Chris@16
|
507 inline RealType owens_t_T5(const RealType h, const RealType a, const Policy&)
|
Chris@16
|
508 {
|
Chris@16
|
509 typedef typename policies::precision<RealType, Policy>::type precision_type;
|
Chris@16
|
510 typedef typename mpl::if_<
|
Chris@16
|
511 mpl::or_<
|
Chris@16
|
512 mpl::less_equal<precision_type, mpl::int_<0> >,
|
Chris@16
|
513 mpl::greater<precision_type, mpl::int_<53> >
|
Chris@16
|
514 >,
|
Chris@16
|
515 mpl::int_<64>,
|
Chris@16
|
516 mpl::int_<53>
|
Chris@16
|
517 >::type tag_type;
|
Chris@16
|
518
|
Chris@16
|
519 return owens_t_T5_imp(h, a, tag_type());
|
Chris@16
|
520 }
|
Chris@16
|
521
|
Chris@16
|
522
|
Chris@16
|
523 // compute the value of Owen's T function with method T6 from the reference paper
|
Chris@16
|
524 template<typename RealType>
|
Chris@16
|
525 inline RealType owens_t_T6(const RealType h, const RealType a)
|
Chris@16
|
526 {
|
Chris@16
|
527 BOOST_MATH_STD_USING
|
Chris@16
|
528 using namespace boost::math::constants;
|
Chris@16
|
529
|
Chris@16
|
530 const RealType normh = owens_t_znorm2( h );
|
Chris@16
|
531 const RealType y = static_cast<RealType>(1) - a;
|
Chris@16
|
532 const RealType r = atan2(y, static_cast<RealType>(1 + a) );
|
Chris@16
|
533
|
Chris@16
|
534 RealType val = normh * ( static_cast<RealType>(1) - normh ) * half<RealType>();
|
Chris@16
|
535
|
Chris@16
|
536 if( r != 0 )
|
Chris@16
|
537 val -= r * exp( -y*h*h*half<RealType>()/r ) * one_div_two_pi<RealType>();
|
Chris@16
|
538
|
Chris@16
|
539 return val;
|
Chris@16
|
540 } // RealType owens_t_T6(const RealType h, const RealType a, const unsigned short m)
|
Chris@16
|
541
|
Chris@16
|
542 template <class T, class Policy>
|
Chris@16
|
543 std::pair<T, T> owens_t_T1_accelerated(T h, T a, const Policy& pol)
|
Chris@16
|
544 {
|
Chris@16
|
545 //
|
Chris@16
|
546 // This is the same series as T1, but:
|
Chris@16
|
547 // * The Taylor series for atan has been combined with that for T1,
|
Chris@16
|
548 // reducing but not eliminating cancellation error.
|
Chris@16
|
549 // * The resulting alternating series is then accelerated using method 1
|
Chris@16
|
550 // from H. Cohen, F. Rodriguez Villegas, D. Zagier,
|
Chris@16
|
551 // "Convergence acceleration of alternating series", Bonn, (1991).
|
Chris@16
|
552 //
|
Chris@16
|
553 BOOST_MATH_STD_USING
|
Chris@16
|
554 static const char* function = "boost::math::owens_t<%1%>(%1%, %1%)";
|
Chris@16
|
555 T half_h_h = h * h / 2;
|
Chris@16
|
556 T a_pow = a;
|
Chris@16
|
557 T aa = a * a;
|
Chris@16
|
558 T exp_term = exp(-h * h / 2);
|
Chris@16
|
559 T one_minus_dj_sum = exp_term;
|
Chris@16
|
560 T sum = a_pow * exp_term;
|
Chris@16
|
561 T dj_pow = exp_term;
|
Chris@16
|
562 T term = sum;
|
Chris@16
|
563 T abs_err;
|
Chris@16
|
564 int j = 1;
|
Chris@16
|
565
|
Chris@16
|
566 //
|
Chris@16
|
567 // Normally with this form of series acceleration we can calculate
|
Chris@16
|
568 // up front how many terms will be required - based on the assumption
|
Chris@16
|
569 // that each term decreases in size by a factor of 3. However,
|
Chris@16
|
570 // that assumption does not apply here, as the underlying T1 series can
|
Chris@16
|
571 // go quite strongly divergent in the early terms, before strongly
|
Chris@16
|
572 // converging later. Various "guestimates" have been tried to take account
|
Chris@16
|
573 // of this, but they don't always work.... so instead set "n" to the
|
Chris@16
|
574 // largest value that won't cause overflow later, and abort iteration
|
Chris@16
|
575 // when the last accelerated term was small enough...
|
Chris@16
|
576 //
|
Chris@16
|
577 int n;
|
Chris@16
|
578 try
|
Chris@16
|
579 {
|
Chris@16
|
580 n = itrunc(T(tools::log_max_value<T>() / 6));
|
Chris@16
|
581 }
|
Chris@16
|
582 catch(...)
|
Chris@16
|
583 {
|
Chris@16
|
584 n = (std::numeric_limits<int>::max)();
|
Chris@16
|
585 }
|
Chris@16
|
586 n = (std::min)(n, 1500);
|
Chris@16
|
587 T d = pow(3 + sqrt(T(8)), n);
|
Chris@16
|
588 d = (d + 1 / d) / 2;
|
Chris@16
|
589 T b = -1;
|
Chris@16
|
590 T c = -d;
|
Chris@16
|
591 c = b - c;
|
Chris@16
|
592 sum *= c;
|
Chris@16
|
593 b = -n * n * b * 2;
|
Chris@16
|
594 abs_err = ldexp(fabs(sum), -tools::digits<T>());
|
Chris@16
|
595
|
Chris@16
|
596 while(j < n)
|
Chris@16
|
597 {
|
Chris@16
|
598 a_pow *= aa;
|
Chris@16
|
599 dj_pow *= half_h_h / j;
|
Chris@16
|
600 one_minus_dj_sum += dj_pow;
|
Chris@16
|
601 term = one_minus_dj_sum * a_pow / (2 * j + 1);
|
Chris@16
|
602 c = b - c;
|
Chris@16
|
603 sum += c * term;
|
Chris@16
|
604 abs_err += ldexp((std::max)(T(fabs(sum)), T(fabs(c*term))), -tools::digits<T>());
|
Chris@16
|
605 b = (j + n) * (j - n) * b / ((j + T(0.5)) * (j + 1));
|
Chris@16
|
606 ++j;
|
Chris@16
|
607 //
|
Chris@16
|
608 // Include an escape route to prevent calculating too many terms:
|
Chris@16
|
609 //
|
Chris@16
|
610 if((j > 10) && (fabs(sum * tools::epsilon<T>()) > fabs(c * term)))
|
Chris@16
|
611 break;
|
Chris@16
|
612 }
|
Chris@16
|
613 abs_err += fabs(c * term);
|
Chris@16
|
614 if(sum < 0) // sum must always be positive, if it's negative something really bad has happend:
|
Chris@16
|
615 policies::raise_evaluation_error(function, 0, T(0), pol);
|
Chris@16
|
616 return std::pair<T, T>((sum / d) / boost::math::constants::two_pi<T>(), abs_err / sum);
|
Chris@16
|
617 }
|
Chris@16
|
618
|
Chris@16
|
619 template<typename RealType, class Policy>
|
Chris@16
|
620 inline RealType owens_t_T2(const RealType h, const RealType a, const unsigned short m, const RealType ah, const Policy&, const mpl::true_&)
|
Chris@16
|
621 {
|
Chris@16
|
622 BOOST_MATH_STD_USING
|
Chris@16
|
623 using namespace boost::math::constants;
|
Chris@16
|
624
|
Chris@16
|
625 const unsigned short maxii = m+m+1;
|
Chris@16
|
626 const RealType hs = h*h;
|
Chris@16
|
627 const RealType as = -a*a;
|
Chris@16
|
628 const RealType y = static_cast<RealType>(1) / hs;
|
Chris@16
|
629
|
Chris@16
|
630 unsigned short ii = 1;
|
Chris@16
|
631 RealType val = 0;
|
Chris@16
|
632 RealType vi = a * exp( -ah*ah*half<RealType>() ) / root_two_pi<RealType>();
|
Chris@16
|
633 RealType z = owens_t_znorm1(ah)/h;
|
Chris@16
|
634 RealType last_z = fabs(z);
|
Chris@16
|
635 RealType lim = policies::get_epsilon<RealType, Policy>();
|
Chris@16
|
636
|
Chris@16
|
637 while( true )
|
Chris@16
|
638 {
|
Chris@16
|
639 val += z;
|
Chris@16
|
640 //
|
Chris@16
|
641 // This series stops converging after a while, so put a limit
|
Chris@16
|
642 // on how far we go before returning our best guess:
|
Chris@16
|
643 //
|
Chris@16
|
644 if((fabs(lim * val) > fabs(z)) || ((ii > maxii) && (fabs(z) > last_z)) || (z == 0))
|
Chris@16
|
645 {
|
Chris@16
|
646 val *= exp( -hs*half<RealType>() ) / root_two_pi<RealType>();
|
Chris@16
|
647 break;
|
Chris@16
|
648 } // if( maxii <= ii )
|
Chris@16
|
649 last_z = fabs(z);
|
Chris@16
|
650 z = y * ( vi - static_cast<RealType>(ii) * z );
|
Chris@16
|
651 vi *= as;
|
Chris@16
|
652 ii += 2;
|
Chris@16
|
653 } // while( true )
|
Chris@16
|
654
|
Chris@16
|
655 return val;
|
Chris@16
|
656 } // RealType owens_t_T2(const RealType h, const RealType a, const unsigned short m, const RealType ah)
|
Chris@16
|
657
|
Chris@16
|
658 template<typename RealType, class Policy>
|
Chris@16
|
659 inline std::pair<RealType, RealType> owens_t_T2_accelerated(const RealType h, const RealType a, const RealType ah, const Policy&)
|
Chris@16
|
660 {
|
Chris@16
|
661 //
|
Chris@16
|
662 // This is the same series as T2, but with acceleration applied.
|
Chris@16
|
663 // Note that we have to be *very* careful to check that nothing bad
|
Chris@16
|
664 // has happened during evaluation - this series will go divergent
|
Chris@16
|
665 // and/or fail to alternate at a drop of a hat! :-(
|
Chris@16
|
666 //
|
Chris@16
|
667 BOOST_MATH_STD_USING
|
Chris@16
|
668 using namespace boost::math::constants;
|
Chris@16
|
669
|
Chris@16
|
670 const RealType hs = h*h;
|
Chris@16
|
671 const RealType as = -a*a;
|
Chris@16
|
672 const RealType y = static_cast<RealType>(1) / hs;
|
Chris@16
|
673
|
Chris@16
|
674 unsigned short ii = 1;
|
Chris@16
|
675 RealType val = 0;
|
Chris@16
|
676 RealType vi = a * exp( -ah*ah*half<RealType>() ) / root_two_pi<RealType>();
|
Chris@16
|
677 RealType z = boost::math::detail::owens_t_znorm1(ah)/h;
|
Chris@16
|
678 RealType last_z = fabs(z);
|
Chris@16
|
679
|
Chris@16
|
680 //
|
Chris@16
|
681 // Normally with this form of series acceleration we can calculate
|
Chris@16
|
682 // up front how many terms will be required - based on the assumption
|
Chris@16
|
683 // that each term decreases in size by a factor of 3. However,
|
Chris@16
|
684 // that assumption does not apply here, as the underlying T1 series can
|
Chris@16
|
685 // go quite strongly divergent in the early terms, before strongly
|
Chris@16
|
686 // converging later. Various "guestimates" have been tried to take account
|
Chris@16
|
687 // of this, but they don't always work.... so instead set "n" to the
|
Chris@16
|
688 // largest value that won't cause overflow later, and abort iteration
|
Chris@16
|
689 // when the last accelerated term was small enough...
|
Chris@16
|
690 //
|
Chris@16
|
691 int n;
|
Chris@16
|
692 try
|
Chris@16
|
693 {
|
Chris@16
|
694 n = itrunc(RealType(tools::log_max_value<RealType>() / 6));
|
Chris@16
|
695 }
|
Chris@16
|
696 catch(...)
|
Chris@16
|
697 {
|
Chris@16
|
698 n = (std::numeric_limits<int>::max)();
|
Chris@16
|
699 }
|
Chris@16
|
700 n = (std::min)(n, 1500);
|
Chris@16
|
701 RealType d = pow(3 + sqrt(RealType(8)), n);
|
Chris@16
|
702 d = (d + 1 / d) / 2;
|
Chris@16
|
703 RealType b = -1;
|
Chris@16
|
704 RealType c = -d;
|
Chris@16
|
705 int s = 1;
|
Chris@16
|
706
|
Chris@16
|
707 for(int k = 0; k < n; ++k)
|
Chris@16
|
708 {
|
Chris@16
|
709 //
|
Chris@16
|
710 // Check for both convergence and whether the series has gone bad:
|
Chris@16
|
711 //
|
Chris@16
|
712 if(
|
Chris@16
|
713 (fabs(z) > last_z) // Series has gone divergent, abort
|
Chris@16
|
714 || (fabs(val) * tools::epsilon<RealType>() > fabs(c * s * z)) // Convergence!
|
Chris@16
|
715 || (z * s < 0) // Series has stopped alternating - all bets are off - abort.
|
Chris@16
|
716 )
|
Chris@16
|
717 {
|
Chris@16
|
718 break;
|
Chris@16
|
719 }
|
Chris@16
|
720 c = b - c;
|
Chris@16
|
721 val += c * s * z;
|
Chris@16
|
722 b = (k + n) * (k - n) * b / ((k + RealType(0.5)) * (k + 1));
|
Chris@16
|
723 last_z = fabs(z);
|
Chris@16
|
724 s = -s;
|
Chris@16
|
725 z = y * ( vi - static_cast<RealType>(ii) * z );
|
Chris@16
|
726 vi *= as;
|
Chris@16
|
727 ii += 2;
|
Chris@16
|
728 } // while( true )
|
Chris@16
|
729 RealType err = fabs(c * z) / val;
|
Chris@16
|
730 return std::pair<RealType, RealType>(val * exp( -hs*half<RealType>() ) / (d * root_two_pi<RealType>()), err);
|
Chris@16
|
731 } // RealType owens_t_T2_accelerated(const RealType h, const RealType a, const RealType ah, const Policy&)
|
Chris@16
|
732
|
Chris@16
|
733 template<typename RealType, typename Policy>
|
Chris@16
|
734 inline RealType T4_mp(const RealType h, const RealType a, const Policy& pol)
|
Chris@16
|
735 {
|
Chris@16
|
736 BOOST_MATH_STD_USING
|
Chris@16
|
737
|
Chris@16
|
738 const RealType hs = h*h;
|
Chris@16
|
739 const RealType as = -a*a;
|
Chris@16
|
740
|
Chris@16
|
741 unsigned short ii = 1;
|
Chris@16
|
742 RealType ai = constants::one_div_two_pi<RealType>() * a * exp( -0.5*hs*(1.0-as) );
|
Chris@16
|
743 RealType yi = 1.0;
|
Chris@16
|
744 RealType val = 0.0;
|
Chris@16
|
745
|
Chris@16
|
746 RealType lim = boost::math::policies::get_epsilon<RealType, Policy>();
|
Chris@16
|
747
|
Chris@16
|
748 while( true )
|
Chris@16
|
749 {
|
Chris@16
|
750 RealType term = ai*yi;
|
Chris@16
|
751 val += term;
|
Chris@16
|
752 if((yi != 0) && (fabs(val * lim) > fabs(term)))
|
Chris@16
|
753 break;
|
Chris@16
|
754 ii += 2;
|
Chris@16
|
755 yi = (1.0-hs*yi) / static_cast<RealType>(ii);
|
Chris@16
|
756 ai *= as;
|
Chris@16
|
757 if(ii > (std::min)(1500, (int)policies::get_max_series_iterations<Policy>()))
|
Chris@16
|
758 policies::raise_evaluation_error("boost::math::owens_t<%1%>", 0, val, pol);
|
Chris@16
|
759 } // while( true )
|
Chris@16
|
760
|
Chris@16
|
761 return val;
|
Chris@16
|
762 } // arg_type owens_t_T4(const arg_type h, const arg_type a, const unsigned short m)
|
Chris@16
|
763
|
Chris@16
|
764
|
Chris@16
|
765 // This routine dispatches the call to one of six subroutines, depending on the values
|
Chris@16
|
766 // of h and a.
|
Chris@16
|
767 // preconditions: h >= 0, 0<=a<=1, ah=a*h
|
Chris@16
|
768 //
|
Chris@16
|
769 // Note there are different versions for different precisions....
|
Chris@16
|
770 template<typename RealType, typename Policy>
|
Chris@16
|
771 inline RealType owens_t_dispatch(const RealType h, const RealType a, const RealType ah, const Policy& pol, mpl::int_<64> const&)
|
Chris@16
|
772 {
|
Chris@16
|
773 // Simple main case for 64-bit precision or less, this is as per the Patefield-Tandy paper:
|
Chris@16
|
774 BOOST_MATH_STD_USING
|
Chris@16
|
775 //
|
Chris@16
|
776 // Handle some special cases first, these are from
|
Chris@16
|
777 // page 1077 of Owen's original paper:
|
Chris@16
|
778 //
|
Chris@16
|
779 if(h == 0)
|
Chris@16
|
780 {
|
Chris@16
|
781 return atan(a) * constants::one_div_two_pi<RealType>();
|
Chris@16
|
782 }
|
Chris@16
|
783 if(a == 0)
|
Chris@16
|
784 {
|
Chris@16
|
785 return 0;
|
Chris@16
|
786 }
|
Chris@16
|
787 if(a == 1)
|
Chris@16
|
788 {
|
Chris@16
|
789 return owens_t_znorm2(RealType(-h)) * owens_t_znorm2(h) / 2;
|
Chris@16
|
790 }
|
Chris@16
|
791 if(a >= tools::max_value<RealType>())
|
Chris@16
|
792 {
|
Chris@16
|
793 return owens_t_znorm2(RealType(fabs(h)));
|
Chris@16
|
794 }
|
Chris@16
|
795 RealType val = 0; // avoid compiler warnings, 0 will be overwritten in any case
|
Chris@16
|
796 const unsigned short icode = owens_t_compute_code(h, a);
|
Chris@16
|
797 const unsigned short m = owens_t_get_order(icode, val /* just a dummy for the type */, pol);
|
Chris@16
|
798 static const unsigned short meth[] = {1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6}; // 18 entries
|
Chris@16
|
799
|
Chris@16
|
800 // determine the appropriate method, T1 ... T6
|
Chris@16
|
801 switch( meth[icode] )
|
Chris@16
|
802 {
|
Chris@16
|
803 case 1: // T1
|
Chris@101
|
804 val = owens_t_T1(h,a,m,pol);
|
Chris@16
|
805 break;
|
Chris@16
|
806 case 2: // T2
|
Chris@16
|
807 typedef typename policies::precision<RealType, Policy>::type precision_type;
|
Chris@16
|
808 typedef mpl::bool_<(precision_type::value == 0) || (precision_type::value > 64)> tag_type;
|
Chris@16
|
809 val = owens_t_T2(h, a, m, ah, pol, tag_type());
|
Chris@16
|
810 break;
|
Chris@16
|
811 case 3: // T3
|
Chris@16
|
812 val = owens_t_T3(h,a,ah, pol);
|
Chris@16
|
813 break;
|
Chris@16
|
814 case 4: // T4
|
Chris@16
|
815 val = owens_t_T4(h,a,m);
|
Chris@16
|
816 break;
|
Chris@16
|
817 case 5: // T5
|
Chris@16
|
818 val = owens_t_T5(h,a, pol);
|
Chris@16
|
819 break;
|
Chris@16
|
820 case 6: // T6
|
Chris@16
|
821 val = owens_t_T6(h,a);
|
Chris@16
|
822 break;
|
Chris@16
|
823 default:
|
Chris@16
|
824 BOOST_THROW_EXCEPTION(std::logic_error("selection routine in Owen's T function failed"));
|
Chris@16
|
825 }
|
Chris@16
|
826 return val;
|
Chris@16
|
827 }
|
Chris@16
|
828
|
Chris@16
|
829 template<typename RealType, typename Policy>
|
Chris@16
|
830 inline RealType owens_t_dispatch(const RealType h, const RealType a, const RealType ah, const Policy& pol, const mpl::int_<65>&)
|
Chris@16
|
831 {
|
Chris@16
|
832 // Arbitrary precision version:
|
Chris@16
|
833 BOOST_MATH_STD_USING
|
Chris@16
|
834 //
|
Chris@16
|
835 // Handle some special cases first, these are from
|
Chris@16
|
836 // page 1077 of Owen's original paper:
|
Chris@16
|
837 //
|
Chris@16
|
838 if(h == 0)
|
Chris@16
|
839 {
|
Chris@16
|
840 return atan(a) * constants::one_div_two_pi<RealType>();
|
Chris@16
|
841 }
|
Chris@16
|
842 if(a == 0)
|
Chris@16
|
843 {
|
Chris@16
|
844 return 0;
|
Chris@16
|
845 }
|
Chris@16
|
846 if(a == 1)
|
Chris@16
|
847 {
|
Chris@16
|
848 return owens_t_znorm2(RealType(-h)) * owens_t_znorm2(h) / 2;
|
Chris@16
|
849 }
|
Chris@16
|
850 if(a >= tools::max_value<RealType>())
|
Chris@16
|
851 {
|
Chris@16
|
852 return owens_t_znorm2(RealType(fabs(h)));
|
Chris@16
|
853 }
|
Chris@16
|
854 // Attempt arbitrary precision code, this will throw if it goes wrong:
|
Chris@16
|
855 typedef typename boost::math::policies::normalise<Policy, boost::math::policies::evaluation_error<> >::type forwarding_policy;
|
Chris@16
|
856 std::pair<RealType, RealType> p1(0, tools::max_value<RealType>()), p2(0, tools::max_value<RealType>());
|
Chris@16
|
857 RealType target_precision = policies::get_epsilon<RealType, Policy>() * 1000;
|
Chris@16
|
858 bool have_t1(false), have_t2(false);
|
Chris@16
|
859 if(ah < 3)
|
Chris@16
|
860 {
|
Chris@16
|
861 try
|
Chris@16
|
862 {
|
Chris@16
|
863 have_t1 = true;
|
Chris@16
|
864 p1 = owens_t_T1_accelerated(h, a, forwarding_policy());
|
Chris@16
|
865 if(p1.second < target_precision)
|
Chris@16
|
866 return p1.first;
|
Chris@16
|
867 }
|
Chris@16
|
868 catch(const boost::math::evaluation_error&){} // T1 may fail and throw, that's OK
|
Chris@16
|
869 }
|
Chris@16
|
870 if(ah > 1)
|
Chris@16
|
871 {
|
Chris@16
|
872 try
|
Chris@16
|
873 {
|
Chris@16
|
874 have_t2 = true;
|
Chris@16
|
875 p2 = owens_t_T2_accelerated(h, a, ah, forwarding_policy());
|
Chris@16
|
876 if(p2.second < target_precision)
|
Chris@16
|
877 return p2.first;
|
Chris@16
|
878 }
|
Chris@16
|
879 catch(const boost::math::evaluation_error&){} // T2 may fail and throw, that's OK
|
Chris@16
|
880 }
|
Chris@16
|
881 //
|
Chris@16
|
882 // If we haven't tried T1 yet, do it now - sometimes it succeeds and the number of iterations
|
Chris@16
|
883 // is fairly low compared to T4.
|
Chris@16
|
884 //
|
Chris@16
|
885 if(!have_t1)
|
Chris@16
|
886 {
|
Chris@16
|
887 try
|
Chris@16
|
888 {
|
Chris@16
|
889 have_t1 = true;
|
Chris@16
|
890 p1 = owens_t_T1_accelerated(h, a, forwarding_policy());
|
Chris@16
|
891 if(p1.second < target_precision)
|
Chris@16
|
892 return p1.first;
|
Chris@16
|
893 }
|
Chris@16
|
894 catch(const boost::math::evaluation_error&){} // T1 may fail and throw, that's OK
|
Chris@16
|
895 }
|
Chris@16
|
896 //
|
Chris@16
|
897 // If we haven't tried T2 yet, do it now - sometimes it succeeds and the number of iterations
|
Chris@16
|
898 // is fairly low compared to T4.
|
Chris@16
|
899 //
|
Chris@16
|
900 if(!have_t2)
|
Chris@16
|
901 {
|
Chris@16
|
902 try
|
Chris@16
|
903 {
|
Chris@16
|
904 have_t2 = true;
|
Chris@16
|
905 p2 = owens_t_T2_accelerated(h, a, ah, forwarding_policy());
|
Chris@16
|
906 if(p2.second < target_precision)
|
Chris@16
|
907 return p2.first;
|
Chris@16
|
908 }
|
Chris@16
|
909 catch(const boost::math::evaluation_error&){} // T2 may fail and throw, that's OK
|
Chris@16
|
910 }
|
Chris@16
|
911 //
|
Chris@16
|
912 // OK, nothing left to do but try the most expensive option which is T4,
|
Chris@16
|
913 // this is often slow to converge, but when it does converge it tends to
|
Chris@16
|
914 // be accurate:
|
Chris@16
|
915 try
|
Chris@16
|
916 {
|
Chris@16
|
917 return T4_mp(h, a, pol);
|
Chris@16
|
918 }
|
Chris@16
|
919 catch(const boost::math::evaluation_error&){} // T4 may fail and throw, that's OK
|
Chris@16
|
920 //
|
Chris@16
|
921 // Now look back at the results from T1 and T2 and see if either gave better
|
Chris@16
|
922 // results than we could get from the 64-bit precision versions.
|
Chris@16
|
923 //
|
Chris@16
|
924 if((std::min)(p1.second, p2.second) < 1e-20)
|
Chris@16
|
925 {
|
Chris@16
|
926 return p1.second < p2.second ? p1.first : p2.first;
|
Chris@16
|
927 }
|
Chris@16
|
928 //
|
Chris@16
|
929 // We give up - no arbitrary precision versions succeeded!
|
Chris@16
|
930 //
|
Chris@16
|
931 return owens_t_dispatch(h, a, ah, pol, mpl::int_<64>());
|
Chris@16
|
932 } // RealType owens_t_dispatch(RealType h, RealType a, RealType ah)
|
Chris@16
|
933 template<typename RealType, typename Policy>
|
Chris@16
|
934 inline RealType owens_t_dispatch(const RealType h, const RealType a, const RealType ah, const Policy& pol, const mpl::int_<0>&)
|
Chris@16
|
935 {
|
Chris@16
|
936 // We don't know what the precision is until runtime:
|
Chris@16
|
937 if(tools::digits<RealType>() <= 64)
|
Chris@16
|
938 return owens_t_dispatch(h, a, ah, pol, mpl::int_<64>());
|
Chris@16
|
939 return owens_t_dispatch(h, a, ah, pol, mpl::int_<65>());
|
Chris@16
|
940 }
|
Chris@16
|
941 template<typename RealType, typename Policy>
|
Chris@16
|
942 inline RealType owens_t_dispatch(const RealType h, const RealType a, const RealType ah, const Policy& pol)
|
Chris@16
|
943 {
|
Chris@16
|
944 // Figure out the precision and forward to the correct version:
|
Chris@16
|
945 typedef typename policies::precision<RealType, Policy>::type precision_type;
|
Chris@16
|
946 typedef typename mpl::if_c<
|
Chris@16
|
947 precision_type::value == 0,
|
Chris@16
|
948 mpl::int_<0>,
|
Chris@16
|
949 typename mpl::if_c<
|
Chris@16
|
950 precision_type::value <= 64,
|
Chris@16
|
951 mpl::int_<64>,
|
Chris@16
|
952 mpl::int_<65>
|
Chris@16
|
953 >::type
|
Chris@16
|
954 >::type tag_type;
|
Chris@16
|
955 return owens_t_dispatch(h, a, ah, pol, tag_type());
|
Chris@16
|
956 }
|
Chris@16
|
957 // compute Owen's T function, T(h,a), for arbitrary values of h and a
|
Chris@16
|
958 template<typename RealType, class Policy>
|
Chris@16
|
959 inline RealType owens_t(RealType h, RealType a, const Policy& pol)
|
Chris@16
|
960 {
|
Chris@16
|
961 BOOST_MATH_STD_USING
|
Chris@16
|
962 // exploit that T(-h,a) == T(h,a)
|
Chris@16
|
963 h = fabs(h);
|
Chris@16
|
964
|
Chris@16
|
965 // Use equation (2) in the paper to remap the arguments
|
Chris@16
|
966 // such that h>=0 and 0<=a<=1 for the call of the actual
|
Chris@16
|
967 // computation routine.
|
Chris@16
|
968
|
Chris@16
|
969 const RealType fabs_a = fabs(a);
|
Chris@16
|
970 const RealType fabs_ah = fabs_a*h;
|
Chris@16
|
971
|
Chris@16
|
972 RealType val = 0.0; // avoid compiler warnings, 0.0 will be overwritten in any case
|
Chris@16
|
973
|
Chris@16
|
974 if(fabs_a <= 1)
|
Chris@16
|
975 {
|
Chris@16
|
976 val = owens_t_dispatch(h, fabs_a, fabs_ah, pol);
|
Chris@16
|
977 } // if(fabs_a <= 1.0)
|
Chris@16
|
978 else
|
Chris@16
|
979 {
|
Chris@16
|
980 if( h <= 0.67 )
|
Chris@16
|
981 {
|
Chris@16
|
982 const RealType normh = owens_t_znorm1(h);
|
Chris@16
|
983 const RealType normah = owens_t_znorm1(fabs_ah);
|
Chris@16
|
984 val = static_cast<RealType>(1)/static_cast<RealType>(4) - normh*normah -
|
Chris@16
|
985 owens_t_dispatch(fabs_ah, static_cast<RealType>(1 / fabs_a), h, pol);
|
Chris@16
|
986 } // if( h <= 0.67 )
|
Chris@16
|
987 else
|
Chris@16
|
988 {
|
Chris@16
|
989 const RealType normh = detail::owens_t_znorm2(h);
|
Chris@16
|
990 const RealType normah = detail::owens_t_znorm2(fabs_ah);
|
Chris@16
|
991 val = constants::half<RealType>()*(normh+normah) - normh*normah -
|
Chris@16
|
992 owens_t_dispatch(fabs_ah, static_cast<RealType>(1 / fabs_a), h, pol);
|
Chris@16
|
993 } // else [if( h <= 0.67 )]
|
Chris@16
|
994 } // else [if(fabs_a <= 1)]
|
Chris@16
|
995
|
Chris@16
|
996 // exploit that T(h,-a) == -T(h,a)
|
Chris@16
|
997 if(a < 0)
|
Chris@16
|
998 {
|
Chris@16
|
999 return -val;
|
Chris@16
|
1000 } // if(a < 0)
|
Chris@16
|
1001
|
Chris@16
|
1002 return val;
|
Chris@16
|
1003 } // RealType owens_t(RealType h, RealType a)
|
Chris@16
|
1004
|
Chris@16
|
1005 template <class T, class Policy, class tag>
|
Chris@16
|
1006 struct owens_t_initializer
|
Chris@16
|
1007 {
|
Chris@16
|
1008 struct init
|
Chris@16
|
1009 {
|
Chris@16
|
1010 init()
|
Chris@16
|
1011 {
|
Chris@16
|
1012 do_init(tag());
|
Chris@16
|
1013 }
|
Chris@16
|
1014 template <int N>
|
Chris@16
|
1015 static void do_init(const mpl::int_<N>&){}
|
Chris@16
|
1016 static void do_init(const mpl::int_<64>&)
|
Chris@16
|
1017 {
|
Chris@16
|
1018 boost::math::owens_t(static_cast<T>(7), static_cast<T>(0.96875), Policy());
|
Chris@16
|
1019 boost::math::owens_t(static_cast<T>(2), static_cast<T>(0.5), Policy());
|
Chris@16
|
1020 }
|
Chris@16
|
1021 void force_instantiate()const{}
|
Chris@16
|
1022 };
|
Chris@16
|
1023 static const init initializer;
|
Chris@16
|
1024 static void force_instantiate()
|
Chris@16
|
1025 {
|
Chris@16
|
1026 initializer.force_instantiate();
|
Chris@16
|
1027 }
|
Chris@16
|
1028 };
|
Chris@16
|
1029
|
Chris@16
|
1030 template <class T, class Policy, class tag>
|
Chris@16
|
1031 const typename owens_t_initializer<T, Policy, tag>::init owens_t_initializer<T, Policy, tag>::initializer;
|
Chris@16
|
1032
|
Chris@16
|
1033 } // namespace detail
|
Chris@16
|
1034
|
Chris@16
|
1035 template <class T1, class T2, class Policy>
|
Chris@16
|
1036 inline typename tools::promote_args<T1, T2>::type owens_t(T1 h, T2 a, const Policy& pol)
|
Chris@16
|
1037 {
|
Chris@16
|
1038 typedef typename tools::promote_args<T1, T2>::type result_type;
|
Chris@16
|
1039 typedef typename policies::evaluation<result_type, Policy>::type value_type;
|
Chris@16
|
1040 typedef typename policies::precision<value_type, Policy>::type precision_type;
|
Chris@16
|
1041 typedef typename mpl::if_c<
|
Chris@16
|
1042 precision_type::value == 0,
|
Chris@16
|
1043 mpl::int_<0>,
|
Chris@16
|
1044 typename mpl::if_c<
|
Chris@16
|
1045 precision_type::value <= 64,
|
Chris@16
|
1046 mpl::int_<64>,
|
Chris@16
|
1047 mpl::int_<65>
|
Chris@16
|
1048 >::type
|
Chris@16
|
1049 >::type tag_type;
|
Chris@16
|
1050
|
Chris@16
|
1051 detail::owens_t_initializer<result_type, Policy, tag_type>::force_instantiate();
|
Chris@16
|
1052
|
Chris@16
|
1053 return policies::checked_narrowing_cast<result_type, Policy>(detail::owens_t(static_cast<value_type>(h), static_cast<value_type>(a), pol), "boost::math::owens_t<%1%>(%1%,%1%)");
|
Chris@16
|
1054 }
|
Chris@16
|
1055
|
Chris@16
|
1056 template <class T1, class T2>
|
Chris@16
|
1057 inline typename tools::promote_args<T1, T2>::type owens_t(T1 h, T2 a)
|
Chris@16
|
1058 {
|
Chris@16
|
1059 return owens_t(h, a, policies::policy<>());
|
Chris@16
|
1060 }
|
Chris@16
|
1061
|
Chris@16
|
1062
|
Chris@16
|
1063 } // namespace math
|
Chris@16
|
1064 } // namespace boost
|
Chris@16
|
1065
|
Chris@101
|
1066 #ifdef BOOST_MSVC
|
Chris@101
|
1067 #pragma warning(pop)
|
Chris@101
|
1068 #endif
|
Chris@101
|
1069
|
Chris@16
|
1070 #endif
|
Chris@16
|
1071 // EOF
|