[0b990d] | 1 | // These routines were translated from lbfgs.f by f2c (version 20030320)
|
---|
| 2 | // and modified by Curtis Janssen.
|
---|
| 3 |
|
---|
| 4 | #ifdef __GNUC__
|
---|
| 5 | #pragma implementation
|
---|
| 6 | #endif
|
---|
| 7 |
|
---|
| 8 | #include <math.h>
|
---|
| 9 | #include <util/class/scexception.h>
|
---|
| 10 | #include <math/optimize/mcsearch.h>
|
---|
| 11 |
|
---|
| 12 | static inline double min(double a, double b)
|
---|
| 13 | {
|
---|
| 14 | return (a<b)?a:b;
|
---|
| 15 | }
|
---|
| 16 |
|
---|
| 17 | static inline double max(double a, double b)
|
---|
| 18 | {
|
---|
| 19 | return (a<b)?b:a;
|
---|
| 20 | }
|
---|
| 21 |
|
---|
| 22 |
|
---|
| 23 | using namespace sc;
|
---|
| 24 |
|
---|
| 25 | namespace sc {
|
---|
| 26 |
|
---|
| 27 | static ClassDesc MCSearch_cd(
|
---|
| 28 | typeid(MCSearch),"MCSearch",1,"public LineOpt",
|
---|
| 29 | 0, create<MCSearch>, 0);
|
---|
| 30 |
|
---|
| 31 | MCSearch::MCSearch(const Ref<KeyVal>& keyval)
|
---|
| 32 | : LineOpt(keyval)
|
---|
| 33 | {
|
---|
| 34 | }
|
---|
| 35 |
|
---|
| 36 | MCSearch::~MCSearch()
|
---|
| 37 | {
|
---|
| 38 | }
|
---|
| 39 |
|
---|
| 40 | void
|
---|
| 41 | MCSearch::mcinit()
|
---|
| 42 | {
|
---|
| 43 | info_ = 0;
|
---|
| 44 |
|
---|
| 45 | // work area
|
---|
| 46 | wa_.reset(new double[function()->dimension()->n()]);
|
---|
| 47 | }
|
---|
| 48 |
|
---|
| 49 | void
|
---|
| 50 | MCSearch::init(RefSCVector& direction)
|
---|
| 51 | {
|
---|
| 52 | LineOpt::init(direction);
|
---|
| 53 | mcinit();
|
---|
| 54 | }
|
---|
| 55 |
|
---|
| 56 | void
|
---|
| 57 | MCSearch::init(RefSCVector& direction, Ref<Function> function)
|
---|
| 58 | {
|
---|
| 59 | LineOpt::init(direction, function);
|
---|
| 60 | mcinit();
|
---|
| 61 | }
|
---|
| 62 |
|
---|
| 63 | int
|
---|
| 64 | MCSearch::update()
|
---|
| 65 | {
|
---|
| 66 | int n = function()->dimension()->n();
|
---|
| 67 |
|
---|
| 68 | // function coordinate
|
---|
| 69 | auto_vec<double> x(new double[n]);
|
---|
| 70 | function()->get_x()->convert(x.get());
|
---|
| 71 |
|
---|
| 72 | // gradient
|
---|
| 73 | auto_vec<double> g(new double[n]);
|
---|
| 74 | function()->gradient()->convert(g.get());
|
---|
| 75 |
|
---|
| 76 | // function value
|
---|
| 77 | double f = function()->value();
|
---|
| 78 |
|
---|
| 79 | // step direction
|
---|
| 80 | auto_vec<double> s(new double[n]);
|
---|
| 81 | search_direction_->convert(s.get());
|
---|
| 82 |
|
---|
| 83 | // step size;
|
---|
| 84 | double stp;
|
---|
| 85 | stp = 1.0;
|
---|
| 86 |
|
---|
| 87 | // value tolerance
|
---|
| 88 | double ftol;
|
---|
| 89 | ftol = 1.0e-4;
|
---|
| 90 |
|
---|
| 91 | // the machine precision
|
---|
| 92 | double xtol;
|
---|
| 93 | xtol = DBL_EPSILON;
|
---|
| 94 |
|
---|
| 95 | // maximum number of function evaluations
|
---|
| 96 | int maxfev = 20;
|
---|
| 97 |
|
---|
| 98 | // number of function evaluations
|
---|
| 99 | int nfev = 0;
|
---|
| 100 |
|
---|
| 101 | // controls accuracy of line search routine
|
---|
| 102 | gtol_ = 0.9;
|
---|
| 103 |
|
---|
| 104 | // minimum step size
|
---|
| 105 | stpmin_ = DBL_EPSILON;
|
---|
| 106 |
|
---|
| 107 | // maximum step size
|
---|
| 108 | stpmax_ = 1.0e20;
|
---|
| 109 |
|
---|
| 110 | mcsrch(&n, x.get(), &f,g.get(), s.get(), &stp, &ftol,
|
---|
| 111 | &xtol, &maxfev, &info_, &nfev, wa_.get());
|
---|
| 112 |
|
---|
| 113 | // INFO = 0 IMPROPER INPUT PARAMETERS.
|
---|
| 114 | if (info_ == 0) {
|
---|
| 115 | throw ProgrammingError("error in MCSearch: info == 0",
|
---|
| 116 | __FILE__,
|
---|
| 117 | __LINE__,
|
---|
| 118 | class_desc());
|
---|
| 119 | }
|
---|
| 120 |
|
---|
| 121 | // INFO =-1 A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT.
|
---|
| 122 | if (info_ == -1) {
|
---|
| 123 | RefSCVector new_x = function()->get_x()->copy();
|
---|
| 124 | new_x->assign(x.get());
|
---|
| 125 | function()->set_x(new_x);
|
---|
| 126 | return 0;
|
---|
| 127 | }
|
---|
| 128 |
|
---|
| 129 | // INFO = 1 THE SUFFICIENT DECREASE CONDITION AND THE
|
---|
| 130 | // DIRECTIONAL DERIVATIVE CONDITION HOLD.
|
---|
| 131 | if (info_ == 1) {
|
---|
| 132 | return 1;
|
---|
| 133 | }
|
---|
| 134 |
|
---|
| 135 | // INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY
|
---|
| 136 | // IS AT MOST XTOL.
|
---|
| 137 | if (info_ == 2) {
|
---|
| 138 | throw AlgorithmException("error in MCSearch: info == 2",
|
---|
| 139 | __FILE__,
|
---|
| 140 | __LINE__,
|
---|
| 141 | class_desc());
|
---|
| 142 | return 1;
|
---|
| 143 | }
|
---|
| 144 |
|
---|
| 145 | // INFO = 3 NUMBER OF CALLS TO FCN HAS REACHED MAXFEV.
|
---|
| 146 | if (info_ == 3) {
|
---|
| 147 | throw ProgrammingError("error in MCSearch: info == 3",
|
---|
| 148 | __FILE__,
|
---|
| 149 | __LINE__,
|
---|
| 150 | class_desc());
|
---|
| 151 | return 1;
|
---|
| 152 | }
|
---|
| 153 |
|
---|
| 154 | // INFO = 4 THE STEP IS AT THE LOWER BOUND STPMIN.
|
---|
| 155 | if (info_ == 4) {
|
---|
| 156 | throw AlgorithmException("error in MCSearch: info == 4",
|
---|
| 157 | __FILE__,
|
---|
| 158 | __LINE__,
|
---|
| 159 | class_desc());
|
---|
| 160 | return 1;
|
---|
| 161 | }
|
---|
| 162 |
|
---|
| 163 | // INFO = 5 THE STEP IS AT THE UPPER BOUND STPMAX.
|
---|
| 164 | if (info_ == 5) {
|
---|
| 165 | throw AlgorithmException("error in MCSearch: info == 5",
|
---|
| 166 | __FILE__,
|
---|
| 167 | __LINE__,
|
---|
| 168 | class_desc());
|
---|
| 169 | return 1;
|
---|
| 170 | }
|
---|
| 171 |
|
---|
| 172 | // INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS.
|
---|
| 173 | // THERE MAY NOT BE A STEP WHICH SATISFIES THE
|
---|
| 174 | // SUFFICIENT DECREASE AND CURVATURE CONDITIONS.
|
---|
| 175 | // TOLERANCES MAY BE TOO SMALL.
|
---|
| 176 | if (info_ == 6) {
|
---|
| 177 | throw AlgorithmException("error in MCSearch: info == 6",
|
---|
| 178 | __FILE__,
|
---|
| 179 | __LINE__,
|
---|
| 180 | class_desc());
|
---|
| 181 | return 1;
|
---|
| 182 | }
|
---|
| 183 |
|
---|
| 184 | throw ProgrammingError("error in MCSearch: unknown info",
|
---|
| 185 | __FILE__,
|
---|
| 186 | __LINE__,
|
---|
| 187 | class_desc());
|
---|
| 188 |
|
---|
| 189 | return 0;
|
---|
| 190 | }
|
---|
| 191 |
|
---|
| 192 | // **************************
|
---|
| 193 | // LINE SEARCH ROUTINE MCSRCH
|
---|
| 194 | // **************************
|
---|
| 195 |
|
---|
| 196 | void
|
---|
| 197 | MCSearch::mcsrch(int *n, double *x, double *f,
|
---|
| 198 | double *g, double *s, double *stp, double *ftol,
|
---|
| 199 | double *xtol, int *maxfev, int *info, int *nfev,
|
---|
| 200 | double *wa)
|
---|
| 201 | {
|
---|
| 202 | // Initialized data
|
---|
| 203 |
|
---|
| 204 | const double p5 = .5;
|
---|
| 205 | const double p66 = .66;
|
---|
| 206 | const double xtrapf = 4.;
|
---|
| 207 | const double zero = 0.;
|
---|
| 208 |
|
---|
| 209 | // System generated locals
|
---|
| 210 | int i__1;
|
---|
| 211 | double d__1;
|
---|
| 212 |
|
---|
| 213 | // SUBROUTINE MCSRCH
|
---|
| 214 |
|
---|
| 215 | // A slight modification of the subroutine CSRCH of More' and Thuente.
|
---|
| 216 | // The changes are to allow reverse communication, and do not affect
|
---|
| 217 | // the performance of the routine.
|
---|
| 218 |
|
---|
| 219 | // THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES
|
---|
| 220 | // A SUFFICIENT DECREASE CONDITION AND A CURVATURE CONDITION.
|
---|
| 221 |
|
---|
| 222 | // AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF
|
---|
| 223 | // UNCERTAINTY WITH ENDPOINTS STX AND STY. THE INTERVAL OF
|
---|
| 224 | // UNCERTAINTY IS INITIALLY CHOSEN SO THAT IT CONTAINS A
|
---|
| 225 | // MINIMIZER OF THE MODIFIED FUNCTION
|
---|
| 226 |
|
---|
| 227 | // F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S).
|
---|
| 228 |
|
---|
| 229 | // IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION
|
---|
| 230 | // HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE,
|
---|
| 231 | // THEN THE INTERVAL OF UNCERTAINTY IS CHOSEN SO THAT IT
|
---|
| 232 | // CONTAINS A MINIMIZER OF F(X+STP*S).
|
---|
| 233 |
|
---|
| 234 | // THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES
|
---|
| 235 | // THE SUFFICIENT DECREASE CONDITION
|
---|
| 236 |
|
---|
| 237 | // F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S),
|
---|
| 238 |
|
---|
| 239 | // AND THE CURVATURE CONDITION
|
---|
| 240 |
|
---|
| 241 | // ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S).
|
---|
| 242 |
|
---|
| 243 | // IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION
|
---|
| 244 | // IS BOUNDED BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES
|
---|
| 245 | // BOTH CONDITIONS. IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH
|
---|
| 246 | // CONDITIONS, THEN THE ALGORITHM USUALLY STOPS WHEN ROUNDING
|
---|
| 247 | // ERRORS PREVENT FURTHER PROGRESS. IN THIS CASE STP ONLY
|
---|
| 248 | // SATISFIES THE SUFFICIENT DECREASE CONDITION.
|
---|
| 249 |
|
---|
| 250 | // THE SUBROUTINE STATEMENT IS
|
---|
| 251 |
|
---|
| 252 | // SUBROUTINE MCSRCH(N,X,F,G,S,STP,FTOL,XTOL, MAXFEV,INFO,NFEV,WA)
|
---|
| 253 | // WHERE
|
---|
| 254 |
|
---|
| 255 | // N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER
|
---|
| 256 | // OF VARIABLES.
|
---|
| 257 |
|
---|
| 258 | // X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE
|
---|
| 259 | // BASE POINT FOR THE LINE SEARCH. ON OUTPUT IT CONTAINS
|
---|
| 260 | // X + STP*S.
|
---|
| 261 |
|
---|
| 262 | // F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F
|
---|
| 263 | // AT X. ON OUTPUT IT CONTAINS THE VALUE OF F AT X + STP*S.
|
---|
| 264 |
|
---|
| 265 | // G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE
|
---|
| 266 | // GRADIENT OF F AT X. ON OUTPUT IT CONTAINS THE GRADIENT
|
---|
| 267 | // OF F AT X + STP*S.
|
---|
| 268 |
|
---|
| 269 | // S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE
|
---|
| 270 | // SEARCH DIRECTION.
|
---|
| 271 |
|
---|
| 272 | // STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN
|
---|
| 273 | // INITIAL ESTIMATE OF A SATISFACTORY STEP. ON OUTPUT
|
---|
| 274 | // STP CONTAINS THE FINAL ESTIMATE.
|
---|
| 275 |
|
---|
| 276 | // FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. (In this reverse
|
---|
| 277 | // communication implementation GTOL is defined in a COMMON
|
---|
| 278 | // statement.) TERMINATION OCCURS WHEN THE SUFFICIENT DECREASE
|
---|
| 279 | // CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE
|
---|
| 280 | // SATISFIED.
|
---|
| 281 |
|
---|
| 282 | // XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS
|
---|
| 283 | // WHEN THE RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY
|
---|
| 284 | // IS AT MOST XTOL.
|
---|
| 285 |
|
---|
| 286 | // STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH
|
---|
| 287 | // SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP. (In this reverse
|
---|
| 288 | // communication implementatin they are defined in a COMMON
|
---|
| 289 | // statement).
|
---|
| 290 |
|
---|
| 291 | // MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION
|
---|
| 292 | // OCCURS WHEN THE NUMBER OF CALLS TO FCN IS AT LEAST
|
---|
| 293 | // MAXFEV BY THE END OF AN ITERATION.
|
---|
| 294 |
|
---|
| 295 | // INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS:
|
---|
| 296 |
|
---|
| 297 | // INFO = 0 IMPROPER INPUT PARAMETERS.
|
---|
| 298 |
|
---|
| 299 | // INFO =-1 A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT.
|
---|
| 300 |
|
---|
| 301 | // INFO = 1 THE SUFFICIENT DECREASE CONDITION AND THE
|
---|
| 302 | // DIRECTIONAL DERIVATIVE CONDITION HOLD.
|
---|
| 303 |
|
---|
| 304 | // INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY
|
---|
| 305 | // IS AT MOST XTOL.
|
---|
| 306 |
|
---|
| 307 | // INFO = 3 NUMBER OF CALLS TO FCN HAS REACHED MAXFEV.
|
---|
| 308 |
|
---|
| 309 | // INFO = 4 THE STEP IS AT THE LOWER BOUND STPMIN.
|
---|
| 310 |
|
---|
| 311 | // INFO = 5 THE STEP IS AT THE UPPER BOUND STPMAX.
|
---|
| 312 |
|
---|
| 313 | // INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS.
|
---|
| 314 | // THERE MAY NOT BE A STEP WHICH SATISFIES THE
|
---|
| 315 | // SUFFICIENT DECREASE AND CURVATURE CONDITIONS.
|
---|
| 316 | // TOLERANCES MAY BE TOO SMALL.
|
---|
| 317 |
|
---|
| 318 | // NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF
|
---|
| 319 | // CALLS TO FCN.
|
---|
| 320 |
|
---|
| 321 | // WA IS A WORK ARRAY OF LENGTH N.
|
---|
| 322 |
|
---|
| 323 | // SUBPROGRAMS CALLED
|
---|
| 324 |
|
---|
| 325 | // MCSTEP
|
---|
| 326 |
|
---|
| 327 | // FORTRAN-SUPPLIED...ABS,MAX,MIN
|
---|
| 328 |
|
---|
| 329 | // ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983
|
---|
| 330 | // JORGE J. MORE', DAVID J. THUENTE
|
---|
| 331 |
|
---|
| 332 | // **********
|
---|
| 333 | // Parameter adjustments
|
---|
| 334 | --wa;
|
---|
| 335 | --s;
|
---|
| 336 | --g;
|
---|
| 337 | --x;
|
---|
| 338 |
|
---|
| 339 | // Function Body
|
---|
| 340 | if (*info == -1) {
|
---|
| 341 | goto L45;
|
---|
| 342 | }
|
---|
| 343 | infoc = 1;
|
---|
| 344 |
|
---|
| 345 | // CHECK THE INPUT PARAMETERS FOR ERRORS.
|
---|
| 346 |
|
---|
| 347 | if (*n <= 0 || *stp <= zero || *ftol < zero || gtol_ < zero || *xtol
|
---|
| 348 | < zero || stpmin_ < zero || stpmax_ < stpmin_ || *
|
---|
| 349 | maxfev <= 0) {
|
---|
| 350 | return;
|
---|
| 351 | }
|
---|
| 352 |
|
---|
| 353 | // COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION
|
---|
| 354 | // AND CHECK THAT S IS A DESCENT DIRECTION.
|
---|
| 355 |
|
---|
| 356 | dginit = zero;
|
---|
| 357 | i__1 = *n;
|
---|
| 358 | for (int j = 1; j <= i__1; ++j) {
|
---|
| 359 | dginit += g[j] * s[j];
|
---|
| 360 | // L10:
|
---|
| 361 | }
|
---|
| 362 | if (dginit >= zero) {
|
---|
| 363 | ExEnv::out0() << indent
|
---|
| 364 | << "MCSearch: "
|
---|
| 365 | << "The search direction is not a descent direction"
|
---|
| 366 | << std::endl;
|
---|
| 367 | return;
|
---|
| 368 | }
|
---|
| 369 |
|
---|
| 370 | // INITIALIZE LOCAL VARIABLES.
|
---|
| 371 |
|
---|
| 372 | brackt = false;
|
---|
| 373 | stage1 = true;
|
---|
| 374 | *nfev = 0;
|
---|
| 375 | finit = *f;
|
---|
| 376 | dgtest = *ftol * dginit;
|
---|
| 377 | width = stpmax_ - stpmin_;
|
---|
| 378 | width1 = width / p5;
|
---|
| 379 | i__1 = *n;
|
---|
| 380 | for (int j = 1; j <= i__1; ++j) {
|
---|
| 381 | wa[j] = x[j];
|
---|
| 382 | // L20:
|
---|
| 383 | }
|
---|
| 384 |
|
---|
| 385 | // THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP,
|
---|
| 386 | // FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP.
|
---|
| 387 | // THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP,
|
---|
| 388 | // FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF
|
---|
| 389 | // THE INTERVAL OF UNCERTAINTY.
|
---|
| 390 | // THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP,
|
---|
| 391 | // FUNCTION, AND DERIVATIVE AT THE CURRENT STEP.
|
---|
| 392 |
|
---|
| 393 | stx = zero;
|
---|
| 394 | fx = finit;
|
---|
| 395 | dgx = dginit;
|
---|
| 396 | sty = zero;
|
---|
| 397 | fy = finit;
|
---|
| 398 | dgy = dginit;
|
---|
| 399 |
|
---|
| 400 | // START OF ITERATION.
|
---|
| 401 |
|
---|
| 402 | L30:
|
---|
| 403 |
|
---|
| 404 | // SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND
|
---|
| 405 | // TO THE PRESENT INTERVAL OF UNCERTAINTY.
|
---|
| 406 |
|
---|
| 407 | if (brackt) {
|
---|
| 408 | stmin = min(stx,sty);
|
---|
| 409 | stmax = max(stx,sty);
|
---|
| 410 | } else {
|
---|
| 411 | stmin = stx;
|
---|
| 412 | stmax = *stp + xtrapf * (*stp - stx);
|
---|
| 413 | }
|
---|
| 414 |
|
---|
| 415 | // FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN.
|
---|
| 416 |
|
---|
| 417 | *stp = max(*stp,stpmin_);
|
---|
| 418 | *stp = min(*stp,stpmax_);
|
---|
| 419 |
|
---|
| 420 | // IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET
|
---|
| 421 | // STP BE THE LOWEST POINT OBTAINED SO FAR.
|
---|
| 422 |
|
---|
| 423 | if (brackt && (*stp <= stmin || *stp >= stmax) || *nfev >= *maxfev - 1 ||
|
---|
| 424 | infoc == 0 || brackt && stmax - stmin <= *xtol * stmax) {
|
---|
| 425 | *stp = stx;
|
---|
| 426 | }
|
---|
| 427 |
|
---|
| 428 | // EVALUATE THE FUNCTION AND GRADIENT AT STP
|
---|
| 429 | // AND COMPUTE THE DIRECTIONAL DERIVATIVE.
|
---|
| 430 | // We return to main program to obtain F and G.
|
---|
| 431 |
|
---|
| 432 | i__1 = *n;
|
---|
| 433 | for (int j = 1; j <= i__1; ++j) {
|
---|
| 434 | x[j] = wa[j] + *stp * s[j];
|
---|
| 435 | // L40:
|
---|
| 436 | }
|
---|
| 437 | *info = -1;
|
---|
| 438 | return;
|
---|
| 439 |
|
---|
| 440 | L45:
|
---|
| 441 | *info = 0;
|
---|
| 442 | ++(*nfev);
|
---|
| 443 | dg = zero;
|
---|
| 444 | i__1 = *n;
|
---|
| 445 | for (int j = 1; j <= i__1; ++j) {
|
---|
| 446 | dg += g[j] * s[j];
|
---|
| 447 | // L50:
|
---|
| 448 | }
|
---|
| 449 | ftest1 = finit + *stp * dgtest;
|
---|
| 450 |
|
---|
| 451 | // TEST FOR CONVERGENCE.
|
---|
| 452 |
|
---|
| 453 | if (brackt && (*stp <= stmin || *stp >= stmax) || infoc == 0) {
|
---|
| 454 | *info = 6;
|
---|
| 455 | }
|
---|
| 456 | if (*stp == stpmax_ && *f <= ftest1 && dg <= dgtest) {
|
---|
| 457 | *info = 5;
|
---|
| 458 | }
|
---|
| 459 | if (*stp == stpmin_ && (*f > ftest1 || dg >= dgtest)) {
|
---|
| 460 | *info = 4;
|
---|
| 461 | }
|
---|
| 462 | if (*nfev >= *maxfev) {
|
---|
| 463 | *info = 3;
|
---|
| 464 | }
|
---|
| 465 | if (brackt && stmax - stmin <= *xtol * stmax) {
|
---|
| 466 | *info = 2;
|
---|
| 467 | }
|
---|
| 468 | if (*f <= ftest1 && fabs(dg) <= gtol_ * (-dginit)) {
|
---|
| 469 | *info = 1;
|
---|
| 470 | }
|
---|
| 471 |
|
---|
| 472 | // CHECK FOR TERMINATION.
|
---|
| 473 |
|
---|
| 474 | if (*info != 0) {
|
---|
| 475 | return;
|
---|
| 476 | }
|
---|
| 477 |
|
---|
| 478 | // IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED
|
---|
| 479 | // FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE.
|
---|
| 480 |
|
---|
| 481 | if (stage1 && *f <= ftest1 && dg >= min(*ftol,gtol_) * dginit) {
|
---|
| 482 | stage1 = false;
|
---|
| 483 | }
|
---|
| 484 |
|
---|
| 485 | // A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF
|
---|
| 486 | // WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED
|
---|
| 487 | // FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE
|
---|
| 488 | // DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN
|
---|
| 489 | // OBTAINED BUT THE DECREASE IS NOT SUFFICIENT.
|
---|
| 490 |
|
---|
| 491 | if (stage1 && *f <= fx && *f > ftest1) {
|
---|
| 492 |
|
---|
| 493 | // DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES.
|
---|
| 494 |
|
---|
| 495 | fm = *f - *stp * dgtest;
|
---|
| 496 | fxm = fx - stx * dgtest;
|
---|
| 497 | fym = fy - sty * dgtest;
|
---|
| 498 | dgm = dg - dgtest;
|
---|
| 499 | dgxm = dgx - dgtest;
|
---|
| 500 | dgym = dgy - dgtest;
|
---|
| 501 |
|
---|
| 502 | // CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY
|
---|
| 503 | // AND TO COMPUTE THE NEW STEP.
|
---|
| 504 |
|
---|
| 505 | mcstep(&stx, &fxm, &dgxm, &sty, &fym, &dgym, stp, &fm, &dgm, &brackt,
|
---|
| 506 | &stmin, &stmax, &infoc);
|
---|
| 507 |
|
---|
| 508 | // RESET THE FUNCTION AND GRADIENT VALUES FOR F.
|
---|
| 509 |
|
---|
| 510 | fx = fxm + stx * dgtest;
|
---|
| 511 | fy = fym + sty * dgtest;
|
---|
| 512 | dgx = dgxm + dgtest;
|
---|
| 513 | dgy = dgym + dgtest;
|
---|
| 514 | } else {
|
---|
| 515 |
|
---|
| 516 | // CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY
|
---|
| 517 | // AND TO COMPUTE THE NEW STEP.
|
---|
| 518 |
|
---|
| 519 | mcstep(&stx, &fx, &dgx, &sty, &fy, &dgy, stp, f, &dg, &brackt, &
|
---|
| 520 | stmin, &stmax, &infoc);
|
---|
| 521 | }
|
---|
| 522 |
|
---|
| 523 | // FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE
|
---|
| 524 | // INTERVAL OF UNCERTAINTY.
|
---|
| 525 |
|
---|
| 526 | if (brackt) {
|
---|
| 527 | if ((d__1 = sty - stx, fabs(d__1)) >= p66 * width1) {
|
---|
| 528 | *stp = stx + p5 * (sty - stx);
|
---|
| 529 | }
|
---|
| 530 | width1 = width;
|
---|
| 531 | width = (d__1 = sty - stx, fabs(d__1));
|
---|
| 532 | }
|
---|
| 533 |
|
---|
| 534 | // END OF ITERATION.
|
---|
| 535 |
|
---|
| 536 | goto L30;
|
---|
| 537 |
|
---|
| 538 | // LAST LINE OF SUBROUTINE MCSRCH.
|
---|
| 539 |
|
---|
| 540 | } // mcsrch_
|
---|
| 541 |
|
---|
| 542 | void
|
---|
| 543 | MCSearch::mcstep(double *stx, double *fx, double *dx,
|
---|
| 544 | double *sty, double *fy, double *dy, double *stp,
|
---|
| 545 | double *fp, double *dp, bool *brackt, double *stpmin,
|
---|
| 546 | double *stpmax, int *info)
|
---|
| 547 | {
|
---|
| 548 | // System generated locals
|
---|
| 549 | double d__1, d__2, d__3;
|
---|
| 550 |
|
---|
| 551 | // SUBROUTINE MCSTEP
|
---|
| 552 |
|
---|
| 553 | // THE PURPOSE OF MCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR
|
---|
| 554 | // A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR
|
---|
| 555 | // A MINIMIZER OF THE FUNCTION.
|
---|
| 556 |
|
---|
| 557 | // THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION
|
---|
| 558 | // VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS
|
---|
| 559 | // ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE
|
---|
| 560 | // DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A
|
---|
| 561 | // MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY
|
---|
| 562 | // WITH ENDPOINTS STX AND STY.
|
---|
| 563 |
|
---|
| 564 | // THE SUBROUTINE STATEMENT IS
|
---|
| 565 |
|
---|
| 566 | // SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,
|
---|
| 567 | // STPMIN,STPMAX,INFO)
|
---|
| 568 |
|
---|
| 569 | // WHERE
|
---|
| 570 |
|
---|
| 571 | // STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP,
|
---|
| 572 | // THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED
|
---|
| 573 | // SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION
|
---|
| 574 | // OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE
|
---|
| 575 | // SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.
|
---|
| 576 |
|
---|
| 577 | // STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP,
|
---|
| 578 | // THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF
|
---|
| 579 | // THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE
|
---|
| 580 | // UPDATED APPROPRIATELY.
|
---|
| 581 |
|
---|
| 582 | // STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP,
|
---|
| 583 | // THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP.
|
---|
| 584 | // IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE
|
---|
| 585 | // BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP.
|
---|
| 586 |
|
---|
| 587 | // BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER
|
---|
| 588 | // HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED
|
---|
| 589 | // THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER
|
---|
| 590 | // IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE.
|
---|
| 591 |
|
---|
| 592 | // STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER
|
---|
| 593 | // AND UPPER BOUNDS FOR THE STEP.
|
---|
| 594 |
|
---|
| 595 | // INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS:
|
---|
| 596 | // IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED
|
---|
| 597 | // ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE
|
---|
| 598 | // INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS.
|
---|
| 599 |
|
---|
| 600 | // SUBPROGRAMS CALLED
|
---|
| 601 |
|
---|
| 602 | // FORTRAN-SUPPLIED ... ABS,MAX,MIN,SQRT
|
---|
| 603 |
|
---|
| 604 | // ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983
|
---|
| 605 | // JORGE J. MORE', DAVID J. THUENTE
|
---|
| 606 |
|
---|
| 607 | *info = 0;
|
---|
| 608 |
|
---|
| 609 | // CHECK THE INPUT PARAMETERS FOR ERRORS.
|
---|
| 610 |
|
---|
| 611 | if (*brackt && (*stp <= min(*stx,*sty) || *stp >= max(*stx,*sty)) || *dx *
|
---|
| 612 | (*stp - *stx) >= 0.f || *stpmax < *stpmin) {
|
---|
| 613 | return;
|
---|
| 614 | }
|
---|
| 615 |
|
---|
| 616 | // DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN.
|
---|
| 617 |
|
---|
| 618 | sgnd = *dp * (*dx / fabs(*dx));
|
---|
| 619 |
|
---|
| 620 | // FIRST CASE. A HIGHER FUNCTION VALUE.
|
---|
| 621 | // THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER
|
---|
| 622 | // TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN,
|
---|
| 623 | // ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN.
|
---|
| 624 |
|
---|
| 625 | if (*fp > *fx) {
|
---|
| 626 | *info = 1;
|
---|
| 627 | bound = true;
|
---|
| 628 | theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
|
---|
| 629 | // Computing MAX
|
---|
| 630 | d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
|
---|
| 631 | *dp);
|
---|
| 632 | s = max(d__1,d__2);
|
---|
| 633 | // Computing 2nd power
|
---|
| 634 | d__1 = theta / s;
|
---|
| 635 | gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
|
---|
| 636 | if (*stp < *stx) {
|
---|
| 637 | gamma = -gamma;
|
---|
| 638 | }
|
---|
| 639 | p = gamma - *dx + theta;
|
---|
| 640 | q = gamma - *dx + gamma + *dp;
|
---|
| 641 | r__ = p / q;
|
---|
| 642 | stpc = *stx + r__ * (*stp - *stx);
|
---|
| 643 | stpq = *stx + *dx / ((*fx - *fp) / (*stp - *stx) + *dx) / 2 * (*stp -
|
---|
| 644 | *stx);
|
---|
| 645 | if ((d__1 = stpc - *stx, fabs(d__1)) < (d__2 = stpq - *stx, fabs(d__2)))
|
---|
| 646 | {
|
---|
| 647 | stpf = stpc;
|
---|
| 648 | } else {
|
---|
| 649 | stpf = stpc + (stpq - stpc) / 2;
|
---|
| 650 | }
|
---|
| 651 | *brackt = true;
|
---|
| 652 |
|
---|
| 653 | // SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF
|
---|
| 654 | // OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC
|
---|
| 655 | // STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP,
|
---|
| 656 | // THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN.
|
---|
| 657 |
|
---|
| 658 | } else if (sgnd < 0.f) {
|
---|
| 659 | *info = 2;
|
---|
| 660 | bound = false;
|
---|
| 661 | theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
|
---|
| 662 | // Computing MAX
|
---|
| 663 | d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
|
---|
| 664 | *dp);
|
---|
| 665 | s = max(d__1,d__2);
|
---|
| 666 | // Computing 2nd power
|
---|
| 667 | d__1 = theta / s;
|
---|
| 668 | gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
|
---|
| 669 | if (*stp > *stx) {
|
---|
| 670 | gamma = -gamma;
|
---|
| 671 | }
|
---|
| 672 | p = gamma - *dp + theta;
|
---|
| 673 | q = gamma - *dp + gamma + *dx;
|
---|
| 674 | r__ = p / q;
|
---|
| 675 | stpc = *stp + r__ * (*stx - *stp);
|
---|
| 676 | stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
|
---|
| 677 | if ((d__1 = stpc - *stp, fabs(d__1)) > (d__2 = stpq - *stp, fabs(d__2)))
|
---|
| 678 | {
|
---|
| 679 | stpf = stpc;
|
---|
| 680 | } else {
|
---|
| 681 | stpf = stpq;
|
---|
| 682 | }
|
---|
| 683 | *brackt = true;
|
---|
| 684 |
|
---|
| 685 | // THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE
|
---|
| 686 | // SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES.
|
---|
| 687 | // THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY
|
---|
| 688 | // IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC
|
---|
| 689 | // IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE
|
---|
| 690 | // EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO
|
---|
| 691 | // COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP
|
---|
| 692 | // CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN.
|
---|
| 693 |
|
---|
| 694 | } else if (fabs(*dp) < fabs(*dx)) {
|
---|
| 695 | *info = 3;
|
---|
| 696 | bound = true;
|
---|
| 697 | theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
|
---|
| 698 | // Computing MAX
|
---|
| 699 | d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
|
---|
| 700 | *dp);
|
---|
| 701 | s = max(d__1,d__2);
|
---|
| 702 |
|
---|
| 703 | // THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND
|
---|
| 704 | // TO INFINITY IN THE DIRECTION OF THE STEP.
|
---|
| 705 |
|
---|
| 706 | // Computing MAX
|
---|
| 707 | // Computing 2nd power
|
---|
| 708 | d__3 = theta / s;
|
---|
| 709 | d__1 = 0., d__2 = d__3 * d__3 - *dx / s * (*dp / s);
|
---|
| 710 | gamma = s * sqrt((max(d__1,d__2)));
|
---|
| 711 | if (*stp > *stx) {
|
---|
| 712 | gamma = -gamma;
|
---|
| 713 | }
|
---|
| 714 | p = gamma - *dp + theta;
|
---|
| 715 | q = gamma + (*dx - *dp) + gamma;
|
---|
| 716 | r__ = p / q;
|
---|
| 717 | if (r__ < 0.f && gamma != 0.f) {
|
---|
| 718 | stpc = *stp + r__ * (*stx - *stp);
|
---|
| 719 | } else if (*stp > *stx) {
|
---|
| 720 | stpc = *stpmax;
|
---|
| 721 | } else {
|
---|
| 722 | stpc = *stpmin;
|
---|
| 723 | }
|
---|
| 724 | stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
|
---|
| 725 | if (*brackt) {
|
---|
| 726 | if ((d__1 = *stp - stpc, fabs(d__1)) < (d__2 = *stp - stpq, fabs(
|
---|
| 727 | d__2))) {
|
---|
| 728 | stpf = stpc;
|
---|
| 729 | } else {
|
---|
| 730 | stpf = stpq;
|
---|
| 731 | }
|
---|
| 732 | } else {
|
---|
| 733 | if ((d__1 = *stp - stpc, fabs(d__1)) > (d__2 = *stp - stpq, fabs(
|
---|
| 734 | d__2))) {
|
---|
| 735 | stpf = stpc;
|
---|
| 736 | } else {
|
---|
| 737 | stpf = stpq;
|
---|
| 738 | }
|
---|
| 739 | }
|
---|
| 740 |
|
---|
| 741 | // FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE
|
---|
| 742 | // SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES
|
---|
| 743 | // NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP
|
---|
| 744 | // IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN.
|
---|
| 745 |
|
---|
| 746 | } else {
|
---|
| 747 | *info = 4;
|
---|
| 748 | bound = false;
|
---|
| 749 | if (*brackt) {
|
---|
| 750 | theta = (*fp - *fy) * 3 / (*sty - *stp) + *dy + *dp;
|
---|
| 751 | // Computing MAX
|
---|
| 752 | d__1 = fabs(theta), d__2 = fabs(*dy), d__1 = max(d__1,d__2), d__2 =
|
---|
| 753 | fabs(*dp);
|
---|
| 754 | s = max(d__1,d__2);
|
---|
| 755 | // Computing 2nd power
|
---|
| 756 | d__1 = theta / s;
|
---|
| 757 | gamma = s * sqrt(d__1 * d__1 - *dy / s * (*dp / s));
|
---|
| 758 | if (*stp > *sty) {
|
---|
| 759 | gamma = -gamma;
|
---|
| 760 | }
|
---|
| 761 | p = gamma - *dp + theta;
|
---|
| 762 | q = gamma - *dp + gamma + *dy;
|
---|
| 763 | r__ = p / q;
|
---|
| 764 | stpc = *stp + r__ * (*sty - *stp);
|
---|
| 765 | stpf = stpc;
|
---|
| 766 | } else if (*stp > *stx) {
|
---|
| 767 | stpf = *stpmax;
|
---|
| 768 | } else {
|
---|
| 769 | stpf = *stpmin;
|
---|
| 770 | }
|
---|
| 771 | }
|
---|
| 772 |
|
---|
| 773 | // UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT
|
---|
| 774 | // DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE.
|
---|
| 775 |
|
---|
| 776 | if (*fp > *fx) {
|
---|
| 777 | *sty = *stp;
|
---|
| 778 | *fy = *fp;
|
---|
| 779 | *dy = *dp;
|
---|
| 780 | } else {
|
---|
| 781 | if (sgnd < 0.) {
|
---|
| 782 | *sty = *stx;
|
---|
| 783 | *fy = *fx;
|
---|
| 784 | *dy = *dx;
|
---|
| 785 | }
|
---|
| 786 | *stx = *stp;
|
---|
| 787 | *fx = *fp;
|
---|
| 788 | *dx = *dp;
|
---|
| 789 | }
|
---|
| 790 |
|
---|
| 791 | // COMPUTE THE NEW STEP AND SAFEGUARD IT.
|
---|
| 792 |
|
---|
| 793 | stpf = min(*stpmax,stpf);
|
---|
| 794 | stpf = max(*stpmin,stpf);
|
---|
| 795 | *stp = stpf;
|
---|
| 796 | if (*brackt && bound) {
|
---|
| 797 | if (*sty > *stx) {
|
---|
| 798 | // Computing MIN
|
---|
| 799 | d__1 = *stx + (*sty - *stx) * .66;
|
---|
| 800 | *stp = min(d__1,*stp);
|
---|
| 801 | } else {
|
---|
| 802 | // Computing MAX
|
---|
| 803 | d__1 = *stx + (*sty - *stx) * .66;
|
---|
| 804 | *stp = max(d__1,*stp);
|
---|
| 805 | }
|
---|
| 806 | }
|
---|
| 807 | return;
|
---|
| 808 |
|
---|
| 809 | // LAST LINE OF SUBROUTINE MCSTEP.
|
---|
| 810 |
|
---|
| 811 | } // mcstep_
|
---|
| 812 |
|
---|
| 813 | }
|
---|
| 814 |
|
---|