Object-oriented Scientific Computing Library: Version 0.910
gsl_fit.h
00001 /*
00002   -------------------------------------------------------------------
00003   
00004   Copyright (C) 2006-2012, 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 /* multifit/fsolver.c
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 
00043 #ifndef O2SCL_GSL_FIT_H
00044 #define O2SCL_GSL_FIT_H
00045 
00046 #include <o2scl/fit_base.h>
00047 #include <gsl/gsl_rng.h>
00048 #include <gsl/gsl_vector.h>
00049 #include <gsl/gsl_blas.h>
00050 #include <gsl/gsl_multifit_nlin.h>
00051 #include <o2scl/omatrix_tlate.h>
00052 
00053 #ifndef DOXYGENP
00054 namespace o2scl {
00055 #endif
00056 
00057   /** \brief Non-linear least-squares fitting class (GSL)
00058     
00059       The GSL-based fitting class using a Levenberg-Marquardt type
00060       algorithm. The algorithm stops when
00061       \f[
00062       |dx_i| < \mathrm{epsabs}+\mathrm{epsrel}\times|x_i|
00063       \f]
00064       where \f$dx\f$ is the last step and \f$x\f$ is the current
00065       position. If test_gradient is true, then additionally fit()
00066       requires that
00067       \f[
00068       \sum_i |g_i| < \mathrm{epsabs}
00069       \f]
00070       where \f$g_i\f$ is the \f$i\f$-th component of the gradient of
00071       the function \f$\Phi(x)\f$ where
00072       \f[
00073       \Phi(x) = || F(x) ||^2
00074       \f]
00075 
00076       Default template arguments
00077       - \c func_t - \ref fit_funct<>
00078       - \c vec_t - \ref ovector_base
00079       - \c alloc_vec_t - \ref ovector
00080       - \c bool_vec_t - <tt>bool *</tt>
00081       
00082       \todo Properly generalize other vector types than 
00083       ovector_base
00084       \todo Allow the user to specify the derivatives
00085       \todo Fix so that the user can specify automatic
00086       scaling of the fitting parameters, where the initial
00087       guess are used for scaling so that the fitting parameters
00088       are near unity.
00089   */
00090   template<class func_t=fit_funct<>, class vec_t=ovector_base, 
00091     class mat_t=omatrix_base, class bool_vec_t=bool *> class gsl_fit : 
00092   public fit_base<func_t,vec_t,mat_t> {
00093 
00094   protected:
00095 
00096 #ifdef O2SCL_NEVER_DEFINED
00097 
00098   int covar_new(size_t n, const mat_t &J, double epsrel, 
00099                 mat_t &covar) {
00100 
00101     double tolr;
00102       
00103     size_t i, j, k;
00104     size_t kmax = 0;
00105     
00106     alloc_mat_t r;
00107     alloc_vec_t tau, norm;
00108     permutation perm;
00109       
00110     am.allocate(r,n,n);
00111     av.allocate(tau,n);
00112     av.allocate(norm,n);
00113     perm.allocate(n);
00114       
00115     int signum = 0;
00116     gsl_matrix_memcpy (r, J);
00117     gsl_linalg_QRPT_decomp (r, tau, perm, &signum, norm);
00118   
00119     /* Form the inverse of R in the full upper triangle of R */
00120 
00121     tolr = epsrel * fabs(gsl_matrix_get(r, 0, 0));
00122 
00123     for (k = 0 ; k < n ; k++) {
00124 
00125       double rkk = r[k][k];
00126 
00127       if (fabs(rkk) <= tolr) {
00128         break;
00129       }
00130 
00131       r[k][k]=1.0/rkk;
00132 
00133       for (j = 0; j < k ; j++) {
00134 
00135         double t = r[j][k] / rkk;
00136         r[j][k]=0.0;
00137 
00138         for (i = 0; i <= j; i++) {
00139 
00140           double rik = r[i][k];
00141           double rij = r[i][k];
00142               
00143           r[i][k]=rik - t * rij;
00144         }
00145       }
00146       kmax = k;
00147     }
00148 
00149     /* Form the full upper triangle of the inverse of R^T R in the full
00150        upper triangle of R */
00151 
00152     for (k = 0; k <= kmax ; k++) {
00153 
00154       for (j = 0; j < k; j++) {
00155 
00156         double rjk = r[j][k];
00157 
00158         for (i = 0; i <= j ; i++) {
00159 
00160           double rij = r[i][j];
00161           double rik = r[i][k];
00162 
00163           r[i][j]= rij + rjk * rik;
00164         }
00165       }
00166       
00167       {
00168         double t = r[k][k];
00169 
00170         for (i = 0; i <= k; i++) {
00171 
00172           double rik = r[i][k];
00173 
00174           r[i][k]*=t;
00175         };
00176       }
00177     }
00178 
00179     /* Form the full lower triangle of the covariance matrix in the
00180        strict lower triangle of R and in w */
00181 
00182     for (j = 0 ; j < n ; j++) {
00183 
00184       size_t pj = gsl_permutation_get (perm, j);
00185       
00186       for (i = 0; i <= j; i++) {
00187 
00188         size_t pi = gsl_permutation_get (perm, i);
00189 
00190         double rij;
00191 
00192         if (j > kmax) {
00193 
00194           gsl_matrix_set (r, i, j, 0.0);
00195           rij = 0.0 ;
00196 
00197         } else {
00198 
00199           rij = gsl_matrix_get (r, i, j);
00200         }
00201 
00202         if (pi > pj) {
00203           gsl_matrix_set (r, pi, pj, rij); 
00204 
00205         } else if (pi < pj) {
00206 
00207           gsl_matrix_set (r, pj, pi, rij);
00208         }
00209 
00210       }
00211       
00212       { 
00213         double rjj = r[j][j];
00214         covar[pj][pj]=rjj;
00215       }
00216     }
00217 
00218      
00219     /* symmetrize the covariance matrix */
00220 
00221     for (j = 0 ; j < n ; j++) {
00222 
00223       for (i = 0; i < j ; i++) {
00224 
00225         double rji = gsl_matrix_get (r, j, i);
00226 
00227         gsl_matrix_set (covar, j, i, rji);
00228         gsl_matrix_set (covar, i, j, rji);
00229       }
00230     }
00231 
00232     gsl_matrix_free (r);
00233     gsl_permutation_free (perm);
00234     gsl_vector_free (tau);
00235     gsl_vector_free (norm);
00236 
00237     return GSL_SUCCESS;
00238   }
00239 
00240 #endif
00241     
00242   public:
00243     
00244   gsl_fit() {
00245     gsl_set_error_handler(err_hnd->gsl_hnd);
00246     max_iter=500;
00247     epsabs=1.0e-4;
00248     epsrel=1.0e-4;
00249     use_scaled=true;
00250     test_gradient=false;
00251   }
00252 
00253   virtual ~gsl_fit() {}
00254   
00255   /** \brief Fit the data specified in (xdat,ydat) to
00256       the function \c fitfun with the parameters in \c par.
00257         
00258       The covariance matrix for the parameters is returned in \c covar
00259       and the value of \f$ \chi^2 \f$ is returned in \c chi2.
00260   */
00261   virtual int fit(size_t ndat, vec_t &xdat, vec_t &ydat, vec_t &yerr,
00262                   size_t npar, vec_t &par, mat_t &covar, double &chi2,
00263                   func_t &fitfun) {
00264 
00265     int status, iter=0;
00266 
00267     gsl_vector *x=gsl_vector_alloc(npar);
00268     for(size_t i=0;i<npar;i++) gsl_vector_set(x,i,par[i]);
00269 
00270     // Create fitting function and parameters
00271     gsl_multifit_function_fdf f;
00272     gsl_vector *grad=gsl_vector_alloc(npar);
00273     func_par fpar={fitfun,ndat,&xdat,&ydat,&yerr,npar};
00274     f.f=func;
00275     f.df=dfunc;
00276     f.fdf=fdfunc;
00277     f.n=ndat;
00278     f.p=npar;
00279     f.params=&fpar;
00280      
00281     // Create fitting object
00282     gsl_multifit_fdfsolver *s;
00283     if (use_scaled) {
00284       s=gsl_multifit_fdfsolver_alloc
00285         (gsl_multifit_fdfsolver_lmsder,ndat,npar);
00286     } else {
00287       s=gsl_multifit_fdfsolver_alloc
00288       (gsl_multifit_fdfsolver_lmder,ndat,npar);
00289     }
00290     gsl_multifit_fdfsolver_set(s,&f,x);
00291   
00292     // Perform the fit
00293     do {
00294       iter++;
00295       status=gsl_multifit_fdfsolver_iterate(s);
00296     
00297       if (status) {
00298         break;
00299       }
00300       
00301       // The equivalent of 
00302       // 
00303       // status=gsl_multifit_test_delta(s->dx,s->x,epsabs,epsrel);
00304       //
00305       // with an additional calculation of the worst deviation for
00306       // printing iteration information in the variable 'max_ratio'
00307       
00308       double max_ratio=0.0;
00309       double val=1.0, tol=1.0;
00310       {
00311         if (epsrel<0.0 || epsabs<0.0) {
00312           O2SCL_ERR2_RET("A tolerance is negative in ",
00313                          "gsl_fit::iterate().",gsl_ebadtol);
00314         }
00315         
00316         status=gsl_success;
00317 
00318         for (size_t i=0;i<x->size;i++) {
00319           double xi=gsl_vector_get(s->x,i);
00320           double dxi=gsl_vector_get(s->dx,i);
00321           double tolerance=epsabs+epsrel*fabs(xi);
00322           
00323           if (fabs(dxi)>tolerance) {
00324             status=gsl_continue;
00325           }
00326           if (fabs(dxi)/tolerance>max_ratio) {
00327             max_ratio=fabs(dxi)/tolerance;
00328             val=fabs(dxi);
00329             tol=tolerance;
00330           }
00331         }
00332       }
00333 
00334       if (this->verbose>0) {
00335         print_iter(npar,s->x,iter,val,tol);
00336       }
00337       
00338       // If requested, also test the gradient
00339 
00340       if (status!=gsl_continue && test_gradient) {
00341 
00342         // The equivalent of 
00343         // status=gsl_multifit_test_gradient(grad,epsabs);
00344         
00345         gsl_multifit_gradient(s->J,s->x,grad);
00346         double residual=0.0;
00347         for(size_t i=0;i<grad->size;i++) {
00348           residual+=fabs(gsl_vector_get(grad,i));
00349         }
00350         if (residual<epsabs) status=gsl_success;
00351         else status=gsl_continue;
00352         
00353         if (this->verbose>0) {
00354           print_iter(npar,s->x,iter,residual,epsabs);
00355         }
00356       }
00357       
00358     } while (status == gsl_continue && iter < max_iter);
00359     
00360     // Create covariance matrix and copy results to the 
00361     // user-specified vector
00362     gsl_matrix *gcovar=gsl_matrix_alloc(npar,npar);
00363     gsl_multifit_covar(s->J,0.0,gcovar);
00364     for(size_t i=0;i<npar;i++) {
00365       par[i]=gsl_vector_get(s->x,i);
00366       for(size_t j=0;j<npar;j++) {
00367         covar.set(i,j,gsl_matrix_get(gcovar,i,j));
00368       }
00369     }
00370     gsl_matrix_free(gcovar);
00371     
00372     // Compute chi squared
00373     chi2=gsl_blas_dnrm2(s->f);
00374     chi2*=chi2;
00375     
00376     // Free memory
00377     gsl_multifit_fdfsolver_free(s);
00378     gsl_vector_free(grad);
00379     
00380     return 0;
00381   }
00382   
00383   /// (default 500)
00384   int max_iter;
00385   
00386   /// (default 1.0e-4)
00387   double epsabs;
00388 
00389   /// (default 1.0e-4)
00390   double epsrel;
00391 
00392   /// If true, test the gradient also (default false)
00393   bool test_gradient;
00394 
00395   /** \brief Use the scaled routine if true (default true)
00396    */
00397   bool use_scaled;
00398 
00399   /// Return string denoting type ("gsl_fit")
00400   virtual const char *type() { return "gsl_fit"; }
00401 
00402 #ifndef DOXYGEN_INTERNAL
00403 
00404   protected:
00405 
00406   /// Print the progress in the current iteration
00407   virtual int print_iter(size_t nv, gsl_vector *x, 
00408                          int iter, double val, double lim) {
00409     
00410     char ch;
00411     
00412     if (this->verbose<=0) return 0;
00413     
00414     std::cout << "gsl_fit iteration: " << iter << std::endl;
00415     std::cout << " par: ";
00416     for(size_t j=0;j<nv;j++) {
00417       std::cout << gsl_vector_get(x,j) << " ";
00418     }
00419     std::cout << std::endl;
00420     std::cout << " Val: " << val
00421     << " Lim: " << lim << std::endl;
00422     if (this->verbose>1) {
00423       std::cout << "Press a key and type enter to continue. ";
00424       std::cin >> ch;
00425     }
00426     
00427     return 0;
00428   }
00429 
00430   /** \brief A structure for passing to the functions func(), dfunc(),
00431       and fdfunc()
00432   */
00433   typedef struct {
00434     /// The function object 
00435     func_t &f;
00436     /// The number 
00437     int ndat;
00438     /// The x values 
00439     vec_t *xdat;
00440     /// The y values 
00441     vec_t *ydat;
00442     /// The y uncertainties
00443     vec_t *yerr;
00444     /// The number of parameters
00445     int npar;
00446   } func_par;
00447 
00448   /// Evaluate the function
00449   static int func(const gsl_vector *x, void *pa, gsl_vector *f) {
00450     func_par *fp=(func_par *)pa;
00451     int i, j;
00452     double yi;
00453     ovector xp(fp->npar);
00454     for(j=0;j<fp->npar;j++) xp[j]=gsl_vector_get(x,j);
00455     for(i=0;i<fp->ndat;i++) {
00456       yi=fp->f(fp->npar,xp,(*fp->xdat)[i]);
00457       gsl_vector_set(f,i,(yi-(*fp->ydat)[i])/(*fp->yerr)[i]);
00458     }
00459 
00460     return 0;
00461   }
00462 
00463   /// Evaluate the jacobian
00464   static int dfunc(const gsl_vector *x, void *pa, gsl_matrix *jac) {
00465     func_par *fp=(func_par *)pa;
00466     int i, j;
00467     double yi, ylo, yhi, xtemp, eps=1.0e-4;
00468     ovector xp(fp->npar);
00469   
00470     for(j=0;j<fp->npar;j++) xp[j]=gsl_vector_get(x,j);
00471     for(j=0;j<fp->npar;j++) {
00472       for(i=0;i<fp->ndat;i++) {
00473         xtemp=xp[j];
00474         xp[j]+=eps;
00475         yi=fp->f(fp->npar,xp,(*fp->xdat)[i]);
00476         yhi=(yi-(*fp->ydat)[i])/(*fp->yerr)[i];
00477         xp[j]=xtemp;
00478         yi=fp->f(fp->npar,xp,(*fp->xdat)[i]);
00479         ylo=(yi-(*fp->ydat)[i])/(*fp->yerr)[i];
00480         gsl_matrix_set(jac,i,j,(yhi-ylo)/eps);
00481       }
00482     }
00483 
00484     return 0;
00485   }
00486 
00487   /// Evaluate the function and the jacobian
00488   static int fdfunc(const gsl_vector *x, void *pa, gsl_vector *f,
00489                     gsl_matrix *jac) {
00490     func(x,pa,f);
00491     dfunc(x,pa,jac);
00492     return 0;
00493   }
00494 
00495 #endif
00496   
00497   };
00498 
00499 #ifndef DOXYGENP
00500 }
00501 #endif
00502 
00503 #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.