![]() |
Object-oriented Scientific Computing Library: Version 0.910
|
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
Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).