annotate DEPENDENCIES/generic/include/boost/math/special_functions/owens_t.hpp @ 125:34e428693f5d vext

Vext -> Repoint
author Chris Cannam
date Thu, 14 Jun 2018 11:15:39 +0100
parents c530137014c0
children
rev   line source
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