gsl_inte_qaws.h

00001 /*
00002   -------------------------------------------------------------------
00003   
00004   Copyright (C) 2006, 2007, 2008, Andrew W. Steiner
00005   
00006   This file is part of O2scl.
00007   
00008   O2scl is free software; you can redistribute it and/or modify
00009   it under the terms of the GNU General Public License as published by
00010   the Free Software Foundation; either version 3 of the License, or
00011   (at your option) any later version.
00012   
00013   O2scl is distributed in the hope that it will be useful,
00014   but WITHOUT ANY WARRANTY; without even the implied warranty of
00015   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00016   GNU General Public License for more details.
00017   
00018   You should have received a copy of the GNU General Public License
00019   along with O2scl. If not, see <http://www.gnu.org/licenses/>.
00020 
00021   -------------------------------------------------------------------
00022 */
00023 #ifndef O2SCL_GSL_INTE_QAWS_H
00024 #define O2SCL_GSL_INTE_QAWS_H
00025 
00026 #include <o2scl/inte.h>
00027 #include <o2scl/gsl_inte_qag_b.h>
00028 
00029 #ifndef DOXYGENP
00030 namespace o2scl {
00031 #endif
00032   
00033   /** 
00034       \brief QAWS integration (GSL)
00035 
00036       \note This is unfinished.
00037       
00038       \todo Finish this!
00039   */
00040   template<class param_t, class func_t> class gsl_inte_qaws : 
00041   public gsl_inte_cheb<param_t,func_t> {
00042     
00043   public:
00044 
00045     gsl_inte_qaws() {
00046     }
00047 
00048     virtual ~gsl_inte_qaws() {}
00049       
00050     /** \brief Integrate function \c func from \c a to \c b.
00051      */
00052     virtual double integ(func_t &func, double a, double b, param_t &pa) {
00053       double res, err;
00054       integ_err(func,a,b,pa,res,err);
00055       this->interror=err;
00056       return res;
00057     }
00058     
00059     /// The singularity
00060     double s;
00061 
00062     /** \brief Integrate function \c func from \c a to \c b and place
00063         the result in \c res and the error in \c err
00064     */
00065     virtual int integ_err(func_t &func, double a, double b, 
00066                           param_t &pa, double &res, double &err2) {
00067 
00068       int status=qaws(func,a,b,s,this->tolx,this->tolf,this->wkspace,
00069                       &res,&err2,pa);
00070       
00071       return status;
00072       
00073     }
00074 
00075 #ifndef DOXYGEN_INTERNAL
00076 
00077   protected:
00078 
00079     /** 
00080         \brief Desc
00081     */
00082     int qaws(func_t &func, const double a, const double b, const double c,
00083              const double epsabs, const double epsrel, const size_t limit,
00084              double *result, double *abserr, param_t &pa) {
00085       double area, errsum;
00086       double result0, abserr0;
00087       double tolerance;
00088       size_t iteration = 0;
00089       int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0;
00090 
00091       /* Initialize results */
00092 
00093       initialise (workspace, a, b);
00094 
00095       *result = 0;
00096       *abserr = 0;
00097 
00098       if (limit > workspace->limit) {
00099         GSL_ERROR ("iteration limit exceeds available workspace", 
00100                    GSL_EINVAL) ;
00101       }
00102 
00103       if (b <= a) {
00104         GSL_ERROR ("limits must form an ascending sequence, a < b", 
00105                    GSL_EINVAL) ;
00106       }
00107       
00108       if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || 
00109                           epsrel < 0.5e-28)) {
00110         GSL_ERROR ("tolerance cannot be acheived with given epsabs and epsrel",
00111                    GSL_EBADTOL);
00112       }
00113       
00114       /* perform the first integration */
00115 
00116       {
00117         double area1, area2;
00118         double error1, error2;
00119         int err_reliable1, err_reliable2;
00120         double a1 = a;
00121         double b1 = 0.5 * (a + b);
00122         double a2 = b1;
00123         double b2 = b;
00124 
00125         qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00126         qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00127     
00128         if (error1 > error2)
00129           {
00130             append_interval (workspace, a1, b1, area1, error1);
00131             append_interval (workspace, a2, b2, area2, error2);
00132           }
00133         else
00134           {
00135             append_interval (workspace, a2, b2, area2, error2);
00136             append_interval (workspace, a1, b1, area1, error1);
00137           }
00138     
00139         result0 = area1 + area2;
00140         abserr0 = error1 + error2;
00141       }
00142 
00143       /* Test on accuracy */
00144 
00145       tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0));
00146 
00147       /* Test on accuracy, use 0.01 relative error as an extra safety
00148          margin on the first iteration (ignored for subsequent iterations) */
00149 
00150       if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0))
00151         {
00152           *result = result0;
00153           *abserr = abserr0;
00154 
00155           return GSL_SUCCESS;
00156         }
00157       else if (limit == 1)
00158         {
00159           *result = result0;
00160           *abserr = abserr0;
00161 
00162           GSL_ERROR ("a maximum of one iteration was insufficient", 
00163                      GSL_EMAXITER);
00164         }
00165 
00166       area = result0;
00167       errsum = abserr0;
00168 
00169       iteration = 2;
00170 
00171       do
00172         {
00173           double a1, b1, a2, b2;
00174           double a_i, b_i, r_i, e_i;
00175           double area1 = 0, area2 = 0, area12 = 0;
00176           double error1 = 0, error2 = 0, error12 = 0;
00177           int err_reliable1, err_reliable2;
00178 
00179           /* Bisect the subinterval with the largest error estimate */
00180 
00181           retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00182 
00183           a1 = a_i; 
00184           b1 = 0.5 * (a_i + b_i);
00185           a2 = b1;
00186           b2 = b_i;
00187 
00188           qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00189           qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00190 
00191           area12 = area1 + area2;
00192           error12 = error1 + error2;
00193 
00194           errsum += (error12 - e_i);
00195           area += area12 - r_i;
00196 
00197           if (err_reliable1 && err_reliable2)
00198             {
00199               double delta = r_i - area12;
00200 
00201               if (fabs (delta) <= 1.0e-5 * fabs (area12) && 
00202                   error12 >= 0.99 * e_i)
00203                 {
00204                   roundoff_type1++;
00205                 }
00206               if (iteration >= 10 && error12 > e_i)
00207                 {
00208                   roundoff_type2++;
00209                 }
00210             }
00211 
00212           tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area));
00213 
00214           if (errsum > tolerance)
00215             {
00216               if (roundoff_type1 >= 6 || roundoff_type2 >= 20)
00217                 {
00218                   error_type = 2;   /* round off error */
00219                 }
00220 
00221               /* set error flag in the case of bad integrand behaviour at
00222                  a point of the integration range */
00223 
00224               if (subinterval_too_small (a1, a2, b2))
00225                 {
00226                   error_type = 3;
00227                 }
00228             }
00229 
00230           update (workspace, a1, b1, area1, error1, a2, b2, area2, error2);
00231 
00232           retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00233 
00234           iteration++;
00235 
00236         }
00237       while (iteration < limit && !error_type && errsum > tolerance);
00238 
00239       *result = sum_results (workspace);
00240       *abserr = errsum;
00241 
00242       if (errsum <= tolerance)
00243         {
00244           return GSL_SUCCESS;
00245         }
00246       else if (error_type == 2)
00247         {
00248           GSL_ERROR ("roundoff error prevents tolerance from being achieved",
00249                      GSL_EROUND);
00250         }
00251       else if (error_type == 3)
00252         {
00253           GSL_ERROR 
00254             ("bad integrand behavior found in the integration interval",
00255              GSL_ESING);
00256         }
00257       else if (iteration == limit)
00258         {
00259           GSL_ERROR ("maximum number of subdivisions reached", GSL_EMAXITER);
00260         }
00261       else
00262         {
00263           GSL_ERROR ("could not integrate function", GSL_EFAILED);
00264         }
00265 
00266     }
00267 
00268     struct fn_qaws_params
00269     {
00270       gsl_function *function;
00271       double a;
00272       double b;
00273       gsl_integration_qaws_table *table;
00274     };
00275 
00276     double fn_qaws (double t, void *params);
00277     double fn_qaws_L (double x, void *params);
00278     double fn_qaws_R (double x, void *params);
00279 
00280     void
00281       compute_result (const double * r, const double * cheb12, const double * cheb24,
00282                       double * result12, double * result24);
00283 
00284 
00285     void
00286       qc25s (gsl_function * f, double a, double b, double a1, double b1,
00287              gsl_integration_qaws_table * t,
00288              double *result, double *abserr, int *err_reliable);
00289 
00290     void
00291       qc25s (gsl_function * f, double a, double b, double a1, double b1,
00292              gsl_integration_qaws_table * t,
00293              double *result, double *abserr, int *err_reliable)
00294       {
00295         gsl_function weighted_function;
00296         struct fn_qaws_params fn_params;
00297   
00298         fn_params.function = f;
00299         fn_params.a = a;
00300         fn_params.b = b;
00301         fn_params.table = t;
00302 
00303         weighted_function.params = &fn_params;
00304     
00305         if (a1 == a && (t->alpha != 0.0 || t->mu != 0))
00306           {
00307             double cheb12[13], cheb24[25];
00308 
00309             double factor = pow(0.5 * (b1 - a1), t->alpha + 1.0);
00310 
00311             weighted_function.function = &fn_qaws_R;
00312 
00313             gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00314 
00315             if (t->mu == 0)
00316               {
00317                 double res12 = 0, res24 = 0;
00318                 double u = factor;
00319 
00320                 compute_result (t->ri, cheb12, cheb24, &res12, &res24);
00321 
00322                 *result = u * res24;
00323                 *abserr = fabs(u * (res24 - res12));
00324               }
00325             else 
00326               {
00327                 double res12a = 0, res24a = 0;
00328                 double res12b = 0, res24b = 0;
00329 
00330                 double u = factor * log(b1 - a1);
00331                 double v = factor;
00332 
00333                 compute_result (t->ri, cheb12, cheb24, &res12a, &res24a);
00334                 compute_result (t->rg, cheb12, cheb24, &res12b, &res24b);
00335 
00336                 *result = u * res24a + v * res24b;
00337                 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00338               }
00339 
00340             *err_reliable = 0;
00341 
00342             return;
00343           }
00344         else if (b1 == b && (t->beta != 0.0 || t->nu != 0))
00345           {
00346             double cheb12[13], cheb24[25];
00347             double factor = pow(0.5 * (b1 - a1), t->beta + 1.0);
00348 
00349             weighted_function.function = &fn_qaws_L;
00350 
00351             gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00352 
00353             if (t->nu == 0)
00354               {
00355                 double res12 = 0, res24 = 0;
00356                 double u = factor;
00357 
00358                 compute_result (t->rj, cheb12, cheb24, &res12, &res24);
00359 
00360                 *result = u * res24;
00361                 *abserr = fabs(u * (res24 - res12));
00362               }
00363             else 
00364               {
00365                 double res12a = 0, res24a = 0;
00366                 double res12b = 0, res24b = 0;
00367 
00368                 double u = factor * log(b1 - a1);
00369                 double v = factor;
00370 
00371                 compute_result (t->rj, cheb12, cheb24, &res12a, &res24a);
00372                 compute_result (t->rh, cheb12, cheb24, &res12b, &res24b);
00373 
00374                 *result = u * res24a + v * res24b;
00375                 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00376               }
00377 
00378             *err_reliable = 0;
00379 
00380             return;
00381           }
00382         else
00383           {
00384             double resabs, resasc;
00385 
00386             weighted_function.function = &fn_qaws;
00387   
00388             gsl_integration_qk15 (&weighted_function, a1, b1, result, abserr,
00389                                   &resabs, &resasc);
00390 
00391             if (*abserr == resasc)
00392               {
00393                 *err_reliable = 0;
00394               }
00395             else 
00396               {
00397                 *err_reliable = 1;
00398               }
00399 
00400             return;
00401           }
00402 
00403       }
00404 
00405     double
00406       fn_qaws (double x, void *params)
00407       {
00408         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00409         gsl_function *f = p->function;
00410         gsl_integration_qaws_table *t = p->table;
00411 
00412         double factor = 1.0;
00413   
00414         if (t->alpha != 0.0)
00415           factor *= pow(x - p->a, t->alpha);
00416 
00417         if (t->beta != 0.0)
00418           factor *= pow(p->b - x, t->beta);
00419 
00420         if (t->mu == 1)
00421           factor *= log(x - p->a);
00422 
00423         if (t->nu == 1)
00424           factor *= log(p->b - x);
00425 
00426         return factor * GSL_FN_EVAL (f, x);
00427       }
00428 
00429     double
00430       fn_qaws_L (double x, void *params)
00431       {
00432         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00433         gsl_function *f = p->function;
00434         gsl_integration_qaws_table *t = p->table;
00435 
00436         double factor = 1.0;
00437   
00438         if (t->alpha != 0.0)
00439           factor *= pow(x - p->a, t->alpha);
00440 
00441         if (t->mu == 1)
00442           factor *= log(x - p->a);
00443 
00444         return factor * GSL_FN_EVAL (f, x);
00445       }
00446 
00447     double
00448       fn_qaws_R (double x, void *params)
00449       {
00450         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00451         gsl_function *f = p->function;
00452         gsl_integration_qaws_table *t = p->table;
00453 
00454         double factor = 1.0;
00455   
00456         if (t->beta != 0.0)
00457           factor *= pow(p->b - x, t->beta);
00458 
00459         if (t->nu == 1)
00460           factor *= log(p->b - x);
00461 
00462         return factor * GSL_FN_EVAL (f, x);
00463       }
00464 
00465 
00466     void
00467       compute_result (const double * r, const double * cheb12, const double * cheb24,
00468                       double * result12, double * result24)
00469       {
00470         size_t i;
00471         double res12 = 0;
00472         double res24 = 0;
00473   
00474         for (i = 0; i < 13; i++)
00475           {
00476             res12 += r[i] * cheb12[i];
00477           }
00478   
00479         for (i = 0; i < 25; i++)
00480           {
00481             res24 += r[i] * cheb24[i];
00482           }
00483   
00484         *result12 = res12;
00485         *result24 = res24;
00486       }
00487 
00488 
00489     /// Desc
00490     virtual double transform(func_t &func, double x, param_t &pa)
00491     {
00492       double y;
00493       func(x,y,pa);
00494       return y/(x-s);
00495     }
00496 
00497 #endif
00498   
00499     /// Return string denoting type ("gsl_inte_qaws")
00500     const char *type() { return "gsl_inte_qaws"; }
00501   
00502   };
00503 
00504 #ifndef DOXYGENP
00505 }
00506 #endif
00507 
00508 #endif

Documentation generated with Doxygen and provided under the GNU Free Documentation License. See License Information for details.

Project hosting provided by SourceForge.net Logo, O2scl Sourceforge Project Page