Object-oriented Scientific Computing Library: Version 0.910
cern_mroot.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 #ifndef O2SCL_CERN_MROOT_H
00024 #define O2SCL_CERN_MROOT_H
00025 
00026 #include <string>
00027 
00028 #include <o2scl/array.h>
00029 #include <o2scl/mroot.h>
00030 #include <o2scl/umatrix_tlate.h>
00031 
00032 #ifndef DOXYGENP
00033 namespace o2scl {
00034 #endif
00035 
00036   /** \brief Multi-dimensional mroot-finding routine (CERNLIB)
00037         
00038       If \f$ x_i \f$ denotes the current iteration, and \f$
00039       x^{\prime}_i \f$ denotes the previous iteration, then the
00040       calculation is terminated if either of the following tests is
00041       successful
00042       \f[
00043       1:\quad \mathrm{max} | f_i(x) | \leq \mathrm{tol\_rel}
00044       \f]
00045       \f[
00046       2:\quad \mathrm{max} |x_i-x^{\prime}_i| \leq
00047       \mathrm{tol\_abs} \times \mathrm{max} | x_i |
00048       \f]
00049 
00050       This routine treats the functions specified as a \ref mm_funct
00051       object slightly differently than \ref gsl_mroot_hybrids. First
00052       the equations should be numbered (as much as is possible) in
00053       order of increasing nonlinearity. Also, instead of calculating
00054       all of the equations on each function call, only the equation
00055       specified by the \c size_t parameter needs to be calculated. If
00056       the equations are specified as
00057       \f{eqnarray*}
00058       &0=f_0(x_0,x_1,...,x_{n-1})& \\
00059       &0=f_1(x_0,x_1,...,x_{n-1})& \\
00060       &...& \\
00061       &0=f_{n-1}(x_0,x_1,...,x_{n-1})& \\
00062       \f}
00063       then when the \c size_t argument is given as \c i, then
00064       only the function \f$ f_i \f$ needs to be calculated.
00065 
00066       \warning This code has not been checked to ensure that it cannot
00067       fail to solve the equations without calling the error handler
00068       and returning a non-zero value. Until then, the solution may
00069       need to be checked explicitly by the caller.
00070 
00071       There is an example for the usage of the multidimensional solver
00072       classes given in <tt>examples/ex_mroot.cpp</tt>, see \ref
00073       ex_mroot_sect .
00074 
00075       \future Modify this so it handles functions which return
00076       non-zero values.
00077       \future Move some of the memory allocation out of msolve()
00078       \future Give the user access to the number of function
00079       calls
00080       \future Rename nier6, nier7, and nier8 to something sensible.
00081       \future It may be that the \o2 native Householder transformations
00082       should be used here instead of the inline version given here.
00083 
00084       Based on the CERNLIB routines RSNLEQ and DSNLEQ, which was 
00085       based on \ref More79 and \ref More80 and is documented at
00086       http://wwwasdoc.web.cern.ch/wwwasdoc/shortwrupsdir/c201/top.html
00087   */
00088   template<class func_t=mm_funct<>, 
00089     class vec_t=ovector_base, class alloc_vec_t=ovector, 
00090     class alloc_t=ovector_alloc,    
00091     class jfunc_t=jac_funct<vec_t,omatrix_base> > 
00092     class cern_mroot : public mroot<func_t,vec_t,jfunc_t> {
00093     
00094 #ifndef DOXYGEN_INTERNAL
00095 
00096   protected:
00097     
00098   /// Memory allocator for objects of type \c alloc_vec_t
00099   alloc_t ao;
00100 
00101   /// Desc
00102   umatrix w;
00103 
00104 #endif
00105     
00106   public:
00107     
00108   cern_mroot() {
00109     info=0;
00110     eps=0.1490116119384766e-07;
00111     scale=10.0;
00112     maxf=0;
00113         
00114     int tmp_mpt[289]=
00115       {0,1,2,3,3,3,4,4,4,5,5,5,5,6,6,6,6,7,7,7,7,8,8,8,8,9,9,9,9,9,10,
00116        10,10,10,10,11,11,11,11,11,12,12,12,12,12,13,13,13,13,13,14,14,
00117        14,14,14,15,15,15,15,15,15,16,16,16,16,16,16,17,17,17,17,17,18,
00118        18,18,18,18,18,19,19,19,19,19,19,20,20,20,20,20,20,21,21,21,21,
00119        21,21,21,22,22,22,22,22,22,23,23,23,23,23,23,24,24,24,24,24,24,
00120        24,25,25,25,25,25,25,26,26,26,26,26,26,26,27,27,27,27,27,27,28,
00121        28,28,28,28,28,28,29,29,29,29,29,29,29,30,30,30,30,30,30,30,31,
00122        31,31,31,31,31,31,32,32,32,32,32,32,32,33,33,33,33,33,33,33,34,
00123        34,34,34,34,34,34,35,35,35,35,35,35,35,36,36,36,36,36,36,36,37,
00124        37,37,37,37,37,37,37,38,38,38,38,38,38,38,39,39,39,39,39,39,39,
00125        40,40,40,40,40,40,40,40,41,41,41,41,41,41,41,42,42,42,42,42,42,
00126        42,42,43,43,43,43,43,43,43,44,44,44,44,44,44,44,44,45,45,45,45,
00127        45,45,45,45,46,46,46,46,46,46,46,47,47,47,47,47,47,47,47,48,48,
00128        48,48,48,48,48,48};
00129     // The for loop is just a convenient way of using
00130     // aggregate initialization
00131     for(size_t i=0;i<289;i++) mpt[i]=tmp_mpt[i];
00132   }
00133       
00134   /** \brief Get the value of \c INFO from the last call to msolve()
00135           
00136       The value of info is assigned according to the following list.
00137       The values 1-8 are the standard behavior from CERNLIB.
00138       0 - The function solve() has not been called.
00139       1 - Test 1 was successful. \n
00140       2 - Test 2 was successful. \n
00141       3 - Both tests were successful. \n
00142       4 - Number of iterations is greater than cern_mroot_root::maxf. \n
00143       5 - Approximate (finite difference) Jacobian matrix is
00144       singular. \n
00145       6 - Iterations are not making good progress. \n
00146       7 - Iterations are diverging. \n
00147       8 - Iterations are converging, but either cern_mroot_root::tol_abs
00148       is too small or the Jacobian is nearly singular
00149       or the variables are badly scaled. \n
00150       9 - Either root::tol_rel or root::tol_abs is not greater than zero
00151       or the specified number of variables is \f$ \leq 0\f$.
00152 
00153       The return values returned by msolve() corresponding
00154       to the values of \c INFO above are
00155       1 - \ref gsl_success
00156       2 - \ref gsl_success
00157       3 - \ref gsl_success
00158       4 - \ref gsl_emaxiter
00159       5 - \ref gsl_esing
00160       6 - \ref gsl_enoprog
00161       7 - \ref gsl_erunaway
00162       8 - \ref gsl_efailed
00163       9 - \ref gsl_einval
00164   */
00165   int get_info() { return info; }
00166 
00167   /** \brief Get the a string corresponding to the integer returned
00168       by \ref cern_mroot::get_info().
00169   */
00170   std::string get_info_string() {
00171     if (info==0) {
00172       return "The function solve() has not been called.";
00173     } else if (info==1) {
00174       return "Test 1 was successful.";
00175     } else if (info==2) {
00176       return "Test 2 was successful.";
00177     } else if (info==3) {
00178       return "Both tests were successful.";
00179     } else if (info==4) {
00180       return "Number of iterations is greater than maxf.";
00181     } else if (info==5) {
00182       return "Approximate Jacobian matrix is singular.";
00183     } else if (info==6) {
00184       return "Iterations are not making good progress.";
00185     } else if (info==7) {
00186       return "Iterations are diverging.";
00187     } else if (info==8) {
00188       return "Either tol_abs is too small or Jacobian is nearly singular.";
00189     } else if (info==9) {
00190       return "Either tol_rel, tol_abs, or the number of vars is not positive.";
00191     }
00192   }
00193 
00194   /** \brief Maximum number of function evaluations
00195 
00196       If \f$ \mathrm{maxf}\leq 0 \f$ , then \f$ 50(\mathrm{nv}+3) \f$ 
00197       (which is the CERNLIB default) is used.  The default value of
00198       \c maxf is zero which then implies the default from CERNLIB.
00199   */
00200   int maxf;
00201 
00202   /// Return the type, \c "cern_mroot".
00203   virtual const char *type() { return "cern_mroot"; }
00204 
00205   /** \brief The original scale parameter from CERNLIB (default 10.0)
00206    */
00207   double scale;
00208     
00209   /** \brief The smallest floating point number
00210       (default \f$ \sim 1.49012 \times 10^{-8} \f$ )
00211 
00212       The original prescription from CERNLIB for \c eps is
00213       given below:
00214       \verbatim
00215       #if !defined(CERNLIB_DOUBLE)
00216       PARAMETER (EPS =  0.84293 69702 17878 97282 52636 392E-07)
00217       #endif
00218       #if defined(CERNLIB_IBM)
00219       PARAMETER (EPS =  0.14901 16119 38476 562D-07)
00220       #endif
00221       #if defined(CERNLIB_VAX)
00222       PARAMETER (EPS =  0.37252 90298 46191 40625D-08)
00223       #endif
00224       #if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE))
00225       PARAMETER (EPS =  0.14901 16119 38476 600D-07)
00226       #endif
00227       \endverbatim
00228   */
00229   double eps;
00230     
00231   /// Solve \c func using \c x as an initial guess, returning \c x.
00232   virtual int msolve(size_t nvar, vec_t &x, func_t &func) {
00233 
00234     int mopt=0, i, j, k, it=0;
00235     double fky;
00236 
00237     this->last_conv=0;
00238         
00239     int lmaxf;
00240     if (maxf<=0) lmaxf=50*(nvar+3);
00241     else lmaxf=maxf;
00242   
00243     info=0;
00244   
00245     if (nvar<=0 || this->tol_rel<=0.0 || this->tol_abs<=0.0) {
00246       info=9;
00247       std::string str="Invalid value of tol_rel ("+dtos(this->tol_rel)+
00248         "), tol_abs ("+dtos(this->tol_abs)+"), or nvar ("+itos(nvar)+
00249         " in cern_mroot::msolve().";
00250       O2SCL_ERR_RET(str.c_str(),gsl_einval);
00251     }
00252   
00253     // Find optimal value of mopt for iterative refinement
00254 
00255     if (nvar<=288) mopt=mpt[nvar-1];
00256     else {
00257       bool done=false;
00258       double h=0.0;
00259       for(i=49;i<=((int)nvar) && done==false;i++) {
00260         double temp=log(((double)i)+1.0)/((double)(nvar+2*i+1));
00261         if (temp<h) {
00262           mopt=i-1;
00263           done=true;
00264         }
00265         if (!done) h=temp;
00266       }
00267     }
00268   
00269     int iflag=0, numf=0, nfcall=0, nier6=-1, nier7=-1, nier8=0;
00270     double fnorm=0.0, difit=0.0, xnorm=0.0;
00271     bool set=false;
00272 
00273     for(i=0;i<((int)nvar);i++) {
00274       if (xnorm<fabs(x[i])) {
00275         xnorm=fabs(x[i]);
00276         set=true;
00277       }
00278     }
00279     double delta=scale*xnorm;
00280     if (set==false) delta=scale;
00281 
00282     w.allocate(nvar,nvar);
00283 
00284     alloc_vec_t f, w0, w1, w2;
00285     ao.allocate(f,nvar);
00286     ao.allocate(w0,nvar);
00287     ao.allocate(w1,nvar);
00288     ao.allocate(w2,nvar);
00289 
00290     bool solve_done=false;
00291     while (solve_done==false) {
00292       bool bskip=false;
00293     
00294       int nsing=nvar;
00295       double fnorm1=fnorm;
00296       double difit1=difit;
00297       fnorm=0.0;
00298     
00299       // Compute step H for the divided difference which approximates
00300       // the K-th row of the Jacobian matrix
00301     
00302       double h=eps*xnorm;
00303       if (h==0.0) h=eps;
00304       for(j=0;j<((int)nvar);j++) {
00305         for(i=0;i<((int)nvar);i++) {
00306           w[j][i]=0.0;
00307         }
00308         w[j][j]=h;
00309         w1[j]=x[j];
00310       }
00311 
00312       // Enter a subiteration
00313     
00314       for(k=0;k<((int)nvar);k++) {
00315         iflag=k;
00316             
00317         func(iflag,w1,f);
00318             
00319         fky=f[k];
00320         nfcall++;
00321         numf=(int)(((double)nfcall)/((double)nvar));
00322         if (fnorm<fabs(fky)) fnorm=fabs(fky);
00323       
00324         // Compute the K-th row of the Jacobian matrix
00325 
00326         for(j=k;j<((int)nvar);j++) {
00327           for(i=0;i<((int)nvar);i++) {
00328             w2[i]=w1[i]+w[j][i];
00329           }
00330 
00331           func(iflag,w2,f);
00332 
00333           double fkz=f[k];
00334           nfcall++;
00335           numf=(int)(((double)nfcall)/((double)nvar));
00336           w0[j]=fkz-fky;
00337         }
00338 
00339         f[k]=fky;
00340       
00341         // Compute the Householder transformation to reduce the K-th row
00342         // of the Jacobian matrix to a multiple of the K-th unit vector
00343 
00344         double eta=0.0;
00345         for(i=k;i<((int)nvar);i++) if (eta<fabs(w0[i])) eta=fabs(w0[i]);
00346         
00347         if (eta!=0.0) {
00348           nsing--;
00349           double sknorm=0.0;
00350           for(i=k;i<((int)nvar);i++) {
00351             w0[i]/=eta;
00352             sknorm+=w0[i]*w0[i];
00353           }
00354           sknorm=sqrt(sknorm);
00355           if (w0[k]<0.0) sknorm=-sknorm;
00356           w0[k]+=sknorm;
00357           
00358           // Apply the transformation
00359 
00360           for(i=0;i<((int)nvar);i++) {
00361             w2[i]=0.0;
00362           }
00363           for(j=k;j<((int)nvar);j++) {
00364             for(i=0;i<((int)nvar);i++) {
00365               w2[i]+=w0[j]*w[j][i];
00366             }
00367           }
00368           for(j=k;j<((int)nvar);j++) {
00369             double temp=w0[j]/(sknorm*w0[k]);
00370             for(i=0;i<((int)nvar);i++) {
00371               w[j][i]-=temp*w2[i];
00372             }
00373           }
00374 
00375           // Compute the subiterate
00376 
00377           w0[k]=sknorm*eta;
00378           double temp2=fky/w0[k];
00379           if (h*fabs(temp2)>delta) 
00380             temp2=(temp2>=0.0) ? fabs(delta/h) : -fabs(delta/h);
00381           for(i=0;i<((int)nvar);i++) {
00382             w1[i]+=temp2*w[k][i];
00383           }
00384         }
00385       }
00386 
00387       // Compute the norms of the iterate and correction vector
00388 
00389       xnorm=0.0;
00390       difit=0.0;
00391       for(i=0;i<((int)nvar);i++) {
00392         if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]);
00393         if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]);
00394         x[i]=w1[i];
00395       }
00396 
00397       // Update the bound on the correction vector
00398 
00399       if(delta<scale*xnorm) delta=scale*xnorm;
00400     
00401       // Determine the progress of the iteration
00402 
00403       bool lcv=(fnorm<fnorm1 && difit<difit1 && nsing==0);
00404       nier6++;
00405       nier7++;
00406       nier8++;
00407       if (lcv) nier6=0;
00408       if (fnorm<fnorm1 || difit<difit1) nier7=0;
00409       if (difit>eps*xnorm) nier8=0;
00410 
00411       // Print iteration information
00412           
00413       if (this->verbose>0) {
00414         print_iter(nvar,x,f,++it,fnorm,this->tol_rel,"cern_mroot");
00415       }
00416     
00417       // Tests for convergence
00418 
00419       if (fnorm<=this->tol_rel) info=1;
00420       if (difit<=this->tol_abs*xnorm && lcv) info=2;
00421       if (fnorm<=this->tol_rel && info==2) info=3;
00422       if (info!=0) {
00423 
00424         w.free();
00425         ao.free(f);
00426         ao.free(w0);
00427         ao.free(w1);
00428         ao.free(w2);
00429 
00430         return 0;
00431       }
00432 
00433       // Tests for termination
00434 
00435       if (numf>=lmaxf) {
00436         info=4;
00437         this->last_conv=gsl_emaxiter;
00438 
00439         w.free();
00440         ao.free(f);
00441         ao.free(w0);
00442         ao.free(w1);
00443         ao.free(w2);
00444         O2SCL_CONV_RET("Too many iterations in cern_mroot::msolve().",
00445                        gsl_emaxiter,this->err_nonconv);
00446       }
00447       if (nsing==((int)nvar)) {
00448         info=5;
00449         this->last_conv=gsl_emaxiter;
00450 
00451         w.free();
00452 
00453         ao.free(f);
00454         ao.free(w0);
00455         ao.free(w1);
00456         ao.free(w2);
00457 
00458         O2SCL_CONV_RET("Jacobian matrix singular in cern_mroot::msolve().",
00459                        gsl_esing,this->err_nonconv);
00460       }
00461       if (nier6==5) {
00462         info=6;
00463         this->last_conv=gsl_enoprog;
00464 
00465         w.free();
00466         ao.free(f);
00467         ao.free(w0);
00468         ao.free(w1);
00469         ao.free(w2);
00470 
00471         O2SCL_CONV_RET("No progress in cern_mroot::msolve().",
00472                        gsl_enoprog,this->err_nonconv);
00473       }
00474       if (nier7==3) {
00475         info=7;
00476         this->last_conv=gsl_erunaway;
00477 
00478         w.free();
00479         ao.free(f);
00480         ao.free(w0);
00481         ao.free(w1);
00482         ao.free(w2);
00483 
00484         O2SCL_CONV_RET("Iterations diverging in cern_mroot::msolve().",
00485                        gsl_erunaway,this->err_nonconv);
00486       }
00487       if (nier8==4) {
00488         info=8;
00489 
00490         this->last_conv=gsl_efailed;
00491 
00492         w.free();
00493         ao.free(f);
00494         ao.free(w0);
00495         ao.free(w1);
00496         ao.free(w2);
00497 
00498         std::string s="Variable tol_abs too small, J singular, or bad ";
00499         s+="scaling in cern_mroot::msolve().";
00500         O2SCL_CONV_RET(s.c_str(),gsl_efailed,this->err_nonconv);
00501       }
00502 
00503       // Exit if necessary
00504 
00505       if (info!=0) {
00506 
00507         w.free();
00508         ao.free(f);
00509         ao.free(w0);
00510         ao.free(w1);
00511         ao.free(w2);
00512         
00513         O2SCL_ERR_RET("Unspecified error in cern_mroot::msolve().",
00514                       gsl_efailed);
00515       }
00516 
00517       if (!((!lcv) || difit>0.05*xnorm)) {
00518         // 8/20/08: Could this just be rewritten? 
00519         // if (lcv && difit<=0.05*xnorm)
00520       
00521         // Iterative refinement (if the iteration is converging)
00522 
00523         for(int m=2;m<=mopt && bskip==false;m++) {
00524           fnorm1=fnorm;
00525           fnorm=0.0;
00526           for(k=0;k<((int)nvar) && bskip==false;k++) {
00527             iflag=k;
00528 
00529             func(iflag,w1,f);
00530           
00531             fky=f[k];
00532             nfcall++;
00533             numf=(int)(((double)nfcall)/((double)nvar));
00534 
00535             if (fnorm<fabs(fky)) fnorm=fabs(fky);
00536         
00537             // Iterative refinement is terminated if it does not give a
00538             // reduction on residuals
00539           
00540             if (fnorm>=fnorm1) {
00541               fnorm=fnorm1;
00542               bskip=true;
00543             } 
00544 
00545             if (!bskip) {
00546               double temp3=fky/w0[k];
00547             
00548               for(i=0;i<((int)nvar);i++) {
00549                 w1[i]+=temp3*w[k][i];
00550               }
00551             }
00552           }
00553         
00554           if (!bskip) {
00555 
00556             // Compute the norms of the iterate and correction vector
00557 
00558             xnorm=0.0;
00559             difit=0.0;
00560 
00561             for(i=0;i<((int)nvar);i++) {
00562               if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]);
00563               if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]);
00564               x[i]=w1[i];
00565             }
00566 
00567             // Stopping criteria for iterative refinement
00568 
00569             if (fnorm<=this->tol_rel) info=1;
00570             if (difit<=xnorm*this->tol_abs) info=2;
00571             if (fnorm<=this->tol_rel && info==2) info=3;
00572             if (numf>=lmaxf && info==0) {
00573               info=4;
00574               this->last_conv=gsl_emaxiter;
00575               
00576               w.free();
00577               ao.free(f);
00578               ao.free(w0);
00579               ao.free(w1);
00580               ao.free(w2);
00581               
00582               O2SCL_CONV_RET("Too many iterations in cern_mroot::msolve().",
00583                              gsl_emaxiter,this->err_nonconv);
00584             }
00585 
00586             if (info!=0) {
00587                 
00588               w.free();
00589               ao.free(f);
00590               ao.free(w0);
00591               ao.free(w1);
00592               ao.free(w2);
00593 
00594               return 0;
00595             }
00596           }
00597         }
00598       }
00599     }
00600       
00601     w.free();
00602     ao.free(f);
00603     ao.free(w0);
00604     ao.free(w1);
00605     ao.free(w2);
00606         
00607     return 0;
00608   }
00609 
00610 #ifndef DOXYGEN_INTERNAL
00611 
00612   protected:
00613       
00614   /// Internal storage for the value of \c info
00615   int info;
00616       
00617   /// Store the number of function evaluations
00618   int mpt[289];
00619       
00620 #endif
00621       
00622   };
00623   
00624 
00625 #ifndef DOXYGENP
00626 }
00627 #endif
00628 
00629 #endif
00630 
 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.