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