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