chiark / gitweb /
octave4.4
[nlopt.git] / luksan / plis.c
1 #include <limits.h>
2 #include <stdlib.h>
3 #include <math.h>
4 #include <string.h>
5 #include "luksan.h"
6
7 #define MAX2(a,b) ((a) > (b) ? (a) : (b))
8 #define MIN2(a,b) ((a) < (b) ? (a) : (b))
9
10 /* *********************************************************************** */
11 /* SUBROUTINE PLIS               ALL SYSTEMS                   01/09/22 */
12 /* PURPOSE : */
13 /* GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT */
14 /* USE THE LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG */
15 /* RECURRENCES. */
16
17 /* PARAMETERS : */
18 /*  II  NF  NUMBER OF VARIABLES. */
19 /*  II  NB  CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. */
20 /*         NB>0-SIMPLE BOUNDS ACCEPTED. */
21 /*  RI  X(NF)  VECTOR OF VARIABLES. */
22 /*  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE */
23 /*         X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). */
24 /*         IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND */
25 /*         XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. */
26 /*  RI  XL(NF)  VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. */
27 /*  RI  XU(NF)  VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. */
28 /*  RO  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION. */
29 /*  RO  S(NF)  DIRECTION VECTOR. */
30 /*  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE. */
31 /*  RI  GO(NF)  GRADIENTS DIFFERENCE. */
32 /*  RA  UO(NF)  AUXILIARY VECTOR. */
33 /*  RA  VO(NF)  AUXILIARY VECTOR. */
34 /*  RI  XMAX  MAXIMUM STEPSIZE. */
35 /*  RI  TOLX  TOLERANCE FOR CHANGE OF VARIABLES. */
36 /*  RI  TOLF  TOLERANCE FOR CHANGE OF FUNCTION VALUES. */
37 /*  RI  TOLB  TOLERANCE FOR THE FUNCTION VALUE. */
38 /*  RI  TOLG  TOLERANCE FOR THE GRADIENT NORM. */
39 /*  RI  MINF_EST  ESTIMATION OF THE MINIMUM FUNCTION VALUE. */
40 /*  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE. */
41 /*  RO  F  VALUE OF THE OBJECTIVE FUNCTION. */
42 /*  II  MIT  MAXIMUM NUMBER OF ITERATIONS. */
43 /*  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS. */
44 /*  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED. */
45 /*         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE MINF_EST. */
46 /*  II  MF  NUMBER OF LIMITED MEMORY STEPS. */
47 /*  IO  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION. */
48 /*         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN */
49 /*                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS. */
50 /*         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN */
51 /*                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS. */
52 /*         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB. */
53 /*         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG. */
54 /*         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED, */
55 /*                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE. */
56 /*         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV. */
57 /*         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED. */
58
59 /* VARIABLES IN COMMON /STAT/ (STATISTICS) : */
60 /*  IO  NRES  NUMBER OF RESTARTS. */
61 /*  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION. */
62 /*  IO  NIN  NUMBER OF INNER ITERATIONS. */
63 /*  IO  NIT  NUMBER OF ITERATIONS. */
64 /*  IO  NFV  NUMBER OF FUNCTION EVALUATIONS. */
65 /*  IO  NFG  NUMBER OF GRADIENT EVALUATIONS. */
66 /*  IO  NFH  NUMBER OF HESSIAN EVALUATIONS. */
67
68 /* SUBPROGRAMS USED : */
69 /*  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS. */
70 /*  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH. */
71 /*  S   PYADC0  ADDITION OF A BOX CONSTRAINT. */
72 /*  S   PYFUT1  TEST ON TERMINATION. */
73 /*  S   PYRMC0  DELETION OF A BOX CONSTRAINT. */
74 /*  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE METRIC */
75 /*         UPDATE. */
76 /*  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT. */
77 /*  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR. */
78 /*  S   MXDRCB BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION */
79 /*         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE. */
80 /*  S   MXDRCF FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION */
81 /*         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE. */
82 /*  S   MXDRSU SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B. */
83 /*         SHIFT OF ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN */
84 /*         THE LIMITED MEMORY BFGS METHOD. */
85 /*  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR. */
86 /*  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS. */
87 /*  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN. */
88 /*  S   MXVCOP  COPYING OF A VECTOR. */
89 /*  S   MXVSCL  SCALING OF A VECTOR. */
90
91 /* EXTERNAL SUBROUTINES : */
92 /*  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION. */
93 /*         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER */
94 /*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS */
95 /*         THE VALUE OF THE OBJECTIVE FUNCTION. */
96 /*  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION. */
97 /*         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER */
98 /*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF) */
99 /*         IS THE GRADIENT OF THE OBJECTIVE FUNCTION. */
100 /* -- OBJ and DOBJ are replaced by a single function, objgrad, in NLopt */
101
102 /* METHOD : */
103 /* LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG */
104 /* RECURRENCES. */
105
106 static void plis_(int *nf, int *nb, double *x, int *
107                   ix, double *xl, double *xu, double *gf, double *s, 
108                   double *xo, double *go, double *uo, double *vo, 
109                   double *xmax, double *tolx, double *tolf, double *
110                   tolb, double *tolg, nlopt_stopping *stop,
111                   double *minf_est, double *gmax, 
112                   double *f, int *mit, int *mfv, int *iest, int *mf,
113                   int *iterm, stat_common *stat_1,
114                   nlopt_func objgrad, void *objgrad_data)
115 {
116     /* System generated locals */
117     int i__1;
118     double d__1, d__2;
119
120     /* Builtin functions */
121
122     /* Local variables */
123     double a, b;
124     int i__, k, n;
125     double p, r__;
126     int kd, ld;
127     double fo, fp, po, pp, ro, rp;
128     int kbf, mfg;
129     int mes, kit;
130     double alf1, alf2, eta0, eta9, par1, par2;
131     int mes1, mes2, mes3;
132     double eps8, eps9;
133     int mred, iold, nred;
134     double maxf, dmax__;
135     int xstop = 0;
136     int inew;
137     double told;
138     int ites;
139     double rmin, rmax, umax, tolp, tols;
140     int isys;
141     int ires1, ires2;
142     int iterd, mtesf, ntesf;
143     double gnorm;
144     int iters, irest, inits, kters, maxst;
145     double snorm;
146     int mtesx, ntesx;
147     ps1l01_state state;
148
149 /*     INITIATION */
150
151     /* Parameter adjustments */
152     --vo;
153     --uo;
154     --go;
155     --xo;
156     --s;
157     --gf;
158     --xu;
159     --xl;
160     --ix;
161     --x;
162
163     /* Function Body */
164     kbf = 0;
165     if (*nb > 0) {
166         kbf = 2;
167     }
168     stat_1->nres = 0;
169     stat_1->ndec = 0;
170     stat_1->nin = 0;
171     stat_1->nit = 0;
172     stat_1->nfg = 0;
173     stat_1->nfh = 0;
174     isys = 0;
175     ites = 1;
176     mtesx = 2;
177     mtesf = 2;
178     inits = 2;
179     *iterm = 0;
180     iterd = 0;
181     iters = 2;
182     kters = 3;
183     irest = 0;
184     ires1 = 999;
185     ires2 = 0;
186     mred = 10;
187     mes = 4;
188     mes1 = 2;
189     mes2 = 2;
190     mes3 = 2;
191     eta0 = 1e-15;
192     eta9 = 1e120;
193     eps8 = 1.;
194     eps9 = 1e-8;
195     alf1 = 1e-10;
196     alf2 = 1e10;
197     rmax = eta9;
198     dmax__ = eta9;
199     maxf = 1e20;
200     if (*iest <= 0) {
201          *minf_est = -HUGE_VAL; /* changed from -1e60 by SGJ */
202     }
203     if (*iest > 0) {
204         *iest = 1;
205     }
206     if (*xmax <= 0.) {
207         *xmax = 1e16;
208     }
209     if (*tolx <= 0.) {
210         *tolx = 1e-16;
211     }
212     if (*tolf <= 0.) {
213         *tolf = 1e-14;
214     }
215     if (*tolg <= 0.) {
216          *tolg = 1e-8; /* SGJ: was 1e-6, but this sometimes stops too soon */
217     }
218 #if 0
219     /* removed by SGJ: this check prevented us from using minf_max <= 0,
220        which doesn't make sense.  Instead, if you don't want to have a
221        lower limit, you should set minf_max = -HUGE_VAL */
222     if (*tolb <= 0.) {
223         *tolb = *minf_est + 1e-16;
224     }
225 #endif
226     told = 1e-4;
227     tols = 1e-4;
228     tolp = .8;
229     /* changed by SGJ: default is no limit (INT_MAX) on # iterations/fevals */
230     if (*mit <= 0) {
231         *mit = INT_MAX;
232     }
233     if (*mfv <= 0) {
234         *mfv = INT_MAX;
235     }
236     mfg = *mfv;
237     kd = 1;
238     ld = -1;
239     kit = -(ires1 * *nf + ires2);
240     fo = *minf_est;
241
242 /*     INITIAL OPERATIONS WITH SIMPLE BOUNDS */
243
244     if (kbf > 0) {
245         i__1 = *nf;
246         for (i__ = 1; i__ <= i__1; ++i__) {
247             if ((ix[i__] == 3 || ix[i__] == 4) && xu[i__] <= xl[i__]) {
248                 xu[i__] = xl[i__];
249                 ix[i__] = 5;
250             } else if (ix[i__] == 5 || ix[i__] == 6) {
251                 xl[i__] = x[i__];
252                 xu[i__] = x[i__];
253                 ix[i__] = 5;
254             }
255 /* L2: */
256         }
257         luksan_pcbs04__(nf, &x[1], &ix[1], &xl[1], &xu[1], &eps9, &kbf);
258         luksan_pyadc0__(nf, &n, &x[1], &ix[1], &xl[1], &xu[1], &inew);
259     }
260     if (*iterm != 0) {
261         goto L11190;
262     }
263     *f = objgrad(*nf, &x[1], &gf[1], objgrad_data);
264     ++stop->nevals;
265     ++stat_1->nfg;
266     if (nlopt_stop_time(stop)) { *iterm = 100; goto L11190; }
267 L11120:
268     luksan_pytrcg__(nf, nf, &ix[1], &gf[1], &umax, gmax, &kbf, &iold);
269     luksan_pyfut1__(nf, f, &fo, &umax, gmax, xstop, stop, tolg, 
270             &kd, &stat_1->nit, &kit, mit, &stat_1->nfg, &mfg, 
271             &ntesx, &mtesx, &ntesf, &mtesf, &ites, &ires1, &ires2, &irest, &
272             iters, iterm);
273     if (*iterm != 0) {
274         goto L11190;
275     }
276     if (nlopt_stop_time(stop)) { *iterm = 100; goto L11190; }
277     if (kbf > 0 && rmax > 0.) {
278         luksan_pyrmc0__(nf, &n, &ix[1], &gf[1], &eps8, &umax, gmax, &rmax, &
279                 iold, &irest);
280     }
281 L11130:
282
283 /*     DIRECTION DETERMINATION */
284
285     gnorm = sqrt(luksan_mxudot__(nf, &gf[1], &gf[1], &ix[1], &kbf));
286     if (irest != 0) {
287         goto L12620;
288     }
289 /* Computing MIN */
290     i__1 = stat_1->nit - kit;
291     k = MIN2(i__1,*mf);
292     if (k <= 0) {
293         irest = MAX2(irest,1);
294         goto L12620;
295     }
296
297 /*     DETERMINATION OF THE PARAMETER B */
298
299     b = luksan_mxudot__(nf, &xo[1], &go[1], &ix[1], &kbf);
300     if (b <= 0.) {
301         irest = MAX2(irest,1);
302         goto L12620;
303     }
304     uo[1] = 1. / b;
305     luksan_mxuneg__(nf, &gf[1], &s[1], &ix[1], &kbf);
306     luksan_mxdrcb__(nf, &k, &xo[1], &go[1], &uo[1], &vo[1], &s[1], &ix[1], &
307             kbf);
308     a = luksan_mxudot__(nf, &go[1], &go[1], &ix[1], &kbf);
309     if (a > 0.) {
310         d__1 = b / a;
311         luksan_mxvscl__(nf, &d__1, &s[1], &s[1]);
312     }
313     luksan_mxdrcf__(nf, &k, &xo[1], &go[1], &uo[1], &vo[1], &s[1], &ix[1], &
314             kbf);
315     snorm = sqrt(luksan_mxudot__(nf, &s[1], &s[1], &ix[1], &kbf));
316 /* Computing MIN */
317     i__1 = k + 1;
318     k = MIN2(i__1,*mf);
319     luksan_mxdrsu__(nf, &k, &xo[1], &go[1], &uo[1]);
320 L12620:
321     iterd = 0;
322     if (irest != 0) {
323
324 /*     STEEPEST DESCENT DIRECTION */
325
326         luksan_mxuneg__(nf, &gf[1], &s[1], &ix[1], &kbf);
327         snorm = gnorm;
328         if (kit < stat_1->nit) {
329             ++stat_1->nres;
330             kit = stat_1->nit;
331         } else {
332              *iterm = -10;
333             if (iters < 0) {
334                 *iterm = iters - 5;
335             }
336         }
337     }
338
339 /*     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH */
340
341     if (kd > 0) {
342         p = luksan_mxudot__(nf, &gf[1], &s[1], &ix[1], &kbf);
343     }
344     if (iterd < 0) {
345         *iterm = iterd;
346     } else {
347
348 /*     TEST ON DESCENT DIRECTION */
349
350         if (snorm <= 0.) {
351             irest = MAX2(irest,1);
352         } else if (p + told * gnorm * snorm <= 0.) {
353             irest = 0;
354         } else {
355
356 /*     UNIFORM DESCENT CRITERION */
357
358             irest = MAX2(irest,1);
359         }
360         if (irest == 0) {
361
362 /*     PREPARATION OF LINE SEARCH */
363
364             nred = 0;
365             rmin = alf1 * gnorm / snorm;
366 /* Computing MIN */
367             d__1 = alf2 * gnorm / snorm, d__2 = *xmax / snorm;
368             rmax = MIN2(d__1,d__2);
369         }
370     }
371     if (*iterm != 0) {
372         goto L11190;
373     }
374     if (nlopt_stop_time(stop)) { *iterm = 100; goto L11190; }
375     if (irest != 0) {
376         goto L11130;
377     }
378     luksan_pytrcs__(nf, &x[1], &ix[1], &xo[1], &xl[1], &xu[1], &gf[1], &go[1],
379              &s[1], &ro, &fp, &fo, f, &po, &p, &rmax, &eta9, &kbf);
380     if (rmax == 0.) {
381         goto L11175;
382     }
383 L11170:
384     luksan_ps1l01__(&r__, &rp, f, &fo, &fp, &p, &po, &pp, minf_est, &maxf, &rmin, 
385             &rmax, &tols, &tolp, &par1, &par2, &kd, &ld, &stat_1->nit, &kit, &
386             nred, &mred, &maxst, iest, &inits, &iters, &kters, &mes,
387                     &isys, &state);
388     if (isys == 0) {
389         goto L11174;
390     }
391     luksan_mxudir__(nf, &r__, &s[1], &xo[1], &x[1], &ix[1], &kbf);
392     luksan_pcbs04__(nf, &x[1], &ix[1], &xl[1], &xu[1], &eps9, &kbf);
393     *f = objgrad(*nf, &x[1], &gf[1], objgrad_data);
394     ++stop->nevals;
395     ++stat_1->nfg;
396     p = luksan_mxudot__(nf, &gf[1], &s[1], &ix[1], &kbf);
397     goto L11170;
398 L11174:
399     if (iters <= 0) {
400         r__ = 0.;
401         *f = fo;
402         p = po;
403         luksan_mxvcop__(nf, &xo[1], &x[1]);
404         luksan_mxvcop__(nf, &go[1], &gf[1]);
405         irest = MAX2(irest,1);
406         ld = kd;
407         goto L11130;
408     }
409     luksan_pytrcd__(nf, &x[1], &ix[1], &xo[1], &gf[1], &go[1], &r__, f, &fo, &
410             p, &po, &dmax__, &kbf, &kd, &ld, &iters);
411     xstop = nlopt_stop_dx(stop, &x[1], &xo[1]);
412 L11175:
413     if (kbf > 0) {
414         luksan_mxvine__(nf, &ix[1]);
415         luksan_pyadc0__(nf, &n, &x[1], &ix[1], &xl[1], &xu[1], &inew);
416     }
417     goto L11120;
418 L11190:
419     return;
420 } /* plis_ */
421
422 /* NLopt wrapper around plis_, handling dynamic allocation etc. */
423 nlopt_result luksan_plis(int n, nlopt_func f, void *f_data,
424                   const double *lb, const double *ub, /* bounds */
425                   double *x, /* in: initial guess, out: minimizer */
426                   double *minf,
427                   nlopt_stopping *stop,
428                          int mf) /* subspace dimension, 0 for default */
429 {
430      int i, *ix, nb = 1;
431      double *work, *xl, *xu, *xo, *gf, *s, *go, *uo, *vo;
432      double gmax, minf_est;
433      double xmax = 0; /* no maximum */
434      double tolg = 0; /* default gradient tolerance */
435      int iest = 0; /* we have no estimate of min function value */
436      int mit = 0; /* default no limit on #iterations */
437      int mfv = stop->maxeval;
438      stat_common stat;
439      int iterm;
440
441      ix = (int*) malloc(sizeof(int) * n);
442      if (!ix) return NLOPT_OUT_OF_MEMORY;
443
444      if (mf <= 0) {
445           mf = MAX2(MEMAVAIL/n, 10);
446           if (stop->maxeval && stop->maxeval <= mf)
447                mf = MAX2(stop->maxeval, 1);
448      }
449
450  retry_alloc:
451      work = (double*) malloc(sizeof(double) * (n * 4 + MAX2(n,n*mf)*2 + 
452                                                MAX2(n,mf)*2));
453      if (!work) { 
454           if (mf > 0) {
455                mf = 0; /* allocate minimal memory */
456                goto retry_alloc;
457           }
458           free(ix);
459           return NLOPT_OUT_OF_MEMORY;
460      }
461
462      xl = work; xu = xl + n; gf = xu + n; s = gf + n; 
463      xo = s + n; go = xo + MAX2(n,n*mf);
464      uo = go + MAX2(n,n*mf); vo = uo + MAX2(n,mf);
465
466      for (i = 0; i < n; ++i) {
467           int lbu = lb[i] <= -0.99 * HUGE_VAL; /* lb unbounded */
468           int ubu = ub[i] >= 0.99 * HUGE_VAL;  /* ub unbounded */
469           ix[i] = lbu ? (ubu ? 0 : 2) : (ubu ? 1 : (lb[i] == ub[i] ? 5 : 3));
470           xl[i] = lb[i];
471           xu[i] = ub[i];
472      }
473
474      /* ?  xo does not seem to be initialized in the
475         original Fortran code, but it is used upon
476         input to plis if mf > 0 ... perhaps ALLOCATE initializes
477         arrays to zero by default? */
478      memset(xo, 0, sizeof(double) * MAX2(n,n*mf));
479
480      plis_(&n, &nb, x, ix, xl, xu, 
481            gf, s, xo, go, uo, vo,
482            &xmax,
483
484            /* fixme: pass tol_rel and tol_abs and use NLopt check */
485            &stop->xtol_rel,
486            &stop->ftol_rel,
487            &stop->minf_max,
488            &tolg,
489            stop,
490
491            &minf_est, &gmax,
492            minf,
493            &mit, &mfv,
494            &iest,
495            &mf,
496            &iterm, &stat,
497            f, f_data);
498
499      free(work);
500      free(ix);
501
502      switch (iterm) {
503          case 1: return NLOPT_XTOL_REACHED;
504          case 2: return NLOPT_FTOL_REACHED;
505          case 3: return NLOPT_MINF_MAX_REACHED;
506          case 4: return NLOPT_SUCCESS; /* gradient tolerance reached */
507          case 6: return NLOPT_SUCCESS;
508          case 12: case 13: return NLOPT_MAXEVAL_REACHED;
509          case 100: return NLOPT_MAXTIME_REACHED;
510          case -999: return NLOPT_FORCED_STOP;
511          default: return NLOPT_FAILURE;
512      }
513 }