Object-oriented Scientific Computing Library: Version 0.910
gsl_inte_qaws.h
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
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines

Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).

Get Object-oriented Scientific Computing
Lib at SourceForge.net. Fast, secure and Free Open Source software
downloads.