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
,
O2scl Sourceforge Project Page