![]() |
Object-oriented Scientific Computing Library: Version 0.910
|
00001 /* 00002 ------------------------------------------------------------------- 00003 00004 Copyright (C) 2006-2012, Jerry Gagelman 00005 and Andrew W. Steiner 00006 00007 This file is part of O2scl. 00008 00009 O2scl is free software; you can redistribute it and/or modify 00010 it under the terms of the GNU General Public License as published by 00011 the Free Software Foundation; either version 3 of the License, or 00012 (at your option) any later version. 00013 00014 O2scl is distributed in the hope that it will be useful, 00015 but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 GNU General Public License for more details. 00018 00019 You should have received a copy of the GNU General Public License 00020 along with O2scl. If not, see <http://www.gnu.org/licenses/>. 00021 00022 ------------------------------------------------------------------- 00023 */ 00024 /* 00025 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Brian Gough 00026 * 00027 * This program is free software; you can redistribute it and/or modify 00028 * it under the terms of the GNU General Public License as published by 00029 * the Free Software Foundation; either version 3 of the License, or (at 00030 * your option) any later version. 00031 * 00032 * This program is distributed in the hope that it will be useful, but 00033 * WITHOUT ANY WARRANTY; without even the implied warranty of 00034 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 00035 * General Public License for more details. 00036 * 00037 * You should have received a copy of the GNU General Public License 00038 * along with this program; if not, write to the Free Software 00039 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 00040 * 02110-1301, USA. 00041 */ 00042 #ifndef GSL_INTE_QAWS_H 00043 #define GSL_INTE_QAWS_H 00044 00045 #include <o2scl/gsl_inte_qawc.h> 00046 00047 #ifndef DOXYGENP 00048 namespace o2scl { 00049 #endif 00050 00051 /** \brief Adaptive integration with with algebraic-logarithmic 00052 singularities at the end-points (GSL) 00053 00054 This class computes the weighted integral 00055 \f[ 00056 \int_a^b f(x)(x - a)^\alpha (b - x)^\beta \log^\mu(x - a) 00057 \log^\nu(b - x)~dx 00058 \f] 00059 where the parameters of the weight function must satisfy 00060 \f[ 00061 \alpha > -1, \quad \beta > -1, \quad 00062 \mu \in \{0, 1\}, \quad \nu \in \{0, 1\}, 00063 \f] 00064 and which are set by \ref set_weight(). Note that setting \f$ 00065 \mu=0 \f$ or \f$ \nu=0 \f$ removes the respective factor \f$ 00066 \log^mu(\ldots) \f$ or \f$ \log^\nu(\ldots) \f$ from the weight. 00067 00068 The adaptive refinement algorithm described for \ref 00069 gsl_inte_qag is used. When a subinterval contains one of the 00070 endpoints, a special 25-point modified Clenshaw-Curtis rule is 00071 used to control the singularities. For subintervals which do not 00072 include the endpoints, a Gauss-Kronrod integration rule is used. 00073 00074 See \ref gslinte_subsect in the User's guide for general 00075 information about the GSL integration classes. 00076 */ 00077 template<class func_t=funct> class gsl_inte_qaws : 00078 public gsl_inte_cheb<func_t> { 00079 00080 #ifndef DOXYGEN_INTERNAL 00081 00082 protected: 00083 00084 /** \name Data from \c gsl_integration_qaws_table 00085 */ 00086 //@{ 00087 double alpha; 00088 double beta; 00089 int mu; 00090 int nu; 00091 00092 double ri[25]; 00093 double rj[25]; 00094 double rg[25]; 00095 double rh[25]; 00096 //@} 00097 00098 /** \brief Set the array values \c ri, \c rj, \c rg, \c rh from the 00099 current values \c alpha and \c beta. 00100 00101 This is the function from the GSL source code \c integration/qmomo.c 00102 that initializes \c gsl_integration_qaws_table. 00103 */ 00104 void initialise_qaws_table() { 00105 00106 const double alpha_p1 = this->alpha + 1.0; 00107 const double beta_p1 = this->beta + 1.0; 00108 00109 const double alpha_p2 = this->alpha + 2.0; 00110 const double beta_p2 = this->beta + 2.0; 00111 00112 const double r_alpha = pow (2.0, alpha_p1); 00113 const double r_beta = pow (2.0,beta_p1); 00114 00115 size_t i; 00116 00117 double an, anm1; 00118 00119 this->ri[0] = r_alpha / alpha_p1; 00120 this->ri[1] = this->ri[0] * this->alpha / alpha_p2; 00121 00122 an = 2.0; 00123 anm1 = 1.0; 00124 00125 for (i = 2; i < 25; i++) { 00126 this->ri[i] = -(r_alpha + an * (an - alpha_p2) * this->ri[i - 1]) 00127 / (anm1 * (an + alpha_p1)); 00128 anm1 = an; 00129 an = an + 1.0; 00130 } 00131 00132 rj[0] = r_beta / beta_p1; 00133 rj[1] = rj[0] * this->beta / beta_p2; 00134 00135 an = 2.0; 00136 anm1 = 1.0; 00137 00138 for (i = 2; i < 25; i++) { 00139 rj[i] = (-(r_beta + an * (an - beta_p2) * rj[i - 1]) 00140 / (anm1 * (an + beta_p1))); 00141 anm1 = an; 00142 an = an + 1.0; 00143 } 00144 00145 this->rg[0] = -this->ri[0] / alpha_p1; 00146 this->rg[1] = -this->rg[0] - 2.0 * r_alpha / (alpha_p2 * alpha_p2); 00147 00148 an = 2.0; 00149 anm1 = 1.0; 00150 00151 for (i = 2; i < 25; i++) { 00152 this->rg[i] = (-(an * (an - alpha_p2) * 00153 this->rg[i - 1] - an * this->ri[i - 1] 00154 + anm1 * this->ri[i]) 00155 / (anm1 * (an + alpha_p1))); 00156 anm1 = an; 00157 an = an + 1.0; 00158 } 00159 00160 this->rh[0] = -this->rj[0] / beta_p1; 00161 this->rh[1] = -this->rh[0] - 2.0 * r_beta / (beta_p2 * beta_p2); 00162 00163 an = 2.0; 00164 anm1 = 1.0; 00165 00166 for (i = 2; i < 25; i++) { 00167 this->rh[i] = (-(an * (an - beta_p2) * 00168 this->rh[i - 1] - an * this->rj[i - 1] 00169 + anm1 * this->rj[i]) 00170 / (anm1 * (an + beta_p1))); 00171 anm1 = an; 00172 an = an + 1.0; 00173 } 00174 00175 for (i = 1; i < 25; i += 2) { 00176 this->rj[i] *= -1; 00177 this->rh[i] *= -1; 00178 } 00179 00180 return; 00181 } 00182 00183 /** \brief True if algebraic-logarithmic singularity is present at the 00184 right endpoint in the definition \c f_trans. 00185 */ 00186 bool fn_qaws_R; 00187 00188 /** \brief True if algebraic-logarithmic singularity is present at the 00189 left endpoint in the definition \c f_trans. 00190 */ 00191 bool fn_qaws_L; 00192 00193 /// Left endpoint in definition of \c f_trans 00194 double left_endpoint; 00195 00196 /// Right endpoint in definition of \c f_trans. 00197 double right_endpoint; 00198 00199 /** \brief Weighted integrand. 00200 */ 00201 virtual double transform(double t, func_t &func) { 00202 00203 double factor = 1.0,y; 00204 00205 if (fn_qaws_L) { 00206 if (alpha != 0.0) { 00207 factor *= pow(t - left_endpoint,alpha); 00208 } 00209 if (mu == 1) { 00210 factor *= log(t - left_endpoint); 00211 } 00212 } 00213 00214 if (fn_qaws_R) { 00215 if (beta != 0.0) { 00216 factor *= pow(right_endpoint - t,beta); 00217 } 00218 if (nu == 1) { 00219 factor *= log(right_endpoint - t); 00220 } 00221 } 00222 00223 return func(t)*factor; 00224 } 00225 00226 /** \brief Clenshaw-Curtis 25-point integration and error estimator 00227 for functions with an algebraic-logarithmic singularity at the 00228 endpoint(s). 00229 */ 00230 void qc25s(func_t &func, double a, double b, double a1, double b1, 00231 double &result, double &abserr, int &err_reliable) { 00232 00233 // Transformed function object for inte_cheb_series() 00234 funct_mfptr_param<gsl_inte_transform<func_t>,func_t> 00235 fmp(this,&gsl_inte_transform<func_t>::transform,func); 00236 00237 this->left_endpoint = a; 00238 this->right_endpoint = b; 00239 00240 if (a1 == a && (this->alpha != 0.0 || this->mu != 0)) { 00241 00242 double cheb12[13], cheb24[25]; 00243 00244 double factor = pow(0.5 * (b1 - a1),this->alpha + 1.0); 00245 00246 // weighted_function.function = &fn_qaws_R; 00247 this->fn_qaws_R = true; 00248 this->fn_qaws_L = false; 00249 00250 this->inte_cheb_series(fmp,a1,b1,cheb12,cheb24); 00251 00252 if (this->mu == 0) { 00253 double res12 = 0,res24 = 0; 00254 double u = factor; 00255 00256 this->compute_result(this->ri,cheb12,cheb24,res12,res24); 00257 00258 result = u * res24; 00259 abserr = fabs(u * (res24 - res12)); 00260 00261 } else { 00262 00263 double res12a = 0,res24a = 0; 00264 double res12b = 0,res24b = 0; 00265 00266 double u = factor * log(b1 - a1); 00267 double v = factor; 00268 00269 this->compute_result(this->ri,cheb12,cheb24,res12a,res24a); 00270 this->compute_result(this->rg,cheb12,cheb24,res12b,res24b); 00271 00272 result = u * res24a + v * res24b; 00273 abserr = fabs(u*(res24a - res12a)) + fabs(v*(res24b - res12b)); 00274 } 00275 00276 err_reliable = 0; 00277 return; 00278 00279 } else if (b1 == b && (this->beta != 0.0 || this->nu != 0)) { 00280 00281 double cheb12[13], cheb24[25]; 00282 double factor = pow(0.5 * (b1 - a1), this->beta + 1.0); 00283 00284 // weighted_function.function = &fn_qaws_L; 00285 this->fn_qaws_L = true; 00286 this->fn_qaws_R = false; 00287 00288 this->inte_cheb_series(fmp,a1,b1,cheb12,cheb24); 00289 00290 if (this->nu == 0) { 00291 00292 double res12 = 0, res24 = 0; 00293 double u = factor; 00294 00295 this->compute_result(this->rj, cheb12,cheb24,res12,res24); 00296 00297 result = u * res24; 00298 abserr = fabs(u * (res24 - res12)); 00299 00300 } else { 00301 00302 double res12a = 0, res24a = 0; 00303 double res12b = 0, res24b = 0; 00304 00305 double u = factor * log(b1 - a1); 00306 double v = factor; 00307 00308 this->compute_result(this->rj,cheb12,cheb24,res12a,res24a); 00309 this->compute_result(this->rh,cheb12,cheb24,res12b,res24b); 00310 00311 result = u * res24a + v * res24b; 00312 abserr = fabs(u*(res24a - res12a)) + fabs(v*(res24b - res12b)); 00313 } 00314 00315 err_reliable = 0; 00316 return; 00317 00318 } else { 00319 00320 double resabs, resasc; 00321 00322 // weighted_function.function = &fn_qaws; 00323 this->fn_qaws_R = true; 00324 this->fn_qaws_L = true; 00325 00326 gauss_kronrod(func,a1,b1,&result,&abserr,&resabs,&resasc); 00327 00328 if (abserr == resasc) { 00329 err_reliable = 0; 00330 } else { 00331 err_reliable = 1; 00332 } 00333 00334 return; 00335 } 00336 } 00337 00338 /** \brief Compute the 13-point and 25-point approximations from 00339 the Chebyshev moments and coefficients. 00340 */ 00341 void compute_result(double *r, double *cheb12, double *cheb24, 00342 double &result12, double &result24) { 00343 00344 result12=0.0; 00345 result24=0.0; 00346 00347 size_t i; 00348 for (i = 0; i < 13; i++) { 00349 result12 += r[i] * cheb12[i]; 00350 } 00351 00352 for (i = 0; i < 25; i++) { 00353 result24 += r[i] * cheb24[i]; 00354 } 00355 } 00356 00357 #endif 00358 00359 public: 00360 00361 /** \brief Initialize the adptive workspace as with the constructor 00362 \ref gsl_inte_qag::gsl_inte_qag. 00363 00364 The default paramters \f$ \alpha, \beta, \mu, \nu \f$ of the weight 00365 function are all zero. 00366 */ 00367 gsl_inte_qaws() : gsl_inte_cheb<func_t>() { 00368 set_weight(0.0,0.0,0,0); 00369 } 00370 00371 ~gsl_inte_qaws() {} 00372 00373 /** \brief Sets the exponents of singularites of the weight function. 00374 00375 The parameters determine the exponents of the weight function 00376 \f[ 00377 W(x) = (x-a)^\alpha (b-x)^\beta \log^\mu(x-a) \log^\nu(b-x), 00378 \f] 00379 and must satsify 00380 \f[ 00381 \alpha > -1, \quad \beta > -1, \quad 00382 \mu \in \{0, 1\}, \quad \nu \in \{0, 1\}. 00383 \f] 00384 In order for the adaptive algorithm to run quickly, a table of 00385 Chebyshev weights for the particular parameters are computed in 00386 advance. 00387 */ 00388 int set_weight(double u_alpha, double u_beta, int u_mu, int u_nu) { 00389 00390 if (u_alpha < -1.0) { 00391 std::string estr=((std::string)"Variable alpha must be ")+ 00392 "greater than -1.0 in gsl_inte_qaws()."; 00393 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00394 } 00395 if (u_beta < -1.0) { 00396 std::string estr=((std::string)"Variable beta must be ")+ 00397 "greater than -1.0 in gsl_inte_qaws()."; 00398 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00399 } 00400 if (u_mu != 0 && u_mu != 1) { 00401 std::string estr=((std::string)"Variable mu must be 0 or 1 ")+ 00402 "in gsl_inte_qaws()."; 00403 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00404 } 00405 if (u_nu != 0 && u_nu != 1) { 00406 std::string estr=((std::string)"Variable nu must be 0 or 1 ")+ 00407 "in gsl_inte_qaws()."; 00408 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00409 } 00410 00411 this->alpha = u_alpha; 00412 this->beta = u_beta; 00413 this->mu = u_mu; 00414 this->nu = u_nu; 00415 00416 initialise_qaws_table(); 00417 return gsl_success; 00418 } 00419 00420 /** \brief Returns the current values (via reference) of the 00421 weight-function's parameters. 00422 */ 00423 void get_weight(double &u_alpha, double &u_beta, int &u_mu, int &u_nu) { 00424 u_alpha = this->alpha; 00425 u_beta = this->beta; 00426 u_mu = this->mu; 00427 u_nu = this->nu; 00428 } 00429 00430 /** \brief Integrate the function \c func on the interval (\c a, \c b) 00431 returning the \c result and error estimate \c abserr. 00432 */ 00433 virtual int integ_err(func_t &func, double a, double b, 00434 double &result, double &abserr) { 00435 00436 double area, errsum; 00437 double result0, abserr0; 00438 double tolerance; 00439 this->last_iter = 0; 00440 int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0; 00441 00442 /* Initialize results */ 00443 00444 this->w->initialise(a,b); 00445 00446 result = 0; 00447 abserr = 0; 00448 00449 size_t limit=this->w->limit; 00450 00451 if (b <= a) { 00452 std::string estr="Integration limits, a="+dtos(a); 00453 estr+=" and b="+dtos(b)+", must satisfy a < b"; 00454 estr+=" in gsl_inte_qaws::gsl_qaws()."; 00455 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00456 } 00457 00458 if (this->tol_abs <= 0 && (this->tol_rel < 50 * GSL_DBL_EPSILON || 00459 this->tol_rel < 0.5e-28)) { 00460 this->last_iter=0; 00461 std::string estr="Tolerance cannot be achieved with given "; 00462 estr+="value of tol_abs, "+dtos(this->tol_abs)+", and tol_rel, "+ 00463 dtos(this->tol_rel)+", in gsl_inte_qaws::integ_err()."; 00464 O2SCL_ERR_RET(estr.c_str(),gsl_ebadtol); 00465 } 00466 00467 /* perform the first integration */ 00468 00469 { 00470 double area1, area2; 00471 double error1, error2; 00472 int err_reliable1, err_reliable2; 00473 double a1 = a; 00474 double b1 = 0.5 * (a + b); 00475 double a2 = b1; 00476 double b2 = b; 00477 00478 qc25s(func, a, b, a1, b1, area1, error1, err_reliable1); 00479 qc25s(func, a, b, a2, b2, area2, error2, err_reliable2); 00480 00481 this->last_iter = 2; 00482 00483 if (error1 > error2) { 00484 this->w->append_interval(a1, b1, area1, error1); 00485 this->w->append_interval(a2, b2, area2, error2); 00486 } else { 00487 this->w->append_interval(a2, b2, area2, error2); 00488 this->w->append_interval(a1, b1, area1, error1); 00489 } 00490 00491 result0 = area1 + area2; 00492 abserr0 = error1 + error2; 00493 } 00494 00495 /* Test on accuracy */ 00496 00497 tolerance = GSL_MAX_DBL (this->tol_abs, this->tol_rel * fabs (result0)); 00498 00499 /* Test on accuracy, use 0.01 relative error as an extra safety 00500 margin on the first iteration (ignored for subsequent iterations) */ 00501 00502 if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0)) { 00503 result = result0; 00504 abserr = abserr0; 00505 return gsl_success; 00506 } else if (limit == 1) { 00507 result = result0; 00508 abserr = abserr0; 00509 00510 this->last_conv=gsl_emaxiter; 00511 std::string estr = "A maximum of 1 iteration was insufficient "; 00512 estr += "in gsl_inte_qaws::gsl_qaws()."; 00513 O2SCL_CONV_RET(estr.c_str(), gsl_emaxiter, this->err_nonconv); 00514 } 00515 00516 area = result0; 00517 errsum = abserr0; 00518 00519 do { 00520 double a1, b1, a2, b2; 00521 double a_i, b_i, r_i, e_i; 00522 double area1 = 0, area2 = 0, area12 = 0; 00523 double error1 = 0, error2 = 0, error12 = 0; 00524 int err_reliable1, err_reliable2; 00525 00526 /* Bisect the subinterval with the largest error estimate */ 00527 this->w->retrieve(&a_i,&b_i,&r_i,&e_i); 00528 00529 a1 = a_i; 00530 b1 = 0.5 * (a_i + b_i); 00531 a2 = b1; 00532 b2 = b_i; 00533 00534 qc25s(func, a, b, a1, b1, area1, error1, err_reliable1); 00535 qc25s(func, a, b, a2, b2, area2, error2, err_reliable2); 00536 00537 area12 = area1 + area2; 00538 error12 = error1 + error2; 00539 00540 errsum += (error12 - e_i); 00541 area += area12 - r_i; 00542 00543 if (err_reliable1 && err_reliable2) { 00544 00545 double delta = r_i - area12; 00546 00547 if (fabs(delta) <= 1.0e-5 * fabs (area12) 00548 && error12 >= 0.99 * e_i) { 00549 roundoff_type1++; 00550 } 00551 if (this->last_iter >= 10 && error12 > e_i) { 00552 roundoff_type2++; 00553 } 00554 } 00555 00556 tolerance = GSL_MAX_DBL (this->tol_abs, this->tol_rel * fabs (area)); 00557 00558 if (errsum > tolerance) { 00559 if (roundoff_type1 >= 6 || roundoff_type2 >= 20) { 00560 // round off error 00561 error_type = 2; 00562 } 00563 00564 /* set error flag in the case of bad integrand behaviour at 00565 a point of the integration range */ 00566 if (this->w->subinterval_too_small (a1, a2, b2)) { 00567 error_type = 3; 00568 } 00569 } 00570 00571 this->w->update(a1, b1, area1, error1, a2, b2, area2, error2); 00572 this->w->retrieve(&a_i,&b_i,&r_i,&e_i); 00573 this->last_iter++; 00574 00575 } while (this->last_iter < this->w->limit 00576 && !error_type && errsum > tolerance); 00577 00578 result = this->w->sum_results(); 00579 abserr = errsum; 00580 this->interror = abserr; 00581 00582 if (errsum <= tolerance) { 00583 return gsl_success; 00584 } else if (error_type == 2) { 00585 this->last_conv=gsl_eround; 00586 std::string estr="Round-off error prevents tolerance "; 00587 estr+="from being achieved in gsl_inte_qaws::gsl_qaws()."; 00588 O2SCL_CONV_RET(estr.c_str(),gsl_eround,this->err_nonconv); 00589 } else if (error_type == 3) { 00590 this->last_conv=gsl_esing; 00591 std::string estr="Bad integrand behavior "; 00592 estr+=" in gsl_inte_qaws::gsl_qaws()."; 00593 O2SCL_CONV_RET(estr.c_str(),gsl_esing,this->err_nonconv); 00594 } else if (this->last_iter == limit) { 00595 this->last_conv=gsl_emaxiter; 00596 std::string estr="Maximum number of subdivisions ("+itos(limit); 00597 estr+=") reached in gsl_inte_qaws::gsl_qaws()."; 00598 O2SCL_CONV_RET(estr.c_str(),gsl_emaxiter,this->err_nonconv); 00599 } else { 00600 std::string estr="Could not integrate function in "; 00601 estr+="gsl_inte_qaws::gsl_qaws()."; 00602 O2SCL_ERR_RET(estr.c_str(),gsl_efailed); 00603 } 00604 00605 // No return statement needed since the above if statement 00606 // always forces a return 00607 } 00608 00609 /// Return string denoting type ("gsl_inte_qaws") 00610 const char *type() { return "gsl_inte_qaws"; } 00611 00612 }; 00613 00614 #ifndef DOXYGENP 00615 } 00616 #endif 00617 00618 #endif
Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).