cern_mroot_root.h

00001 /*
00002   -------------------------------------------------------------------
00003   
00004   Copyright (C) 2006, 2007, 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_CERN_MROOT_ROOT_H
00024 #define O2SCL_CERN_MROOT_ROOT_H
00025 
00026 #include <o2scl/root.h>
00027 
00028 #ifndef DOXYGENP
00029 namespace o2scl {
00030 #endif
00031 
00032   /** 
00033       \brief One-dimensional version of cern_mroot
00034       
00035       This one-dimensional root-finding routine, based on cern_mroot,
00036       is probably slower than the more typical 1-d routines, but also
00037       tends to converge for a larger class of functions than
00038       cern_root, gsl_root_brent, or gsl_root_stef. It has been
00039       modified from cern_mroot and slightly optimized, but has the
00040       same basic behavior.
00041 
00042       If \f$ x_i \f$ denotes the current iteration, and \f$
00043       x^{\prime}_i \f$ denotes the previous iteration, then the
00044       calculation is terminated if either (or both) of the following
00045       tests is successful
00046       \f[
00047       1:\quad \mathrm{max} | f_i(x) | \leq \mathrm{tolf}
00048       \f]
00049       \f[
00050       2:\quad \mathrm{max} |x_i-x^{\prime}_i| \leq
00051       \mathrm{tolx} \times \mathrm{max} | x_i |
00052       \f]
00053       
00054       \note This code has not been checked to ensure that it cannot
00055       fail to solve the equations without calling the error handler
00056       and returning a non-zero value. Until then, the solution may
00057       need to be checked explicitly by the caller.
00058 
00059       \future Double-check this class to make sure it cannot fail
00060       while returning 0 for success.
00061   */
00062   template<class param_t, class func_t=funct<param_t> > 
00063     class cern_mroot_root : public root<param_t,func_t> {
00064     
00065     public:
00066     
00067     cern_mroot_root() {
00068       info=0;
00069       eps=0.1490116119384766e-07;
00070       scale=10.0;
00071       maxf=0;
00072     }
00073 
00074     virtual ~cern_mroot_root() {}
00075     
00076     /** \brief Get the value of \c INFO from the last call to solve() 
00077         (default 0)
00078         
00079         The value of info is assigned according to the following list.
00080         The values 1-8 are the standard behavior from CERNLIB.
00081         0 - The function solve() has not been called.
00082         1 - Test 1 was successful. \n
00083         2 - Test 2 was successful. \n
00084         3 - Both tests were successful. \n
00085         4 - Number of iterations is greater than cern_mroot_root::maxf. \n
00086         5 - Approximate (finite difference) Jacobian matrix is
00087         singular. \n
00088         6 - Iterations are not making good progress. \n
00089         7 - Iterations are diverging. \n
00090         8 - Iterations are converging, but either cern_mroot_root::tolx
00091         is too small or the Jacobian is nearly singular
00092         or the variables are badly scaled. \n
00093         9 - Either root::tolf or root::tolx is not greater than zero.
00094 
00095     */
00096     int get_info() { return info; }
00097 
00098     /** 
00099         \brief Maximum number of function evaluations
00100         
00101         If \f$ \mathrm{maxf}\leq 0 \f$, then 200 (which is the CERNLIB
00102         default) is used.  The default value of \c maxf is zero which
00103         then implies the default from CERNLIB.
00104     */
00105     int maxf;
00106 
00107     /// Return the type, \c "cern_mroot_root".
00108     virtual const char *type() { return "cern_mroot_root"; }
00109 
00110     /** \brief The original scale parameter from CERNLIB (default 10.0)
00111      */
00112     double scale;
00113     
00114     /** \brief The smallest floating point number
00115         (default \f$ \sim 1.49012 \times 10^{-8} \f$)
00116 
00117         The original prescription from CERNLIB for \c eps is
00118         given below:
00119         \verbatim
00120         #if !defined(CERNLIB_DOUBLE)
00121         PARAMETER (EPS =  0.84293 69702 17878 97282 52636 392E-07)
00122         #endif
00123         #if defined(CERNLIB_IBM)
00124         PARAMETER (EPS =  0.14901 16119 38476 562D-07)
00125         #endif
00126         #if defined(CERNLIB_VAX)
00127         PARAMETER (EPS =  0.37252 90298 46191 40625D-08)
00128         #endif
00129         #if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
00130         PARAMETER (EPS =  0.14901 16119 38476 600D-07)
00131         #endif
00132         \endverbatim
00133     */
00134     double eps;
00135     
00136     /// Solve \c func using \c x as an initial guess, returning \c x.
00137     virtual int solve(double &ux, param_t &pa, func_t &func) {
00138       
00139       int it=0;
00140       double fky;
00141         
00142       int lmaxf;
00143       if (maxf<=0) lmaxf=200;
00144       else lmaxf=maxf;
00145       
00146       info=0;
00147   
00148       if (this->tolf<=0.0 || this->tolx<=0.0) {
00149         info=9;
00150         set_err_ret("Invalid arguments in cern_mroot_root::solve().",
00151                     gsl_efailed);
00152       }
00153   
00154       int iflag=0, numf=0, nfcall=0, nier6=-1, nier7=-1, nier8=0;
00155       double fnorm=0.0, difit=0.0, xnorm=0.0;
00156       bool set=false;
00157         
00158       if (xnorm<fabs(ux)) {
00159         xnorm=fabs(ux);
00160         set=true;
00161       }
00162 
00163       double delta=scale*xnorm;
00164       if (set==false) delta=scale;
00165         
00166       double wmat, farr, w0arr, w1arr, w2arr;
00167         
00168       bool solve_done=false;
00169       while (solve_done==false) {
00170         bool bskip=false;
00171     
00172         int nsing=1;
00173         double fnorm1=fnorm;
00174         double difit1=difit;
00175         fnorm=0.0;
00176     
00177         // Compute step H for the divided difference which approximates
00178         // the K-th row of the Jacobian matrix
00179         
00180         double h=eps*xnorm;
00181         if (h==0.0) h=eps;
00182 
00183         wmat=h;
00184         w1arr=ux;
00185 
00186         // Enter a subiteration
00187     
00188         iflag=0;
00189 
00190         func(w1arr,farr,pa);
00191 
00192         fky=farr;
00193         nfcall++;
00194         numf=nfcall;
00195         if (fnorm<fabs(fky)) fnorm=fabs(fky);
00196       
00197         // Compute the K-th row of the Jacobian matrix
00198 
00199         w2arr=w1arr+wmat;
00200             
00201         func(w2arr,farr,pa);
00202             
00203         double fkz=farr;
00204         nfcall++;
00205         numf=nfcall;
00206         w0arr=fkz-fky;
00207             
00208         farr=fky;
00209       
00210         // Compute the Householder transformation to reduce the K-th row
00211         // of the Jacobian matrix to a multiple of the K-th unit vector
00212 
00213         double eta=0.0;
00214         if (eta<fabs(w0arr)) eta=fabs(w0arr);
00215         
00216         if (eta!=0.0) {
00217           nsing--;
00218           double sknorm=0.0;
00219               
00220           w0arr/=eta;
00221           sknorm+=w0arr*w0arr;
00222 
00223           sknorm=sqrt(sknorm);
00224           if (w0arr<0.0) sknorm=-sknorm;
00225           w0arr+=sknorm;
00226           
00227           // Apply the transformation
00228 
00229           w2arr=0.0;
00230           w2arr+=w0arr*wmat;
00231           double temp=w0arr/(sknorm*w0arr);
00232           wmat-=temp*w2arr;
00233 
00234           // Compute the subiterate
00235 
00236           w0arr=sknorm*eta;
00237           double temp2=fky/w0arr;
00238           if (h*fabs(temp2)>delta) 
00239             temp2=(temp2>=0.0) ? fabs(delta/h) : -fabs(delta/h);
00240           w1arr+=temp2*wmat;
00241         }
00242 
00243         // Compute the norms of the iterate and correction vector
00244 
00245         xnorm=0.0;
00246         difit=0.0;
00247           
00248         if (xnorm<fabs(w1arr)) xnorm=fabs(w1arr);
00249         if (difit<fabs(ux-w1arr)) difit=fabs(ux-w1arr);
00250         ux=w1arr;
00251           
00252         // Update the bound on the correction vector
00253 
00254         if(delta<scale*xnorm) delta=scale*xnorm;
00255     
00256         // Determine the progress of the iteration
00257 
00258         bool lcv=(fnorm<fnorm1 && difit<difit1 && nsing==0);
00259         nier6++;
00260         nier7++;
00261         nier8++;
00262         if (lcv) nier6=0;
00263         if (fnorm<fnorm1 || difit<difit1) nier7=0;
00264         if (difit>eps*xnorm) nier8=0;
00265 
00266         // Print iteration information
00267           
00268         if (this->verbose>0) print_iter(ux,farr,++it,fnorm,this->tolf,
00269                                         "cern_mroot_root");
00270         
00271         // Tests for convergence
00272 
00273         if (fnorm<=this->tolf) info=1;
00274         if (difit<=this->tolx*xnorm && lcv) info=2;
00275         if (fnorm<=this->tolf && info==2) info=3;
00276         if (info!=0) {
00277           return 0;
00278         }
00279 
00280         // Tests for termination
00281 
00282         if (numf>=lmaxf) {
00283           info=4;
00284           set_err_ret("Too many iterations in cern_mroot_root::solve().",
00285                       gsl_emaxiter);
00286         }
00287         if (nsing==1) {
00288           info=5;
00289           set_err_ret("Jacobian matrix singular in cern_mroot_root::solve().",
00290                       gsl_esing);
00291         }
00292         if (nier6==5) {
00293           info=6;
00294           set_err_ret("No progress in cern_mroot_root::solve().",
00295                       gsl_enoprog);
00296         }
00297         if (nier7==3) {
00298           info=7;
00299           set_err_ret("Iterations diverging in cern_mroot_root::solve().",
00300                       gsl_erunaway);
00301         }
00302         if (nier8==4) {
00303           info=8;
00304           std::string s2="Variable tolx too small, J singular, ";
00305           s2+="or bad scaling in cerm_mroot_root::solve().";
00306           set_err(s2.c_str(),gsl_efailed);
00307         }
00308 
00309         // Exit if necessary
00310 
00311         if (info!=0) return gsl_efailed;
00312           
00313       }
00314         
00315       return 0;
00316     }
00317       
00318 #ifndef DOXYGEN_INTERNAL
00319 
00320     protected:
00321       
00322     /// Internal storage for the value of \c info
00323     int info;
00324       
00325 #endif
00326       
00327   };
00328   
00329 #ifndef DOXYGENP
00330   template<> int io_tlate<cern_mroot_root<void *,funct<void *> > >::input
00331     (cinput *co, in_file_format *ins, 
00332      cern_mroot_root<void *, funct<void *> > *ro);
00333   template<> int io_tlate<cern_mroot_root<void *,funct<void *> > >::output
00334     (coutput *co, out_file_format *outs, 
00335      cern_mroot_root<void *, funct<void *> > *ro);
00336   template<> const char *io_tlate<cern_mroot_root<void *,
00337     funct<void *> > >::type();
00338 #endif
00339   
00340   typedef io_tlate<cern_mroot_root<void *,funct<void *> > > 
00341     cern_mroot_root_io_type;
00342   
00343 #ifndef DOXYGENP
00344 }
00345 #endif
00346   
00347 #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