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

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