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 00231 int mopt=0, i, j, k, it=0; 00232 double fky; 00233 00234 this->last_conv=0; 00235 00236 int lmaxf; 00237 if (maxf<=0) lmaxf=50*(nvar+3); 00238 else lmaxf=maxf; 00239 00240 info=0; 00241 00242 if (nvar<=0 || this->tolf<=0.0 || this->tolx<=0.0) { 00243 info=9; 00244 O2SCL_ERR2_RET("Invalid value of tolf, tolx, or nvar ", 00245 "in cern_mroot::msolve().",gsl_einval); 00246 } 00247 00248 // Find optimal value of mopt for iterative refinement 00249 00250 if (nvar<=288) mopt=mpt[nvar-1]; 00251 else { 00252 bool done=false; 00253 double h=0.0; 00254 for(i=49;i<=((int)nvar) && done==false;i++) { 00255 double temp=log(((double)i)+1.0)/((double)(nvar+2*i+1)); 00256 if (temp<h) { 00257 mopt=i-1; 00258 done=true; 00259 } 00260 if (!done) h=temp; 00261 } 00262 } 00263 00264 int iflag=0, numf=0, nfcall=0, nier6=-1, nier7=-1, nier8=0; 00265 double fnorm=0.0, difit=0.0, xnorm=0.0; 00266 bool set=false; 00267 00268 for(i=0;i<((int)nvar);i++) { 00269 if (xnorm<fabs(x[i])) { 00270 xnorm=fabs(x[i]); 00271 set=true; 00272 } 00273 } 00274 double delta=scale*xnorm; 00275 if (set==false) delta=scale; 00276 00277 double **w=new_2d_array<double>(nvar,nvar); 00278 00279 alloc_vec_t f, w0, w1, w2; 00280 ao.allocate(f,nvar); 00281 ao.allocate(w0,nvar); 00282 ao.allocate(w1,nvar); 00283 ao.allocate(w2,nvar); 00284 00285 bool solve_done=false; 00286 while (solve_done==false) { 00287 bool bskip=false; 00288 00289 int nsing=nvar; 00290 double fnorm1=fnorm; 00291 double difit1=difit; 00292 fnorm=0.0; 00293 00294 // Compute step H for the divided difference which approximates 00295 // the K-th row of the Jacobian matrix 00296 00297 double h=eps*xnorm; 00298 if (h==0.0) h=eps; 00299 for(j=0;j<((int)nvar);j++) { 00300 for(i=0;i<((int)nvar);i++) { 00301 w[j][i]=0.0; 00302 } 00303 w[j][j]=h; 00304 w1[j]=x[j]; 00305 } 00306 00307 // Enter a subiteration 00308 00309 for(k=0;k<((int)nvar);k++) { 00310 iflag=k; 00311 00312 func(iflag,w1,f,pa); 00313 00314 fky=f[k]; 00315 nfcall++; 00316 numf=(int)(((double)nfcall)/((double)nvar)); 00317 if (fnorm<fabs(fky)) fnorm=fabs(fky); 00318 00319 // Compute the K-th row of the Jacobian matrix 00320 00321 for(j=k;j<((int)nvar);j++) { 00322 for(i=0;i<((int)nvar);i++) { 00323 w2[i]=w1[i]+w[j][i]; 00324 } 00325 00326 func(iflag,w2,f,pa); 00327 00328 double fkz=f[k]; 00329 nfcall++; 00330 numf=(int)(((double)nfcall)/((double)nvar)); 00331 w0[j]=fkz-fky; 00332 } 00333 00334 f[k]=fky; 00335 00336 // Compute the Householder transformation to reduce the K-th row 00337 // of the Jacobian matrix to a multiple of the K-th unit vector 00338 00339 double eta=0.0; 00340 for(i=k;i<((int)nvar);i++) if (eta<fabs(w0[i])) eta=fabs(w0[i]); 00341 00342 if (eta!=0.0) { 00343 nsing--; 00344 double sknorm=0.0; 00345 for(i=k;i<((int)nvar);i++) { 00346 w0[i]/=eta; 00347 sknorm+=w0[i]*w0[i]; 00348 } 00349 sknorm=sqrt(sknorm); 00350 if (w0[k]<0.0) sknorm=-sknorm; 00351 w0[k]+=sknorm; 00352 00353 // Apply the transformation 00354 00355 for(i=0;i<((int)nvar);i++) { 00356 w2[i]=0.0; 00357 } 00358 for(j=k;j<((int)nvar);j++) { 00359 for(i=0;i<((int)nvar);i++) { 00360 w2[i]+=w0[j]*w[j][i]; 00361 } 00362 } 00363 for(j=k;j<((int)nvar);j++) { 00364 double temp=w0[j]/(sknorm*w0[k]); 00365 for(i=0;i<((int)nvar);i++) { 00366 w[j][i]-=temp*w2[i]; 00367 } 00368 } 00369 00370 // Compute the subiterate 00371 00372 w0[k]=sknorm*eta; 00373 double temp2=fky/w0[k]; 00374 if (h*fabs(temp2)>delta) 00375 temp2=(temp2>=0.0) ? fabs(delta/h) : -fabs(delta/h); 00376 for(i=0;i<((int)nvar);i++) { 00377 w1[i]+=temp2*w[k][i]; 00378 } 00379 } 00380 } 00381 00382 // Compute the norms of the iterate and correction vector 00383 00384 xnorm=0.0; 00385 difit=0.0; 00386 for(i=0;i<((int)nvar);i++) { 00387 if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]); 00388 if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]); 00389 x[i]=w1[i]; 00390 } 00391 00392 // Update the bound on the correction vector 00393 00394 if(delta<scale*xnorm) delta=scale*xnorm; 00395 00396 // Determine the progress of the iteration 00397 00398 bool lcv=(fnorm<fnorm1 && difit<difit1 && nsing==0); 00399 nier6++; 00400 nier7++; 00401 nier8++; 00402 if (lcv) nier6=0; 00403 if (fnorm<fnorm1 || difit<difit1) nier7=0; 00404 if (difit>eps*xnorm) nier8=0; 00405 00406 // Print iteration information 00407 00408 if (this->verbose>0) { 00409 print_iter(nvar,x,f,++it,fnorm,this->tolf,"cern_mroot"); 00410 } 00411 00412 // Tests for convergence 00413 00414 if (fnorm<=this->tolf) info=1; 00415 if (difit<=this->tolx*xnorm && lcv) info=2; 00416 if (fnorm<=this->tolf && info==2) info=3; 00417 if (info!=0) { 00418 00419 delete_2d_array(w,nvar); 00420 ao.free(f); 00421 ao.free(w0); 00422 ao.free(w1); 00423 ao.free(w2); 00424 00425 return 0; 00426 } 00427 00428 // Tests for termination 00429 00430 if (numf>=lmaxf) { 00431 info=4; 00432 this->last_conv=gsl_emaxiter; 00433 00434 delete_2d_array(w,nvar); 00435 ao.free(f); 00436 ao.free(w0); 00437 ao.free(w1); 00438 ao.free(w2); 00439 00440 O2SCL_CONV_RET("Too many iterations in cern_mroot::msolve().", 00441 gsl_emaxiter,this->err_nonconv); 00442 } 00443 if (nsing==((int)nvar)) { 00444 info=5; 00445 this->last_conv=gsl_emaxiter; 00446 00447 delete_2d_array(w,nvar); 00448 ao.free(f); 00449 ao.free(w0); 00450 ao.free(w1); 00451 ao.free(w2); 00452 00453 O2SCL_CONV_RET("Jacobian matrix singular in cern_mroot::msolve().", 00454 gsl_esing,this->err_nonconv); 00455 } 00456 if (nier6==5) { 00457 info=6; 00458 this->last_conv=gsl_enoprog; 00459 00460 delete_2d_array(w,nvar); 00461 ao.free(f); 00462 ao.free(w0); 00463 ao.free(w1); 00464 ao.free(w2); 00465 00466 O2SCL_CONV_RET("No progress in cern_mroot::msolve().", 00467 gsl_enoprog,this->err_nonconv); 00468 } 00469 if (nier7==3) { 00470 info=7; 00471 this->last_conv=gsl_erunaway; 00472 00473 delete_2d_array(w,nvar); 00474 ao.free(f); 00475 ao.free(w0); 00476 ao.free(w1); 00477 ao.free(w2); 00478 00479 O2SCL_CONV_RET("Iterations diverging in cern_mroot::msolve().", 00480 gsl_erunaway,this->err_nonconv); 00481 } 00482 if (nier8==4) { 00483 info=8; 00484 00485 this->last_conv=gsl_efailed; 00486 00487 delete_2d_array(w,nvar); 00488 ao.free(f); 00489 ao.free(w0); 00490 ao.free(w1); 00491 ao.free(w2); 00492 00493 std::string s="Variable tolx too small, J singular, or bad "; 00494 s+="scaling in cern_mroot::msolve()."; 00495 O2SCL_CONV_RET(s.c_str(),gsl_efailed,this->err_nonconv); 00496 } 00497 00498 // Exit if necessary 00499 00500 if (info!=0) { 00501 00502 delete_2d_array(w,nvar); 00503 ao.free(f); 00504 ao.free(w0); 00505 ao.free(w1); 00506 ao.free(w2); 00507 00508 O2SCL_ERR_RET("Unspecified error in cern_mroot::msolve().", 00509 gsl_efailed); 00510 } 00511 00512 if (!((!lcv) || difit>0.05*xnorm)) { 00513 // 8/20/08: Could this just be rewritten? 00514 // if (lcv && difit<=0.05*xnorm) 00515 00516 // Iterative refinement (if the iteration is converging) 00517 00518 for(int m=2;m<=mopt && bskip==false;m++) { 00519 fnorm1=fnorm; 00520 fnorm=0.0; 00521 for(k=0;k<((int)nvar) && bskip==false;k++) { 00522 iflag=k; 00523 00524 func(iflag,w1,f,pa); 00525 00526 fky=f[k]; 00527 nfcall++; 00528 numf=(int)(((double)nfcall)/((double)nvar)); 00529 00530 if (fnorm<fabs(fky)) fnorm=fabs(fky); 00531 00532 // Iterative refinement is terminated if it does not give a 00533 // reduction on residuals 00534 00535 if (fnorm>=fnorm1) { 00536 fnorm=fnorm1; 00537 bskip=true; 00538 } 00539 00540 if (!bskip) { 00541 double temp3=fky/w0[k]; 00542 00543 for(i=0;i<((int)nvar);i++) { 00544 w1[i]+=temp3*w[k][i]; 00545 } 00546 } 00547 } 00548 00549 if (!bskip) { 00550 00551 // Compute the norms of the iterate and correction vector 00552 00553 xnorm=0.0; 00554 difit=0.0; 00555 00556 for(i=0;i<((int)nvar);i++) { 00557 if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]); 00558 if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]); 00559 x[i]=w1[i]; 00560 } 00561 00562 // Stopping criteria for iterative refinement 00563 00564 if (fnorm<=this->tolf) info=1; 00565 if (difit<=xnorm*this->tolx) info=2; 00566 if (fnorm<=this->tolf && info==2) info=3; 00567 if (numf>=lmaxf && info==0) { 00568 info=4; 00569 this->last_conv=gsl_emaxiter; 00570 00571 delete_2d_array(w,nvar); 00572 ao.free(f); 00573 ao.free(w0); 00574 ao.free(w1); 00575 ao.free(w2); 00576 00577 O2SCL_CONV_RET("Too many iterations in cern_mroot::msolve().", 00578 gsl_emaxiter,this->err_nonconv); 00579 } 00580 00581 if (info!=0) { 00582 00583 delete_2d_array(w,nvar); 00584 ao.free(f); 00585 ao.free(w0); 00586 ao.free(w1); 00587 ao.free(w2); 00588 00589 return 0; 00590 } 00591 } 00592 } 00593 } 00594 } 00595 00596 delete_2d_array(w,nvar); 00597 ao.free(f); 00598 ao.free(w0); 00599 ao.free(w1); 00600 ao.free(w2); 00601 00602 return 0; 00603 } 00604 00605 #ifndef DOXYGEN_INTERNAL 00606 00607 protected: 00608 00609 /// Internal storage for the value of \c info 00610 int info; 00611 00612 /// Store the number of function evaluations 00613 int mpt[289]; 00614 00615 #endif 00616 00617 }; 00618 00619 00620 #ifndef DOXYGENP 00621 } 00622 #endif 00623 00624 #endif 00625
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