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