OSVR-Core
newuoa.h
Go to the documentation of this file.
1 
17 /* SPDX-License-Identifier: MIT */
18 
19 /* NOTE: Original header comments from attractivechaos newuoa.hh follows: */
20 /*
21  This is NEWUOA for unconstrained minimization. The codes were written
22  by Powell in Fortran and then translated to C with f2c. I further
23  modified the code to make it independent of libf2c and f2c.h. Please
24  refer to "The NEWUOA software for unconstrained optimization without
25  derivatives", which is available at www.damtp.cam.ac.uk, for more
26  information.
27  Updated version from https://github.com/elsid/newuoa-cpp - further updated by
28  Ryan Pavlik.
29  */
30 /*
31  The original fortran codes are distributed without restrictions. The
32  C++ codes are distributed under MIT license.
33  */
34 
35 /* NOTE: The following header comment from attractivechaos newuoa.hh was
36  * preserved unmodified in the elsid version, but has been updated in this file
37  * to include the elsid copyright (a separate file in that repo) and Sensics
38  * copyright. */
39 /* The MIT License
40 
41  Copyright (c) 2004, by M.J.D. Powell <mjdp@cam.ac.uk>
42  2008, by Attractive Chaos <attractivechaos@aol.co.uk>
43  2015, by @elsid https://github.com/elsid/newuoa-cpp
44  2016, by Sensics, Inc. <http://sensics.com/osvr>
45 
46  Permission is hereby granted, free of charge, to any person obtaining
47  a copy of this software and associated documentation files (the
48  "Software"), to deal in the Software without restriction, including
49  without limitation the rights to use, copy, modify, merge, publish,
50  distribute, sublicense, and/or sell copies of the Software, and to
51  permit persons to whom the Software is furnished to do so, subject to
52  the following conditions:
53 
54  The above copyright notice and this permission notice shall be
55  included in all copies or substantial portions of the Software.
56 
57  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
58  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
59  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
60  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
61  BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
62  ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
63  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
64  SOFTWARE.
65 */
66 
67 #ifndef INCLUDED_newuoa_h_GUID_F9E56CF3_7B12_41A0_4A09_E2A02B48FAC1
68 #define INCLUDED_newuoa_h_GUID_F9E56CF3_7B12_41A0_4A09_E2A02B48FAC1
69 
70 #include <Eigen/Core>
71 
72 #include <cassert>
73 #include <cmath>
74 #include <cstddef>
75 #include <cstdio>
76 #include <cstdlib>
77 
78 #include <tuple>
79 #include <type_traits>
80 #include <utility>
81 
82 #define DEBUG_LOG(what)
83 #if 0
84 #ifdef DEBUG
85 #define DEBUG_LOG(what) DEBUG_LOG(what)
86 #else
87 #define DEBUG_LOG(what)
88 #endif
89 #endif
90 
91 namespace newuoa_detail {
92 
93 template <class Function>
94 void biglag(long n, long npt, double *xopt, double *xpt, double *bmat,
95  double *zmat, long *idz, long *ndim, long *knew, double *delta,
96  double *d__, double *alpha, double *hcol, double *gc, double *gd,
97  double *s, double *w, Function &&function) {
98  /* N is the number of variables. NPT is the number of interpolation
99  * equations. XOPT is the best interpolation point so far. XPT
100  * contains the coordinates of the current interpolation
101  * points. BMAT provides the last N columns of H. ZMAT and IDZ give
102  * a factorization of the first NPT by NPT submatrix of H. NDIM is
103  * the first dimension of BMAT and has the value NPT+N. KNEW is the
104  * index of the interpolation point that is going to be moved. DEBLLTA
105  * is the current trust region bound. D will be set to the step from
106  * XOPT to the new point. ABLLPHA will be set to the KNEW-th diagonal
107  * element of the H matrix. HCOBLL, GC, GD, S and W will be used for
108  * working space. */
109  /* The step D is calculated in a way that attempts to maximize the
110  * modulus of BLLFUNC(XOPT+D), subject to the bound ||D|| .BLLE. DEBLLTA,
111  * where BLLFUNC is the KNEW-th BLLagrange function. */
112 
113  long xpt_dim1, xpt_offset, bmat_dim1, bmat_offset, zmat_dim1, zmat_offset,
114  i__1, i__2, i__, j, k, iu, nptm, iterc, isave;
115  double sp, ss, cf1, cf2, cf3, cf4, cf5, dhd, cth, tau, sth, sum, temp, step,
116  angle, scale, denom, delsq, tempa, tempb, twopi, taubeg, tauold, taumax,
117  d__1, dd, gg;
118 
119  /* Parameter adjustments */
120  tempa = tempb = 0.0;
121  zmat_dim1 = npt;
122  zmat_offset = 1 + zmat_dim1;
123  zmat -= zmat_offset;
124  xpt_dim1 = npt;
125  xpt_offset = 1 + xpt_dim1;
126  xpt -= xpt_offset;
127  --xopt;
128  bmat_dim1 = *ndim;
129  bmat_offset = 1 + bmat_dim1;
130  bmat -= bmat_offset;
131  --d__;
132  --hcol;
133  --gc;
134  --gd;
135  --s;
136  --w;
137  /* Functiontion Body */
138  twopi = 2.0 * M_PI;
139  delsq = *delta * *delta;
140  nptm = npt - n - 1;
141  /* Set the first NPT components of HCOBLL to the leading elements of
142  * the KNEW-th column of H. */
143  iterc = 0;
144  i__1 = npt;
145  for (k = 1; k <= i__1; ++k)
146  hcol[k] = 0;
147  i__1 = nptm;
148  for (j = 1; j <= i__1; ++j) {
149  temp = zmat[*knew + j * zmat_dim1];
150  if (j < *idz)
151  temp = -temp;
152  i__2 = npt;
153  for (k = 1; k <= i__2; ++k)
154  hcol[k] += temp * zmat[k + j * zmat_dim1];
155  }
156  *alpha = hcol[*knew];
157  /* Set the unscaled initial direction D. Form the gradient of BLLFUNC
158  * atXOPT, and multiply D by the second derivative matrix of
159  * BLLFUNC. */
160  dd = 0;
161  i__2 = n;
162  for (i__ = 1; i__ <= i__2; ++i__) {
163  d__[i__] = xpt[*knew + i__ * xpt_dim1] - xopt[i__];
164  gc[i__] = bmat[*knew + i__ * bmat_dim1];
165  gd[i__] = 0;
166  /* Computing 2nd power */
167  d__1 = d__[i__];
168  dd += d__1 * d__1;
169  }
170  i__2 = npt;
171  for (k = 1; k <= i__2; ++k) {
172  temp = 0;
173  sum = 0;
174  i__1 = n;
175  for (j = 1; j <= i__1; ++j) {
176  temp += xpt[k + j * xpt_dim1] * xopt[j];
177  sum += xpt[k + j * xpt_dim1] * d__[j];
178  }
179  temp = hcol[k] * temp;
180  sum = hcol[k] * sum;
181  i__1 = n;
182  for (i__ = 1; i__ <= i__1; ++i__) {
183  gc[i__] += temp * xpt[k + i__ * xpt_dim1];
184  gd[i__] += sum * xpt[k + i__ * xpt_dim1];
185  }
186  }
187  /* Scale D and GD, with a sign change if required. Set S to another
188  * vector in the initial two dimensional subspace. */
189  gg = sp = dhd = 0;
190  i__1 = n;
191  for (i__ = 1; i__ <= i__1; ++i__) {
192  /* Computing 2nd power */
193  d__1 = gc[i__];
194  gg += d__1 * d__1;
195  sp += d__[i__] * gc[i__];
196  dhd += d__[i__] * gd[i__];
197  }
198  scale = *delta / sqrt(dd);
199  if (sp * dhd < 0)
200  scale = -scale;
201  temp = 0;
202  if (sp * sp > dd * .99 * gg)
203  temp = 1.0;
204  tau = scale * (fabs(sp) + 0.5 * scale * fabs(dhd));
205  if (gg * delsq < tau * .01 * tau)
206  temp = 1.0;
207  i__1 = n;
208  for (i__ = 1; i__ <= i__1; ++i__) {
209  d__[i__] = scale * d__[i__];
210  gd[i__] = scale * gd[i__];
211  s[i__] = gc[i__] + temp * gd[i__];
212  }
213  /* Begin the iteration by overwriting S with a vector that has the
214  * required length and direction, except that termination occurs if
215  * the given D and S are nearly parallel. */
216  for (iterc = 0; iterc != n; ++iterc) {
217  dd = sp = ss = 0;
218  i__1 = n;
219  for (i__ = 1; i__ <= i__1; ++i__) {
220  /* Computing 2nd power */
221  d__1 = d__[i__];
222  dd += d__1 * d__1;
223  sp += d__[i__] * s[i__];
224  /* Computing 2nd power */
225  d__1 = s[i__];
226  ss += d__1 * d__1;
227  }
228  temp = dd * ss - sp * sp;
229  if (temp <= dd * 1e-8 * ss)
230  return;
231  denom = sqrt(temp);
232  i__1 = n;
233  for (i__ = 1; i__ <= i__1; ++i__) {
234  s[i__] = (dd * s[i__] - sp * d__[i__]) / denom;
235  w[i__] = 0;
236  }
237  /* Calculate the coefficients of the objective function on the
238  * circle, beginning with the multiplication of S by the second
239  * derivative matrix. */
240  i__1 = npt;
241  for (k = 1; k <= i__1; ++k) {
242  sum = 0;
243  i__2 = n;
244  for (j = 1; j <= i__2; ++j)
245  sum += xpt[k + j * xpt_dim1] * s[j];
246  sum = hcol[k] * sum;
247  i__2 = n;
248  for (i__ = 1; i__ <= i__2; ++i__)
249  w[i__] += sum * xpt[k + i__ * xpt_dim1];
250  }
251  cf1 = cf2 = cf3 = cf4 = cf5 = 0;
252  i__2 = n;
253  for (i__ = 1; i__ <= i__2; ++i__) {
254  cf1 += s[i__] * w[i__];
255  cf2 += d__[i__] * gc[i__];
256  cf3 += s[i__] * gc[i__];
257  cf4 += d__[i__] * gd[i__];
258  cf5 += s[i__] * gd[i__];
259  }
260  cf1 = 0.5 * cf1;
261  cf4 = 0.5 * cf4 - cf1;
262  /* Seek the value of the angle that maximizes the modulus of TAU. */
263  taubeg = cf1 + cf2 + cf4;
264  taumax = tauold = taubeg;
265  isave = 0;
266  iu = 49;
267  temp = twopi / (double)(iu + 1);
268  i__2 = iu;
269  for (i__ = 1; i__ <= i__2; ++i__) {
270  angle = (double)i__ * temp;
271  cth = cos(angle);
272  sth = sin(angle);
273  tau = cf1 + (cf2 + cf4 * cth) * cth + (cf3 + cf5 * cth) * sth;
274  if (fabs(tau) > fabs(taumax)) {
275  taumax = tau;
276  isave = i__;
277  tempa = tauold;
278  } else if (i__ == isave + 1)
279  tempb = tau;
280  tauold = tau;
281  }
282  if (isave == 0)
283  tempa = tau;
284  if (isave == iu)
285  tempb = taubeg;
286  step = 0;
287  if (tempa != tempb) {
288  tempa -= taumax;
289  tempb -= taumax;
290  step = 0.5 * (tempa - tempb) / (tempa + tempb);
291  }
292  angle = temp * ((double)isave + step);
293  /* Calculate the new D and GD. Then test for convergence. */
294  cth = cos(angle);
295  sth = sin(angle);
296  tau = cf1 + (cf2 + cf4 * cth) * cth + (cf3 + cf5 * cth) * sth;
297  i__2 = n;
298  for (i__ = 1; i__ <= i__2; ++i__) {
299  d__[i__] = cth * d__[i__] + sth * s[i__];
300  gd[i__] = cth * gd[i__] + sth * w[i__];
301  s[i__] = gc[i__] + gd[i__];
302  }
303  if (fabs(tau) <= fabs(taubeg) * 1.1)
304  return;
305  }
306 }
307 
308 void bigden(long n, long npt, double *xopt, double *xpt, double *bmat,
309  double *zmat, long *idz, long *ndim, long *kopt, long *knew,
310  double *d__, double *w, double *vlag, double *beta, double *s,
311  double *wvec, double *prod) {
312  /* N is the number of variables.
313  * NPT is the number of interpolation equations.
314  * XOPT is the best interpolation point so far.
315  * XPT contains the coordinates of the current interpolation points.
316  * BMAT provides the last N columns of H.
317  * ZMAT and IDZ give a factorization of the first NPT by NPT
318  submatrix of H.
319  * NDIM is the first dimension of BMAT and has the value NPT+N.
320  * KOPT is the index of the optimal interpolation point.
321  * KNEW is the index of the interpolation point that is going to be
322  moved.
323  * D will be set to the step from XOPT to the new point, and on
324  entry it should be the D that was calculated by the last call of
325  BIGBDLAG. The length of the initial D provides a trust region bound
326  on the final D.
327  * W will be set to Wcheck for the final choice of D.
328  * VBDLAG will be set to Theta*Wcheck+e_b for the final choice of D.
329  * BETA will be set to the value that will occur in the updating
330  formula when the KNEW-th interpolation point is moved to its new
331  position.
332  * S, WVEC, PROD and the private arrays DEN, DENEX and PAR will be
333  used for working space.
334  * D is calculated in a way that should provide a denominator with a
335  large modulus in the updating formula when the KNEW-th
336  interpolation point is shifted to the new position XOPT+D. */
337 
338  long xpt_dim1, xpt_offset, bmat_dim1, bmat_offset, zmat_dim1, zmat_offset,
339  wvec_dim1, wvec_offset, prod_dim1, prod_offset, i__1, i__2, i__, j, k,
340  isave, iterc, jc, ip, iu, nw, ksav, nptm;
341  double dd, d__1, ds, ss, den[9], par[9], tau, sum, diff, temp, step, alpha,
342  angle, denex[9], tempa, tempb, tempc, ssden, dtest, xoptd, twopi, xopts,
343  denold, denmax, densav, dstemp, sumold, sstemp, xoptsq;
344 
345  /* Parameter adjustments */
346  zmat_dim1 = npt;
347  zmat_offset = 1 + zmat_dim1;
348  zmat -= zmat_offset;
349  xpt_dim1 = npt;
350  xpt_offset = 1 + xpt_dim1;
351  xpt -= xpt_offset;
352  --xopt;
353  prod_dim1 = *ndim;
354  prod_offset = 1 + prod_dim1;
355  prod -= prod_offset;
356  wvec_dim1 = *ndim;
357  wvec_offset = 1 + wvec_dim1;
358  wvec -= wvec_offset;
359  bmat_dim1 = *ndim;
360  bmat_offset = 1 + bmat_dim1;
361  bmat -= bmat_offset;
362  --d__;
363  --w;
364  --vlag;
365  --s;
366  /* Functiontion Body */
367  twopi = atan(1.0) * 8.;
368  nptm = npt - n - 1;
369  /* Store the first NPT elements of the KNEW-th column of H in W(N+1)
370  * to W(N+NPT). */
371  i__1 = npt;
372  for (k = 1; k <= i__1; ++k)
373  w[n + k] = 0;
374  i__1 = nptm;
375  for (j = 1; j <= i__1; ++j) {
376  temp = zmat[*knew + j * zmat_dim1];
377  if (j < *idz)
378  temp = -temp;
379  i__2 = npt;
380  for (k = 1; k <= i__2; ++k)
381  w[n + k] += temp * zmat[k + j * zmat_dim1];
382  }
383  alpha = w[n + *knew];
384  /* The initial search direction D is taken from the last call of
385  * BIGBDLAG, and the initial S is set below, usually to the direction
386  * from X_OPT to X_KNEW, but a different direction to an
387  * interpolation point may be chosen, in order to prevent S from
388  * being nearly parallel to D. */
389  dd = ds = ss = xoptsq = 0;
390  i__2 = n;
391  for (i__ = 1; i__ <= i__2; ++i__) {
392  /* Computing 2nd power */
393  d__1 = d__[i__];
394  dd += d__1 * d__1;
395  s[i__] = xpt[*knew + i__ * xpt_dim1] - xopt[i__];
396  ds += d__[i__] * s[i__];
397  /* Computing 2nd power */
398  d__1 = s[i__];
399  ss += d__1 * d__1;
400  /* Computing 2nd power */
401  d__1 = xopt[i__];
402  xoptsq += d__1 * d__1;
403  }
404  if (ds * ds > dd * .99 * ss) {
405  ksav = *knew;
406  dtest = ds * ds / ss;
407  i__2 = npt;
408  for (k = 1; k <= i__2; ++k) {
409  if (k != *kopt) {
410  dstemp = 0;
411  sstemp = 0;
412  i__1 = n;
413  for (i__ = 1; i__ <= i__1; ++i__) {
414  diff = xpt[k + i__ * xpt_dim1] - xopt[i__];
415  dstemp += d__[i__] * diff;
416  sstemp += diff * diff;
417  }
418  if (dstemp * dstemp / sstemp < dtest) {
419  ksav = k;
420  dtest = dstemp * dstemp / sstemp;
421  ds = dstemp;
422  ss = sstemp;
423  }
424  }
425  }
426  i__2 = n;
427  for (i__ = 1; i__ <= i__2; ++i__)
428  s[i__] = xpt[ksav + i__ * xpt_dim1] - xopt[i__];
429  }
430  ssden = dd * ss - ds * ds;
431  iterc = 0;
432  densav = 0;
433 /* Begin the iteration by overwriting S with a vector that has the
434  * required length and direction. */
435 BDL70:
436  ++iterc;
437  temp = 1.0 / sqrt(ssden);
438  xoptd = xopts = 0;
439  i__2 = n;
440  for (i__ = 1; i__ <= i__2; ++i__) {
441  s[i__] = temp * (dd * s[i__] - ds * d__[i__]);
442  xoptd += xopt[i__] * d__[i__];
443  xopts += xopt[i__] * s[i__];
444  }
445  /* Set the coefficients of the first 2.0 terms of BETA. */
446  tempa = 0.5 * xoptd * xoptd;
447  tempb = 0.5 * xopts * xopts;
448  den[0] = dd * (xoptsq + 0.5 * dd) + tempa + tempb;
449  den[1] = 2.0 * xoptd * dd;
450  den[2] = 2.0 * xopts * dd;
451  den[3] = tempa - tempb;
452  den[4] = xoptd * xopts;
453  for (i__ = 6; i__ <= 9; ++i__)
454  den[i__ - 1] = 0;
455  /* Put the coefficients of Wcheck in WVEC. */
456  i__2 = npt;
457  for (k = 1; k <= i__2; ++k) {
458  tempa = tempb = tempc = 0;
459  i__1 = n;
460  for (i__ = 1; i__ <= i__1; ++i__) {
461  tempa += xpt[k + i__ * xpt_dim1] * d__[i__];
462  tempb += xpt[k + i__ * xpt_dim1] * s[i__];
463  tempc += xpt[k + i__ * xpt_dim1] * xopt[i__];
464  }
465  wvec[k + wvec_dim1] = 0.25 * (tempa * tempa + tempb * tempb);
466  wvec[k + (wvec_dim1 << 1)] = tempa * tempc;
467  wvec[k + wvec_dim1 * 3] = tempb * tempc;
468  wvec[k + (wvec_dim1 << 2)] = 0.25 * (tempa * tempa - tempb * tempb);
469  wvec[k + wvec_dim1 * 5] = 0.5 * tempa * tempb;
470  }
471  i__2 = n;
472  for (i__ = 1; i__ <= i__2; ++i__) {
473  ip = i__ + npt;
474  wvec[ip + wvec_dim1] = 0;
475  wvec[ip + (wvec_dim1 << 1)] = d__[i__];
476  wvec[ip + wvec_dim1 * 3] = s[i__];
477  wvec[ip + (wvec_dim1 << 2)] = 0;
478  wvec[ip + wvec_dim1 * 5] = 0;
479  }
480  /* Put the coefficents of THETA*Wcheck in PROD. */
481  for (jc = 1; jc <= 5; ++jc) {
482  nw = npt;
483  if (jc == 2 || jc == 3)
484  nw = *ndim;
485  i__2 = npt;
486  for (k = 1; k <= i__2; ++k)
487  prod[k + jc * prod_dim1] = 0;
488  i__2 = nptm;
489  for (j = 1; j <= i__2; ++j) {
490  sum = 0;
491  i__1 = npt;
492  for (k = 1; k <= i__1; ++k)
493  sum += zmat[k + j * zmat_dim1] * wvec[k + jc * wvec_dim1];
494  if (j < *idz)
495  sum = -sum;
496  i__1 = npt;
497  for (k = 1; k <= i__1; ++k)
498  prod[k + jc * prod_dim1] += sum * zmat[k + j * zmat_dim1];
499  }
500  if (nw == *ndim) {
501  i__1 = npt;
502  for (k = 1; k <= i__1; ++k) {
503  sum = 0;
504  i__2 = n;
505  for (j = 1; j <= i__2; ++j)
506  sum += bmat[k + j * bmat_dim1] *
507  wvec[npt + j + jc * wvec_dim1];
508  prod[k + jc * prod_dim1] += sum;
509  }
510  }
511  i__1 = n;
512  for (j = 1; j <= i__1; ++j) {
513  sum = 0;
514  i__2 = nw;
515  for (i__ = 1; i__ <= i__2; ++i__)
516  sum += bmat[i__ + j * bmat_dim1] * wvec[i__ + jc * wvec_dim1];
517  prod[npt + j + jc * prod_dim1] = sum;
518  }
519  }
520  /* Include in DEN the part of BETA that depends on THETA. */
521  i__1 = *ndim;
522  for (k = 1; k <= i__1; ++k) {
523  sum = 0;
524  for (i__ = 1; i__ <= 5; ++i__) {
525  par[i__ - 1] =
526  0.5 * prod[k + i__ * prod_dim1] * wvec[k + i__ * wvec_dim1];
527  sum += par[i__ - 1];
528  }
529  den[0] = den[0] - par[0] - sum;
530  tempa = prod[k + prod_dim1] * wvec[k + (wvec_dim1 << 1)] +
531  prod[k + (prod_dim1 << 1)] * wvec[k + wvec_dim1];
532  tempb = prod[k + (prod_dim1 << 1)] * wvec[k + (wvec_dim1 << 2)] +
533  prod[k + (prod_dim1 << 2)] * wvec[k + (wvec_dim1 << 1)];
534  tempc = prod[k + prod_dim1 * 3] * wvec[k + wvec_dim1 * 5] +
535  prod[k + prod_dim1 * 5] * wvec[k + wvec_dim1 * 3];
536  den[1] = den[1] - tempa - 0.5 * (tempb + tempc);
537  den[5] -= 0.5 * (tempb - tempc);
538  tempa = prod[k + prod_dim1] * wvec[k + wvec_dim1 * 3] +
539  prod[k + prod_dim1 * 3] * wvec[k + wvec_dim1];
540  tempb = prod[k + (prod_dim1 << 1)] * wvec[k + wvec_dim1 * 5] +
541  prod[k + prod_dim1 * 5] * wvec[k + (wvec_dim1 << 1)];
542  tempc = prod[k + prod_dim1 * 3] * wvec[k + (wvec_dim1 << 2)] +
543  prod[k + (prod_dim1 << 2)] * wvec[k + wvec_dim1 * 3];
544  den[2] = den[2] - tempa - 0.5 * (tempb - tempc);
545  den[6] -= 0.5 * (tempb + tempc);
546  tempa = prod[k + prod_dim1] * wvec[k + (wvec_dim1 << 2)] +
547  prod[k + (prod_dim1 << 2)] * wvec[k + wvec_dim1];
548  den[3] = den[3] - tempa - par[1] + par[2];
549  tempa = prod[k + prod_dim1] * wvec[k + wvec_dim1 * 5] +
550  prod[k + prod_dim1 * 5] * wvec[k + wvec_dim1];
551  tempb = prod[k + (prod_dim1 << 1)] * wvec[k + wvec_dim1 * 3] +
552  prod[k + prod_dim1 * 3] * wvec[k + (wvec_dim1 << 1)];
553  den[4] = den[4] - tempa - 0.5 * tempb;
554  den[7] = den[7] - par[3] + par[4];
555  tempa = prod[k + (prod_dim1 << 2)] * wvec[k + wvec_dim1 * 5] +
556  prod[k + prod_dim1 * 5] * wvec[k + (wvec_dim1 << 2)];
557  den[8] -= 0.5 * tempa;
558  }
559  /* Extend DEN so that it holds all the coefficients of DENOM. */
560  sum = 0;
561  for (i__ = 1; i__ <= 5; ++i__) {
562  /* Computing 2nd power */
563  d__1 = prod[*knew + i__ * prod_dim1];
564  par[i__ - 1] = 0.5 * (d__1 * d__1);
565  sum += par[i__ - 1];
566  }
567  denex[0] = alpha * den[0] + par[0] + sum;
568  tempa = 2.0 * prod[*knew + prod_dim1] * prod[*knew + (prod_dim1 << 1)];
569  tempb = prod[*knew + (prod_dim1 << 1)] * prod[*knew + (prod_dim1 << 2)];
570  tempc = prod[*knew + prod_dim1 * 3] * prod[*knew + prod_dim1 * 5];
571  denex[1] = alpha * den[1] + tempa + tempb + tempc;
572  denex[5] = alpha * den[5] + tempb - tempc;
573  tempa = 2.0 * prod[*knew + prod_dim1] * prod[*knew + prod_dim1 * 3];
574  tempb = prod[*knew + (prod_dim1 << 1)] * prod[*knew + prod_dim1 * 5];
575  tempc = prod[*knew + prod_dim1 * 3] * prod[*knew + (prod_dim1 << 2)];
576  denex[2] = alpha * den[2] + tempa + tempb - tempc;
577  denex[6] = alpha * den[6] + tempb + tempc;
578  tempa = 2.0 * prod[*knew + prod_dim1] * prod[*knew + (prod_dim1 << 2)];
579  denex[3] = alpha * den[3] + tempa + par[1] - par[2];
580  tempa = 2.0 * prod[*knew + prod_dim1] * prod[*knew + prod_dim1 * 5];
581  denex[4] = alpha * den[4] + tempa +
582  prod[*knew + (prod_dim1 << 1)] * prod[*knew + prod_dim1 * 3];
583  denex[7] = alpha * den[7] + par[3] - par[4];
584  denex[8] = alpha * den[8] +
585  prod[*knew + (prod_dim1 << 2)] * prod[*knew + prod_dim1 * 5];
586  /* Seek the value of the angle that maximizes the modulus of DENOM. */
587  sum = denex[0] + denex[1] + denex[3] + denex[5] + denex[7];
588  denold = denmax = sum;
589  isave = 0;
590  iu = 49;
591  temp = twopi / (double)(iu + 1);
592  par[0] = 1.0;
593  i__1 = iu;
594  for (i__ = 1; i__ <= i__1; ++i__) {
595  angle = (double)i__ * temp;
596  par[1] = cos(angle);
597  par[2] = sin(angle);
598  for (j = 4; j <= 8; j += 2) {
599  par[j - 1] = par[1] * par[j - 3] - par[2] * par[j - 2];
600  par[j] = par[1] * par[j - 2] + par[2] * par[j - 3];
601  }
602  sumold = sum;
603  sum = 0;
604  for (j = 1; j <= 9; ++j)
605  sum += denex[j - 1] * par[j - 1];
606  if (fabs(sum) > fabs(denmax)) {
607  denmax = sum;
608  isave = i__;
609  tempa = sumold;
610  } else if (i__ == isave + 1) {
611  tempb = sum;
612  }
613  }
614  if (isave == 0)
615  tempa = sum;
616  if (isave == iu)
617  tempb = denold;
618  step = 0;
619  if (tempa != tempb) {
620  tempa -= denmax;
621  tempb -= denmax;
622  step = 0.5 * (tempa - tempb) / (tempa + tempb);
623  }
624  angle = temp * ((double)isave + step);
625  /* Calculate the new parameters of the denominator, the new VBDLAG
626  * vector and the new D. Then test for convergence. */
627  par[1] = cos(angle);
628  par[2] = sin(angle);
629  for (j = 4; j <= 8; j += 2) {
630  par[j - 1] = par[1] * par[j - 3] - par[2] * par[j - 2];
631  par[j] = par[1] * par[j - 2] + par[2] * par[j - 3];
632  }
633  *beta = 0;
634  denmax = 0;
635  for (j = 1; j <= 9; ++j) {
636  *beta += den[j - 1] * par[j - 1];
637  denmax += denex[j - 1] * par[j - 1];
638  }
639  i__1 = *ndim;
640  for (k = 1; k <= i__1; ++k) {
641  vlag[k] = 0;
642  for (j = 1; j <= 5; ++j)
643  vlag[k] += prod[k + j * prod_dim1] * par[j - 1];
644  }
645  tau = vlag[*knew];
646  dd = tempa = tempb = 0;
647  i__1 = n;
648  for (i__ = 1; i__ <= i__1; ++i__) {
649  d__[i__] = par[1] * d__[i__] + par[2] * s[i__];
650  w[i__] = xopt[i__] + d__[i__];
651  /* Computing 2nd power */
652  d__1 = d__[i__];
653  dd += d__1 * d__1;
654  tempa += d__[i__] * w[i__];
655  tempb += w[i__] * w[i__];
656  }
657  if (iterc >= n)
658  goto BDL340;
659  if (iterc > 1)
660  densav = fmax(densav, denold);
661  if (fabs(denmax) <= fabs(densav) * 1.1)
662  goto BDL340;
663  densav = denmax;
664  /* Set S to 0.5 the gradient of the denominator with respect to
665  * D. Then branch for the next iteration. */
666  i__1 = n;
667  for (i__ = 1; i__ <= i__1; ++i__) {
668  temp = tempa * xopt[i__] + tempb * d__[i__] - vlag[npt + i__];
669  s[i__] = tau * bmat[*knew + i__ * bmat_dim1] + alpha * temp;
670  }
671  i__1 = npt;
672  for (k = 1; k <= i__1; ++k) {
673  sum = 0;
674  i__2 = n;
675  for (j = 1; j <= i__2; ++j)
676  sum += xpt[k + j * xpt_dim1] * w[j];
677  temp = (tau * w[n + k] - alpha * vlag[k]) * sum;
678  i__2 = n;
679  for (i__ = 1; i__ <= i__2; ++i__)
680  s[i__] += temp * xpt[k + i__ * xpt_dim1];
681  }
682  ss = 0;
683  ds = 0;
684  i__2 = n;
685  for (i__ = 1; i__ <= i__2; ++i__) {
686  /* Computing 2nd power */
687  d__1 = s[i__];
688  ss += d__1 * d__1;
689  ds += d__[i__] * s[i__];
690  }
691  ssden = dd * ss - ds * ds;
692  if (ssden >= dd * 1e-8 * ss)
693  goto BDL70;
694 /* Set the vector W before the RETURN from the subroutine. */
695 BDL340:
696  i__2 = *ndim;
697  for (k = 1; k <= i__2; ++k) {
698  w[k] = 0;
699  for (j = 1; j <= 5; ++j)
700  w[k] += wvec[k + j * wvec_dim1] * par[j - 1];
701  }
702  vlag[*kopt] += 1.0;
703 }
704 
705 void trsapp(long n, long npt, double *xopt, double *xpt, double *gq, double *hq,
706  double *pq, double *delta, double *step, double *d__, double *g,
707  double *hd, double *hs, double *crvmin) {
708  /* The arguments NPT, XOPT, XPT, GQ, HQ and PQ have their usual
709  * meanings, in order to define the current quadratic model Q.
710  * DETRLTA is the trust region radius, and has to be positive. STEP
711  * will be set to the calculated trial step. The arrays D, G, HD and
712  * HS will be used for working space. CRVMIN will be set to the
713  * least curvature of H aint the conjugate directions that occur,
714  * except that it is set to 0 if STEP goes all the way to the trust
715  * region boundary. The calculation of STEP begins with the
716  * truncated conjugate gradient method. If the boundary of the trust
717  * region is reached, then further changes to STEP may be made, each
718  * one being in the 2D space spanned by the current STEP and the
719  * corresponding gradient of Q. Thus STEP should provide a
720  * substantial reduction to Q within the trust region. */
721 
722  long xpt_dim1, xpt_offset, i__1, i__2, i__, j, k, ih, iu, iterc, isave,
723  itersw, itermax;
724  double d__1, d__2, dd, cf, dg, gg, ds, sg, ss, dhd, dhs, cth, sgk, shs, sth,
725  qadd, qbeg, qred, qmin, temp, qsav, qnew, ggbeg, alpha, angle, reduc,
726  ggsav, delsq, tempa, tempb, bstep, ratio, twopi, angtest;
727 
728  /* Parameter adjustments */
729  tempa = tempb = shs = sg = bstep = ggbeg = gg = qred = dd = 0.0;
730  xpt_dim1 = npt;
731  xpt_offset = 1 + xpt_dim1;
732  xpt -= xpt_offset;
733  --xopt;
734  --gq;
735  --hq;
736  --pq;
737  --step;
738  --d__;
739  --g;
740  --hd;
741  --hs;
742  /* Functiontion Body */
743  twopi = 2.0 * M_PI;
744  delsq = *delta * *delta;
745  iterc = 0;
746  itermax = n;
747  itersw = itermax;
748  i__1 = n;
749  for (i__ = 1; i__ <= i__1; ++i__)
750  d__[i__] = xopt[i__];
751  goto TRL170;
752 /* Prepare for the first line search. */
753 TRL20:
754  qred = dd = 0;
755  i__1 = n;
756  for (i__ = 1; i__ <= i__1; ++i__) {
757  step[i__] = 0;
758  hs[i__] = 0;
759  g[i__] = gq[i__] + hd[i__];
760  d__[i__] = -g[i__];
761  /* Computing 2nd power */
762  d__1 = d__[i__];
763  dd += d__1 * d__1;
764  }
765  *crvmin = 0;
766  if (dd == 0)
767  goto TRL160;
768  ds = ss = 0;
769  gg = dd;
770  ggbeg = gg;
771 /* Calculate the step to the trust region boundary and the product
772  * HD. */
773 TRL40:
774  ++iterc;
775  temp = delsq - ss;
776  bstep = temp / (ds + sqrt(ds * ds + dd * temp));
777  goto TRL170;
778 TRL50:
779  dhd = 0;
780  i__1 = n;
781  for (j = 1; j <= i__1; ++j)
782  dhd += d__[j] * hd[j];
783  /* Update CRVMIN and set the step-length ATRLPHA. */
784  alpha = bstep;
785  if (dhd > 0) {
786  temp = dhd / dd;
787  if (iterc == 1)
788  *crvmin = temp;
789  *crvmin = fmin(*crvmin, temp);
790  /* Computing MIN */
791  d__1 = alpha, d__2 = gg / dhd;
792  alpha = fmin(d__1, d__2);
793  }
794  qadd = alpha * (gg - 0.5 * alpha * dhd);
795  qred += qadd;
796  /* Update STEP and HS. */
797  ggsav = gg;
798  gg = 0;
799  i__1 = n;
800  for (i__ = 1; i__ <= i__1; ++i__) {
801  step[i__] += alpha * d__[i__];
802  hs[i__] += alpha * hd[i__];
803  /* Computing 2nd power */
804  d__1 = g[i__] + hs[i__];
805  gg += d__1 * d__1;
806  }
807  /* Begin another conjugate direction iteration if required. */
808  if (alpha < bstep) {
809  if (qadd <= qred * .01 || gg <= ggbeg * 1e-4 || iterc == itermax)
810  goto TRL160;
811  temp = gg / ggsav;
812  dd = ds = ss = 0;
813  i__1 = n;
814  for (i__ = 1; i__ <= i__1; ++i__) {
815  d__[i__] = temp * d__[i__] - g[i__] - hs[i__];
816  /* Computing 2nd power */
817  d__1 = d__[i__];
818  dd += d__1 * d__1;
819  ds += d__[i__] * step[i__];
820  /* Computing 2nd power */
821  d__1 = step[i__];
822  ss += d__1 * d__1;
823  }
824  if (ds <= 0)
825  goto TRL160;
826  if (ss < delsq)
827  goto TRL40;
828  }
829  *crvmin = 0;
830  itersw = iterc;
831 /* Test whether an alternative iteration is required. */
832 TRL90:
833  if (gg <= ggbeg * 1e-4)
834  goto TRL160;
835  sg = 0;
836  shs = 0;
837  i__1 = n;
838  for (i__ = 1; i__ <= i__1; ++i__) {
839  sg += step[i__] * g[i__];
840  shs += step[i__] * hs[i__];
841  }
842  sgk = sg + shs;
843  angtest = sgk / sqrt(gg * delsq);
844  if (angtest <= -.99)
845  goto TRL160;
846  /* Begin the alternative iteration by calculating D and HD and some
847  * scalar products. */
848  ++iterc;
849  temp = sqrt(delsq * gg - sgk * sgk);
850  tempa = delsq / temp;
851  tempb = sgk / temp;
852  i__1 = n;
853  for (i__ = 1; i__ <= i__1; ++i__)
854  d__[i__] = tempa * (g[i__] + hs[i__]) - tempb * step[i__];
855  goto TRL170;
856 TRL120:
857  dg = dhd = dhs = 0;
858  i__1 = n;
859  for (i__ = 1; i__ <= i__1; ++i__) {
860  dg += d__[i__] * g[i__];
861  dhd += hd[i__] * d__[i__];
862  dhs += hd[i__] * step[i__];
863  }
864  /* Seek the value of the angle that minimizes Q. */
865  cf = 0.5 * (shs - dhd);
866  qbeg = sg + cf;
867  qsav = qmin = qbeg;
868  isave = 0;
869  iu = 49;
870  temp = twopi / (double)(iu + 1);
871  i__1 = iu;
872  for (i__ = 1; i__ <= i__1; ++i__) {
873  angle = (double)i__ * temp;
874  cth = cos(angle);
875  sth = sin(angle);
876  qnew = (sg + cf * cth) * cth + (dg + dhs * cth) * sth;
877  if (qnew < qmin) {
878  qmin = qnew;
879  isave = i__;
880  tempa = qsav;
881  } else if (i__ == isave + 1)
882  tempb = qnew;
883  qsav = qnew;
884  }
885  if ((double)isave == 0)
886  tempa = qnew;
887  if (isave == iu)
888  tempb = qbeg;
889  angle = 0;
890  if (tempa != tempb) {
891  tempa -= qmin;
892  tempb -= qmin;
893  angle = 0.5 * (tempa - tempb) / (tempa + tempb);
894  }
895  angle = temp * ((double)isave + angle);
896  /* Calculate the new STEP and HS. Then test for convergence. */
897  cth = cos(angle);
898  sth = sin(angle);
899  reduc = qbeg - (sg + cf * cth) * cth - (dg + dhs * cth) * sth;
900  gg = 0;
901  i__1 = n;
902  for (i__ = 1; i__ <= i__1; ++i__) {
903  step[i__] = cth * step[i__] + sth * d__[i__];
904  hs[i__] = cth * hs[i__] + sth * hd[i__];
905  /* Computing 2nd power */
906  d__1 = g[i__] + hs[i__];
907  gg += d__1 * d__1;
908  }
909  qred += reduc;
910  ratio = reduc / qred;
911  if (iterc < itermax && ratio > .01)
912  goto TRL90;
913 TRL160:
914  return;
915 /* The following instructions act as a subroutine for setting the
916  * vector HD to the vector D multiplied by the second derivative
917  * matrix of Q. They are called from three different places, which
918  * are distinguished by the value of ITERC. */
919 TRL170:
920  i__1 = n;
921  for (i__ = 1; i__ <= i__1; ++i__)
922  hd[i__] = 0;
923  i__1 = npt;
924  for (k = 1; k <= i__1; ++k) {
925  temp = 0;
926  i__2 = n;
927  for (j = 1; j <= i__2; ++j)
928  temp += xpt[k + j * xpt_dim1] * d__[j];
929  temp *= pq[k];
930  i__2 = n;
931  for (i__ = 1; i__ <= i__2; ++i__)
932  hd[i__] += temp * xpt[k + i__ * xpt_dim1];
933  }
934  ih = 0;
935  i__2 = n;
936  for (j = 1; j <= i__2; ++j) {
937  i__1 = j;
938  for (i__ = 1; i__ <= i__1; ++i__) {
939  ++ih;
940  if (i__ < j)
941  hd[j] += hq[ih] * d__[i__];
942  hd[i__] += hq[ih] * d__[j];
943  }
944  }
945  if (iterc == 0)
946  goto TRL20;
947  if (iterc <= itersw)
948  goto TRL50;
949  goto TRL120;
950 }
951 
952 void update(long n, long npt, double *bmat, double *zmat, long *idz, long *ndim,
953  double *vlag, double *beta, long *knew, double *w) {
954  /* The arrays BMAT and ZMAT with IDZ are updated, in order to shift
955  * the interpolation point that has index KNEW. On entry, VLAG
956  * contains the components of the vector Theta*Wcheck+e_b of the
957  * updating formula (6.11), and BETA holds the value of the
958  * parameter that has this name. The vector W is used for working
959  * space. */
960 
961  long bmat_dim1, bmat_offset, zmat_dim1, zmat_offset, i__1, i__2, i__, j, ja,
962  jb, jl, jp, nptm, iflag;
963  double d__1, d__2, tau, temp, scala, scalb, alpha, denom, tempa, tempb,
964  tausq;
965 
966  /* Parameter adjustments */
967  tempb = 0.0;
968  zmat_dim1 = npt;
969  zmat_offset = 1 + zmat_dim1;
970  zmat -= zmat_offset;
971  bmat_dim1 = *ndim;
972  bmat_offset = 1 + bmat_dim1;
973  bmat -= bmat_offset;
974  --vlag;
975  --w;
976  /* Functiontion Body */
977  nptm = npt - n - 1;
978  /* Apply the rotations that put zeros in the KNEW-th row of ZMAT. */
979  jl = 1;
980  i__1 = nptm;
981  for (j = 2; j <= i__1; ++j) {
982  if (j == *idz) {
983  jl = *idz;
984  } else if (zmat[*knew + j * zmat_dim1] != 0) {
985  /* Computing 2nd power */
986  d__1 = zmat[*knew + jl * zmat_dim1];
987  /* Computing 2nd power */
988  d__2 = zmat[*knew + j * zmat_dim1];
989  temp = sqrt(d__1 * d__1 + d__2 * d__2);
990  tempa = zmat[*knew + jl * zmat_dim1] / temp;
991  tempb = zmat[*knew + j * zmat_dim1] / temp;
992  i__2 = npt;
993  for (i__ = 1; i__ <= i__2; ++i__) {
994  temp = tempa * zmat[i__ + jl * zmat_dim1] +
995  tempb * zmat[i__ + j * zmat_dim1];
996  zmat[i__ + j * zmat_dim1] = tempa * zmat[i__ + j * zmat_dim1] -
997  tempb * zmat[i__ + jl * zmat_dim1];
998  zmat[i__ + jl * zmat_dim1] = temp;
999  }
1000  zmat[*knew + j * zmat_dim1] = 0;
1001  }
1002  }
1003  /* Put the first NPT components of the KNEW-th column of HLAG into
1004  * W, and calculate the parameters of the updating formula. */
1005  tempa = zmat[*knew + zmat_dim1];
1006  if (*idz >= 2)
1007  tempa = -tempa;
1008  if (jl > 1)
1009  tempb = zmat[*knew + jl * zmat_dim1];
1010  i__1 = npt;
1011  for (i__ = 1; i__ <= i__1; ++i__) {
1012  w[i__] = tempa * zmat[i__ + zmat_dim1];
1013  if (jl > 1)
1014  w[i__] += tempb * zmat[i__ + jl * zmat_dim1];
1015  }
1016  alpha = w[*knew];
1017  tau = vlag[*knew];
1018  tausq = tau * tau;
1019  denom = alpha * *beta + tausq;
1020  vlag[*knew] -= 1.0;
1021  /* Complete the updating of ZMAT when there is only 1.0 nonzero
1022  * element in the KNEW-th row of the new matrix ZMAT, but, if IFLAG
1023  * is set to 1.0, then the first column of ZMAT will be exchanged
1024  * with another 1.0 later. */
1025  iflag = 0;
1026  if (jl == 1) {
1027  temp = sqrt((fabs(denom)));
1028  tempb = tempa / temp;
1029  tempa = tau / temp;
1030  i__1 = npt;
1031  for (i__ = 1; i__ <= i__1; ++i__)
1032  zmat[i__ + zmat_dim1] =
1033  tempa * zmat[i__ + zmat_dim1] - tempb * vlag[i__];
1034  if (*idz == 1 && temp < 0)
1035  *idz = 2;
1036  if (*idz >= 2 && temp >= 0)
1037  iflag = 1;
1038  } else {
1039  /* Complete the updating of ZMAT in the alternative case. */
1040  ja = 1;
1041  if (*beta >= 0) {
1042  ja = jl;
1043  }
1044  jb = jl + 1 - ja;
1045  temp = zmat[*knew + jb * zmat_dim1] / denom;
1046  tempa = temp * *beta;
1047  tempb = temp * tau;
1048  temp = zmat[*knew + ja * zmat_dim1];
1049  scala = 1.0 / sqrt(fabs(*beta) * temp * temp + tausq);
1050  scalb = scala * sqrt((fabs(denom)));
1051  i__1 = npt;
1052  for (i__ = 1; i__ <= i__1; ++i__) {
1053  zmat[i__ + ja * zmat_dim1] =
1054  scala * (tau * zmat[i__ + ja * zmat_dim1] - temp * vlag[i__]);
1055  zmat[i__ + jb * zmat_dim1] =
1056  scalb * (zmat[i__ + jb * zmat_dim1] - tempa * w[i__] -
1057  tempb * vlag[i__]);
1058  }
1059  if (denom <= 0) {
1060  if (*beta < 0)
1061  ++(*idz);
1062  if (*beta >= 0)
1063  iflag = 1;
1064  }
1065  }
1066  /* IDZ is reduced in the following case, and usually the first
1067  * column of ZMAT is exchanged with a later 1.0. */
1068  if (iflag == 1) {
1069  --(*idz);
1070  i__1 = npt;
1071  for (i__ = 1; i__ <= i__1; ++i__) {
1072  temp = zmat[i__ + zmat_dim1];
1073  zmat[i__ + zmat_dim1] = zmat[i__ + *idz * zmat_dim1];
1074  zmat[i__ + *idz * zmat_dim1] = temp;
1075  }
1076  }
1077  /* Finally, update the matrix BMAT. */
1078  i__1 = n;
1079  for (j = 1; j <= i__1; ++j) {
1080  jp = npt + j;
1081  w[jp] = bmat[*knew + j * bmat_dim1];
1082  tempa = (alpha * vlag[jp] - tau * w[jp]) / denom;
1083  tempb = (-(*beta) * w[jp] - tau * vlag[jp]) / denom;
1084  i__2 = jp;
1085  for (i__ = 1; i__ <= i__2; ++i__) {
1086  bmat[i__ + j * bmat_dim1] =
1087  bmat[i__ + j * bmat_dim1] + tempa * vlag[i__] + tempb * w[i__];
1088  if (i__ > npt) {
1089  bmat[jp + (i__ - npt) * bmat_dim1] = bmat[i__ + j * bmat_dim1];
1090  }
1091  }
1092  }
1093  return;
1094 }
1095 
1096 template <class Function>
1097 double newuob(long n, long npt, double *x, double rhobeg, double rhoend,
1098  long maxfun, double *xbase, double *xopt, double *xnew,
1099  double *xpt, double *fval, double *gq, double *hq, double *pq,
1100  double *bmat, double *zmat, long *ndim, double *d__, double *vlag,
1101  double *w, Function &&function) {
1102  /* XBASE will hold a shift of origin that should reduce the
1103  contributions from rounding errors to values of the model and
1104  Lagrange functions.
1105  * XOPT will be set to the displacement from XBASE of the vector of
1106  variables that provides the least calculated F so far.
1107  * XNEW will be set to the displacement from XBASE of the vector of
1108  variables for the current calculation of F.
1109  * XPT will contain the interpolation point coordinates relative to
1110  XBASE.
1111  * FVAL will hold the values of F at the interpolation points.
1112  * GQ will hold the gradient of the quadratic model at XBASE.
1113  * HQ will hold the explicit second derivatives of the quadratic
1114  model.
1115  * PQ will contain the parameters of the implicit second derivatives
1116  of the quadratic model.
1117  * BMAT will hold the last N columns of H.
1118  * ZMAT will hold the factorization of the leading NPT by NPT
1119  submatrix of H, this factorization being ZMAT times Diag(DZ)
1120  times ZMAT^T, where the elements of DZ are plus or minus 1.0, as
1121  specified by IDZ.
1122  * NDIM is the first dimension of BMAT and has the value NPT+N.
1123  * D is reserved for trial steps from XOPT.
1124  * VLAG will contain the values of the Lagrange functions at a new
1125  point X. They are part of a product that requires VLAG to be of
1126  length NDIM.
1127  * The array W will be used for working space. Its length must be at
1128  least 10*NDIM = 10*(NPT+N). Set some constants. */
1129 
1130  long xpt_dim1, xpt_offset, bmat_dim1, bmat_offset, zmat_dim1, zmat_offset,
1131  i__1, i__2, i__3, i__, j, k, ih, nf, nh, ip, jp, np, nfm, idz, ipt, jpt,
1132  nfmm, knew, kopt, nptm, ksave, nfsav, itemp, ktemp, itest, nftest;
1133  double d__1, d__2, d__3, f, dx, dsq, rho, sum, fbeg, diff, beta, gisq, temp,
1134  suma, sumb, fopt, bsum, gqsq, xipt, xjpt, sumz, diffa, diffb, diffc,
1135  hdiag, alpha, delta = 0.0, recip, reciq, fsave, dnorm, ratio, dstep,
1136  vquad, tempq, rhosq, detrat, crvmin = 0.0, distsq, xoptsq;
1137 
1138  /* Parameter adjustments */
1139  diffc = ratio = dnorm = diffa = diffb = xoptsq = f = 0.0;
1140  nfsav = 0;
1141  rho = fbeg = fopt = xjpt = xipt = 0.0;
1142  itest = ipt = jpt = 0;
1143  alpha = dstep = 0.0;
1144  zmat_dim1 = npt;
1145  zmat_offset = 1 + zmat_dim1;
1146  zmat -= zmat_offset;
1147  xpt_dim1 = npt;
1148  xpt_offset = 1 + xpt_dim1;
1149  xpt -= xpt_offset;
1150  --x;
1151  --xbase;
1152  --xopt;
1153  --xnew;
1154  --fval;
1155  --gq;
1156  --hq;
1157  --pq;
1158  bmat_dim1 = *ndim;
1159  bmat_offset = 1 + bmat_dim1;
1160  bmat -= bmat_offset;
1161  --d__;
1162  --vlag;
1163  --w;
1164  /* Functiontion Body */
1165  np = n + 1;
1166  nh = n * np / 2;
1167  nptm = npt - np;
1168  nftest = (maxfun > 1) ? maxfun : 1;
1169  /* Set the initial elements of XPT, BMAT, HQ, PQ and ZMAT to 0. */
1170  i__1 = n;
1171  for (j = 1; j <= i__1; ++j) {
1172  xbase[j] = x[j];
1173  i__2 = npt;
1174  for (k = 1; k <= i__2; ++k)
1175  xpt[k + j * xpt_dim1] = 0;
1176  i__2 = *ndim;
1177  for (i__ = 1; i__ <= i__2; ++i__)
1178  bmat[i__ + j * bmat_dim1] = 0;
1179  }
1180  i__2 = nh;
1181  for (ih = 1; ih <= i__2; ++ih)
1182  hq[ih] = 0;
1183  i__2 = npt;
1184  for (k = 1; k <= i__2; ++k) {
1185  pq[k] = 0;
1186  i__1 = nptm;
1187  for (j = 1; j <= i__1; ++j)
1188  zmat[k + j * zmat_dim1] = 0;
1189  }
1190  /* Begin the initialization procedure. NF becomes 1.0 more than the
1191  * number of function values so far. The coordinates of the
1192  * displacement of the next initial interpolation point from XBASE
1193  * are set in XPT(NF,.). */
1194  rhosq = rhobeg * rhobeg;
1195  recip = 1.0 / rhosq;
1196  reciq = sqrt(.5) / rhosq;
1197  nf = 0;
1198 L50:
1199  nfm = nf;
1200  nfmm = nf - n;
1201  ++nf;
1202  if (nfm <= n << 1) {
1203  if (nfm >= 1 && nfm <= n) {
1204  xpt[nf + nfm * xpt_dim1] = rhobeg;
1205  } else if (nfm > n) {
1206  xpt[nf + nfmm * xpt_dim1] = -(rhobeg);
1207  }
1208  } else {
1209  itemp = (nfmm - 1) / n;
1210  jpt = nfm - itemp * n - n;
1211  ipt = jpt + itemp;
1212  if (ipt > n) {
1213  itemp = jpt;
1214  jpt = ipt - n;
1215  ipt = itemp;
1216  }
1217  xipt = rhobeg;
1218  if (fval[ipt + np] < fval[ipt + 1])
1219  xipt = -xipt;
1220  xjpt = rhobeg;
1221  if (fval[jpt + np] < fval[jpt + 1])
1222  xjpt = -xjpt;
1223  xpt[nf + ipt * xpt_dim1] = xipt;
1224  xpt[nf + jpt * xpt_dim1] = xjpt;
1225  }
1226  /* Calculate the next value of F, label 70 being reached immediately
1227  * after this calculation. The least function value so far and its
1228  * index are required. */
1229  i__1 = n;
1230  for (j = 1; j <= i__1; ++j)
1231  x[j] = xpt[nf + j * xpt_dim1] + xbase[j];
1232  goto L310;
1233 L70:
1234  fval[nf] = f;
1235  if (nf == 1) {
1236  fbeg = fopt = f;
1237  kopt = 1;
1238  } else if (f < fopt) {
1239  fopt = f;
1240  kopt = nf;
1241  }
1242  /* Set the non0 initial elements of BMAT and the quadratic model
1243  * in the cases when NF is at most 2*N+1. */
1244  if (nfm <= n << 1) {
1245  if (nfm >= 1 && nfm <= n) {
1246  gq[nfm] = (f - fbeg) / rhobeg;
1247  if (npt < nf + n) {
1248  bmat[nfm * bmat_dim1 + 1] = -1.0 / rhobeg;
1249  bmat[nf + nfm * bmat_dim1] = 1.0 / rhobeg;
1250  bmat[npt + nfm + nfm * bmat_dim1] = -.5 * rhosq;
1251  }
1252  } else if (nfm > n) {
1253  bmat[nf - n + nfmm * bmat_dim1] = .5 / rhobeg;
1254  bmat[nf + nfmm * bmat_dim1] = -.5 / rhobeg;
1255  zmat[nfmm * zmat_dim1 + 1] = -reciq - reciq;
1256  zmat[nf - n + nfmm * zmat_dim1] = reciq;
1257  zmat[nf + nfmm * zmat_dim1] = reciq;
1258  ih = nfmm * (nfmm + 1) / 2;
1259  temp = (fbeg - f) / rhobeg;
1260  hq[ih] = (gq[nfmm] - temp) / rhobeg;
1261  gq[nfmm] = .5 * (gq[nfmm] + temp);
1262  }
1263  /* Set the off-diagonal second derivatives of the Lagrange
1264  * functions and the initial quadratic model. */
1265  } else {
1266  ih = ipt * (ipt - 1) / 2 + jpt;
1267  if (xipt < 0)
1268  ipt += n;
1269  if (xjpt < 0)
1270  jpt += n;
1271  zmat[nfmm * zmat_dim1 + 1] = recip;
1272  zmat[nf + nfmm * zmat_dim1] = recip;
1273  zmat[ipt + 1 + nfmm * zmat_dim1] = -recip;
1274  zmat[jpt + 1 + nfmm * zmat_dim1] = -recip;
1275  hq[ih] = (fbeg - fval[ipt + 1] - fval[jpt + 1] + f) / (xipt * xjpt);
1276  }
1277  if (nf < npt)
1278  goto L50;
1279  /* Begin the iterative procedure, because the initial model is
1280  * complete. */
1281  rho = rhobeg;
1282  delta = rho;
1283  idz = 1;
1284  diffa = 0;
1285  diffb = 0;
1286  itest = 0;
1287  xoptsq = 0;
1288  i__1 = n;
1289  for (i__ = 1; i__ <= i__1; ++i__) {
1290  xopt[i__] = xpt[kopt + i__ * xpt_dim1];
1291  /* Computing 2nd power */
1292  d__1 = xopt[i__];
1293  xoptsq += d__1 * d__1;
1294  }
1295 L90:
1296  nfsav = nf;
1297 /* Generate the next trust region step and test its length. Set KNEW
1298  * to -1 if the purpose of the next F will be to improve the
1299  * model. */
1300 L100:
1301  knew = 0;
1302  trsapp(n, npt, &xopt[1], &xpt[xpt_offset], &gq[1], &hq[1], &pq[1], &delta,
1303  &d__[1], &w[1], &w[np], &w[np + n], &w[np + (n << 1)], &crvmin);
1304  dsq = 0;
1305  i__1 = n;
1306  for (i__ = 1; i__ <= i__1; ++i__) {
1307  /* Computing 2nd power */
1308  d__1 = d__[i__];
1309  dsq += d__1 * d__1;
1310  }
1311  /* Computing MIN */
1312  d__1 = delta, d__2 = sqrt(dsq);
1313  dnorm = fmin(d__1, d__2);
1314  if (dnorm < .5 * rho) {
1315  knew = -1;
1316  delta = 0.1 * delta;
1317  ratio = -1.;
1318  if (delta <= rho * 1.5)
1319  delta = rho;
1320  if (nf <= nfsav + 2)
1321  goto L460;
1322  temp = crvmin * .125 * rho * rho;
1323  /* Computing MAX */
1324  d__1 = fmax(diffa, diffb);
1325  if (temp <= fmax(d__1, diffc))
1326  goto L460;
1327  goto L490;
1328  }
1329 /* Shift XBASE if XOPT may be too far from XBASE. First make the
1330  * changes to BMAT that do not depend on ZMAT. */
1331 L120:
1332  if (dsq <= xoptsq * .001) {
1333  tempq = xoptsq * .25;
1334  i__1 = npt;
1335  for (k = 1; k <= i__1; ++k) {
1336  sum = 0;
1337  i__2 = n;
1338  for (i__ = 1; i__ <= i__2; ++i__)
1339  sum += xpt[k + i__ * xpt_dim1] * xopt[i__];
1340  temp = pq[k] * sum;
1341  sum -= .5 * xoptsq;
1342  w[npt + k] = sum;
1343  i__2 = n;
1344  for (i__ = 1; i__ <= i__2; ++i__) {
1345  gq[i__] += temp * xpt[k + i__ * xpt_dim1];
1346  xpt[k + i__ * xpt_dim1] -= .5 * xopt[i__];
1347  vlag[i__] = bmat[k + i__ * bmat_dim1];
1348  w[i__] = sum * xpt[k + i__ * xpt_dim1] + tempq * xopt[i__];
1349  ip = npt + i__;
1350  i__3 = i__;
1351  for (j = 1; j <= i__3; ++j)
1352  bmat[ip + j * bmat_dim1] = bmat[ip + j * bmat_dim1] +
1353  vlag[i__] * w[j] +
1354  w[i__] * vlag[j];
1355  }
1356  }
1357  /* Then the revisions of BMAT that depend on ZMAT are
1358  * calculated. */
1359  i__3 = nptm;
1360  for (k = 1; k <= i__3; ++k) {
1361  sumz = 0;
1362  i__2 = npt;
1363  for (i__ = 1; i__ <= i__2; ++i__) {
1364  sumz += zmat[i__ + k * zmat_dim1];
1365  w[i__] = w[npt + i__] * zmat[i__ + k * zmat_dim1];
1366  }
1367  i__2 = n;
1368  for (j = 1; j <= i__2; ++j) {
1369  sum = tempq * sumz * xopt[j];
1370  i__1 = npt;
1371  for (i__ = 1; i__ <= i__1; ++i__)
1372  sum += w[i__] * xpt[i__ + j * xpt_dim1];
1373  vlag[j] = sum;
1374  if (k < idz)
1375  sum = -sum;
1376  i__1 = npt;
1377  for (i__ = 1; i__ <= i__1; ++i__)
1378  bmat[i__ + j * bmat_dim1] +=
1379  sum * zmat[i__ + k * zmat_dim1];
1380  }
1381  i__1 = n;
1382  for (i__ = 1; i__ <= i__1; ++i__) {
1383  ip = i__ + npt;
1384  temp = vlag[i__];
1385  if (k < idz)
1386  temp = -temp;
1387  i__2 = i__;
1388  for (j = 1; j <= i__2; ++j)
1389  bmat[ip + j * bmat_dim1] += temp * vlag[j];
1390  }
1391  }
1392  /* The following instructions complete the shift of XBASE,
1393  * including the changes to the parameters of the quadratic
1394  * model. */
1395  ih = 0;
1396  i__2 = n;
1397  for (j = 1; j <= i__2; ++j) {
1398  w[j] = 0;
1399  i__1 = npt;
1400  for (k = 1; k <= i__1; ++k) {
1401  w[j] += pq[k] * xpt[k + j * xpt_dim1];
1402  xpt[k + j * xpt_dim1] -= .5 * xopt[j];
1403  }
1404  i__1 = j;
1405  for (i__ = 1; i__ <= i__1; ++i__) {
1406  ++ih;
1407  if (i__ < j)
1408  gq[j] += hq[ih] * xopt[i__];
1409  gq[i__] += hq[ih] * xopt[j];
1410  hq[ih] = hq[ih] + w[i__] * xopt[j] + xopt[i__] * w[j];
1411  bmat[npt + i__ + j * bmat_dim1] =
1412  bmat[npt + j + i__ * bmat_dim1];
1413  }
1414  }
1415  i__1 = n;
1416  for (j = 1; j <= i__1; ++j) {
1417  xbase[j] += xopt[j];
1418  xopt[j] = 0;
1419  }
1420  xoptsq = 0;
1421  }
1422  /* Pick the model step if KNEW is positive. A different choice of D
1423  * may be made later, if the choice of D by BIGLAG causes
1424  * substantial cancellation in DENOM. */
1425  if (knew > 0) {
1426  biglag(n, npt, &xopt[1], &xpt[xpt_offset], &bmat[bmat_offset],
1427  &zmat[zmat_offset], &idz, ndim, &knew, &dstep, &d__[1], &alpha,
1428  &vlag[1], &vlag[npt + 1], &w[1], &w[np], &w[np + n],
1429  std::forward<Function>(function));
1430  }
1431  /* Calculate VLAG and BETA for the current choice of D. The first
1432  * NPT components of W_check will be held in W. */
1433  i__1 = npt;
1434  for (k = 1; k <= i__1; ++k) {
1435  suma = 0;
1436  sumb = 0;
1437  sum = 0;
1438  i__2 = n;
1439  for (j = 1; j <= i__2; ++j) {
1440  suma += xpt[k + j * xpt_dim1] * d__[j];
1441  sumb += xpt[k + j * xpt_dim1] * xopt[j];
1442  sum += bmat[k + j * bmat_dim1] * d__[j];
1443  }
1444  w[k] = suma * (.5 * suma + sumb);
1445  vlag[k] = sum;
1446  }
1447  beta = 0;
1448  i__1 = nptm;
1449  for (k = 1; k <= i__1; ++k) {
1450  sum = 0;
1451  i__2 = npt;
1452  for (i__ = 1; i__ <= i__2; ++i__)
1453  sum += zmat[i__ + k * zmat_dim1] * w[i__];
1454  if (k < idz) {
1455  beta += sum * sum;
1456  sum = -sum;
1457  } else
1458  beta -= sum * sum;
1459  i__2 = npt;
1460  for (i__ = 1; i__ <= i__2; ++i__)
1461  vlag[i__] += sum * zmat[i__ + k * zmat_dim1];
1462  }
1463  bsum = 0;
1464  dx = 0;
1465  i__2 = n;
1466  for (j = 1; j <= i__2; ++j) {
1467  sum = 0;
1468  i__1 = npt;
1469  for (i__ = 1; i__ <= i__1; ++i__)
1470  sum += w[i__] * bmat[i__ + j * bmat_dim1];
1471  bsum += sum * d__[j];
1472  jp = npt + j;
1473  i__1 = n;
1474  for (k = 1; k <= i__1; ++k)
1475  sum += bmat[jp + k * bmat_dim1] * d__[k];
1476  vlag[jp] = sum;
1477  bsum += sum * d__[j];
1478  dx += d__[j] * xopt[j];
1479  }
1480  beta = dx * dx + dsq * (xoptsq + dx + dx + .5 * dsq) + beta - bsum;
1481  vlag[kopt] += 1.0;
1482  /* If KNEW is positive and if the cancellation in DENOM is
1483  * unacceptable, then BIGDEN calculates an alternative model step,
1484  * XNEW being used for working space. */
1485  if (knew > 0) {
1486  /* Computing 2nd power */
1487  d__1 = vlag[knew];
1488  temp = 1.0 + alpha * beta / (d__1 * d__1);
1489  if (fabs(temp) <= .8) {
1490  bigden(n, npt, &xopt[1], &xpt[xpt_offset], &bmat[bmat_offset],
1491  &zmat[zmat_offset], &idz, ndim, &kopt, &knew, &d__[1], &w[1],
1492  &vlag[1], &beta, &xnew[1], &w[*ndim + 1], &w[*ndim * 6 + 1]);
1493  }
1494  }
1495 /* Calculate the next value of the objective function. */
1496 L290:
1497  i__2 = n;
1498  for (i__ = 1; i__ <= i__2; ++i__) {
1499  xnew[i__] = xopt[i__] + d__[i__];
1500  x[i__] = xbase[i__] + xnew[i__];
1501  }
1502  ++nf;
1503 L310:
1504  if (nf > nftest) {
1505  --nf;
1506  DEBUG_LOG("Return from NEWUOA because CALFUN has been called MAXFUN "
1507  "times.\n");
1508  goto L530;
1509  }
1510  f = function(n, &x[1]);
1511  if (nf <= npt)
1512  goto L70;
1513  if (knew == -1)
1514  goto L530;
1515  /* Use the quadratic model to predict the change in F due to the
1516  * step D, and set DIFF to the error of this prediction. */
1517  vquad = ih = 0;
1518  i__2 = n;
1519  for (j = 1; j <= i__2; ++j) {
1520  vquad += d__[j] * gq[j];
1521  i__1 = j;
1522  for (i__ = 1; i__ <= i__1; ++i__) {
1523  ++ih;
1524  temp = d__[i__] * xnew[j] + d__[j] * xopt[i__];
1525  if (i__ == j)
1526  temp = .5 * temp;
1527  vquad += temp * hq[ih];
1528  }
1529  }
1530  i__1 = npt;
1531  for (k = 1; k <= i__1; ++k)
1532  vquad += pq[k] * w[k];
1533  diff = f - fopt - vquad;
1534  diffc = diffb;
1535  diffb = diffa;
1536  diffa = fabs(diff);
1537  if (dnorm > rho)
1538  nfsav = nf;
1539  /* Update FOPT and XOPT if the new F is the least value of the
1540  * objective function so far. The branch when KNEW is positive
1541  * occurs if D is not a trust region step. */
1542  fsave = fopt;
1543  if (f < fopt) {
1544  fopt = f;
1545  xoptsq = 0;
1546  i__1 = n;
1547  for (i__ = 1; i__ <= i__1; ++i__) {
1548  xopt[i__] = xnew[i__];
1549  /* Computing 2nd power */
1550  d__1 = xopt[i__];
1551  xoptsq += d__1 * d__1;
1552  }
1553  }
1554  ksave = knew;
1555  if (knew > 0)
1556  goto L410;
1557  /* Pick the next value of DELTA after a trust region step. */
1558  if (vquad >= 0) {
1559  DEBUG_LOG("Return from NEWUOA because a trust region step has failed "
1560  "to reduce Q.\n");
1561  goto L530;
1562  }
1563  ratio = (f - fsave) / vquad;
1564  if (ratio <= 0.1) {
1565  delta = .5 * dnorm;
1566  } else if (ratio <= .7) {
1567  /* Computing MAX */
1568  d__1 = .5 * delta;
1569  delta = fmax(d__1, dnorm);
1570  } else {
1571  /* Computing MAX */
1572  d__1 = .5 * delta, d__2 = dnorm + dnorm;
1573  delta = fmax(d__1, d__2);
1574  }
1575  if (delta <= rho * 1.5)
1576  delta = rho;
1577  /* Set KNEW to the index of the next interpolation point to be
1578  * deleted. */
1579  /* Computing MAX */
1580  d__2 = 0.1 * delta;
1581  /* Computing 2nd power */
1582  d__1 = fmax(d__2, rho);
1583  rhosq = d__1 * d__1;
1584  ktemp = 0;
1585  detrat = 0;
1586  if (f >= fsave) {
1587  ktemp = kopt;
1588  detrat = 1.0;
1589  }
1590  i__1 = npt;
1591  for (k = 1; k <= i__1; ++k) {
1592  hdiag = 0;
1593  i__2 = nptm;
1594  for (j = 1; j <= i__2; ++j) {
1595  temp = 1.0;
1596  if (j < idz)
1597  temp = -1.0;
1598  /* Computing 2nd power */
1599  d__1 = zmat[k + j * zmat_dim1];
1600  hdiag += temp * (d__1 * d__1);
1601  }
1602  /* Computing 2nd power */
1603  d__2 = vlag[k];
1604  temp = (d__1 = beta * hdiag + d__2 * d__2, fabs(d__1));
1605  distsq = 0;
1606  i__2 = n;
1607  for (j = 1; j <= i__2; ++j) {
1608  /* Computing 2nd power */
1609  d__1 = xpt[k + j * xpt_dim1] - xopt[j];
1610  distsq += d__1 * d__1;
1611  }
1612  if (distsq > rhosq) {
1613  /* Computing 3rd power */
1614  d__1 = distsq / rhosq;
1615  temp *= d__1 * (d__1 * d__1);
1616  }
1617  if (temp > detrat && k != ktemp) {
1618  detrat = temp;
1619  knew = k;
1620  }
1621  }
1622  if (knew == 0)
1623  goto L460;
1624 /* Update BMAT, ZMAT and IDZ, so that the KNEW-th interpolation
1625  * point can be moved. Begin the updating of the quadratic model,
1626  * starting with the explicit second derivative term. */
1627 L410:
1628  update(n, npt, &bmat[bmat_offset], &zmat[zmat_offset], &idz, ndim, &vlag[1],
1629  &beta, &knew, &w[1]);
1630  fval[knew] = f;
1631  ih = 0;
1632  i__1 = n;
1633  for (i__ = 1; i__ <= i__1; ++i__) {
1634  temp = pq[knew] * xpt[knew + i__ * xpt_dim1];
1635  i__2 = i__;
1636  for (j = 1; j <= i__2; ++j) {
1637  ++ih;
1638  hq[ih] += temp * xpt[knew + j * xpt_dim1];
1639  }
1640  }
1641  pq[knew] = 0;
1642  /* Update the other second derivative parameters, and then the
1643  * gradient vector of the model. Also include the new interpolation
1644  * point. */
1645  i__2 = nptm;
1646  for (j = 1; j <= i__2; ++j) {
1647  temp = diff * zmat[knew + j * zmat_dim1];
1648  if (j < idz)
1649  temp = -temp;
1650  i__1 = npt;
1651  for (k = 1; k <= i__1; ++k) {
1652  pq[k] += temp * zmat[k + j * zmat_dim1];
1653  }
1654  }
1655  gqsq = 0;
1656  i__1 = n;
1657  for (i__ = 1; i__ <= i__1; ++i__) {
1658  gq[i__] += diff * bmat[knew + i__ * bmat_dim1];
1659  /* Computing 2nd power */
1660  d__1 = gq[i__];
1661  gqsq += d__1 * d__1;
1662  xpt[knew + i__ * xpt_dim1] = xnew[i__];
1663  }
1664  /* If a trust region step makes a small change to the objective
1665  * function, then calculate the gradient of the least Frobenius norm
1666  * interpolant at XBASE, and store it in W, using VLAG for a vector
1667  * of right hand sides. */
1668  if (ksave == 0 && delta == rho) {
1669  if (fabs(ratio) > .01) {
1670  itest = 0;
1671  } else {
1672  i__1 = npt;
1673  for (k = 1; k <= i__1; ++k)
1674  vlag[k] = fval[k] - fval[kopt];
1675  gisq = 0;
1676  i__1 = n;
1677  for (i__ = 1; i__ <= i__1; ++i__) {
1678  sum = 0;
1679  i__2 = npt;
1680  for (k = 1; k <= i__2; ++k)
1681  sum += bmat[k + i__ * bmat_dim1] * vlag[k];
1682  gisq += sum * sum;
1683  w[i__] = sum;
1684  }
1685  /* Test whether to replace the new quadratic model by the
1686  * least Frobenius norm interpolant, making the replacement
1687  * if the test is satisfied. */
1688  ++itest;
1689  if (gqsq < gisq * 100.)
1690  itest = 0;
1691  if (itest >= 3) {
1692  i__1 = n;
1693  for (i__ = 1; i__ <= i__1; ++i__)
1694  gq[i__] = w[i__];
1695  i__1 = nh;
1696  for (ih = 1; ih <= i__1; ++ih)
1697  hq[ih] = 0;
1698  i__1 = nptm;
1699  for (j = 1; j <= i__1; ++j) {
1700  w[j] = 0;
1701  i__2 = npt;
1702  for (k = 1; k <= i__2; ++k)
1703  w[j] += vlag[k] * zmat[k + j * zmat_dim1];
1704  if (j < idz)
1705  w[j] = -w[j];
1706  }
1707  i__1 = npt;
1708  for (k = 1; k <= i__1; ++k) {
1709  pq[k] = 0;
1710  i__2 = nptm;
1711  for (j = 1; j <= i__2; ++j)
1712  pq[k] += zmat[k + j * zmat_dim1] * w[j];
1713  }
1714  itest = 0;
1715  }
1716  }
1717  }
1718  if (f < fsave)
1719  kopt = knew;
1720  /* If a trust region step has provided a sufficient decrease in F,
1721  * then branch for another trust region calculation. The case
1722  * KSAVE>0 occurs when the new function value was calculated by a
1723  * model step. */
1724  if (f <= fsave + 0.1 * vquad)
1725  goto L100;
1726  if (ksave > 0)
1727  goto L100;
1728  /* Alternatively, find out if the interpolation points are close
1729  * enough to the best point so far. */
1730  knew = 0;
1731 L460:
1732  distsq = delta * 4. * delta;
1733  i__2 = npt;
1734  for (k = 1; k <= i__2; ++k) {
1735  sum = 0;
1736  i__1 = n;
1737  for (j = 1; j <= i__1; ++j) {
1738  /* Computing 2nd power */
1739  d__1 = xpt[k + j * xpt_dim1] - xopt[j];
1740  sum += d__1 * d__1;
1741  }
1742  if (sum > distsq) {
1743  knew = k;
1744  distsq = sum;
1745  }
1746  }
1747  /* If KNEW is positive, then set DSTEP, and branch back for the next
1748  * iteration, which will generate a "model step". */
1749  if (knew > 0) {
1750  /* Computing MAX and MIN*/
1751  d__2 = 0.1 * sqrt(distsq), d__3 = .5 * delta;
1752  d__1 = fmin(d__2, d__3);
1753  dstep = fmax(d__1, rho);
1754  dsq = dstep * dstep;
1755  goto L120;
1756  }
1757  if (ratio > 0)
1758  goto L100;
1759  if (fmax(delta, dnorm) > rho)
1760  goto L100;
1761 /* The calculations with the current value of RHO are complete. Pick
1762  * the next values of RHO and DELTA. */
1763 L490:
1764  if (rho > rhoend) {
1765  delta = .5 * rho;
1766  ratio = rho / rhoend;
1767  if (ratio <= 16.)
1768  rho = rhoend;
1769  else if (ratio <= 250.)
1770  rho = sqrt(ratio) * rhoend;
1771  else
1772  rho = 0.1 * rho;
1773  delta = fmax(delta, rho);
1774  goto L90;
1775  }
1776  /* Return from the calculation, after another Newton-Raphson step,
1777  * if it is too short to have been tried before. */
1778  if (knew == -1)
1779  goto L290;
1780 L530:
1781  if (fopt <= f) {
1782  i__2 = n;
1783  for (i__ = 1; i__ <= i__2; ++i__)
1784  x[i__] = xbase[i__] + xopt[i__];
1785  f = fopt;
1786  }
1787  return f;
1788 }
1789 
1790 template <class Function>
1791 double newuoa_impl(Function &&function, long n, long npt, double *x,
1792  double rhobeg, double rhoend, long maxfun, double *w) {
1793  /* This subroutine seeks the least value of a function of many
1794  * variables, by a trust region method that forms quadratic models
1795  * by interpolation. There can be some freedom in the interpolation
1796  * conditions, which is taken up by minimizing the Frobenius norm of
1797  * the change to the second derivative of the quadratic model,
1798  * beginning with a zero matrix. The arguments of the subroutine are
1799  * as follows. */
1800 
1801  /* N must be set to the number of variables and must be at least
1802  * two. NPT is the number of interpolation conditions. Its value
1803  * must be in the interval [N+2,(N+1)(N+2)/2]. Initial values of the
1804  * variables must be set in X(1),X(2),...,X(N). They will be changed
1805  * to the values that give the least calculated F. RHOBEG and RHOEND
1806  * must be set to the initial and final values of a trust region
1807  * radius, so both must be positive with RHOEND<=RHOBEG. Typically
1808  * RHOBEG should be about one tenth of the greatest expected change
1809  * to a variable, and RHOEND should indicate the accuracy that is
1810  * required in the final values of the variables. MAXFUN must be set
1811  * to an upper bound on the number of calls of CALFUN. The array W
1812  * will be used for working space. Its length must be at least
1813  * (NPT+13)*(NPT+N)+3*N*(N+3)/2. */
1814 
1815  /* SUBROUTINE CALFUN (N,X,F) must be provided by the user. It must
1816  * set F to the value of the objective function for the variables
1817  * X(1),X(2),...,X(N). Partition the working space array, so that
1818  * different parts of it can be treated separately by the subroutine
1819  * that performs the main calculation. */
1820 
1821  long id, np, iw, igq, ihq, ixb, ifv, ipq, ivl, ixn, ixo, ixp, ndim, nptm,
1822  ibmat, izmat;
1823 
1824  /* Parameter adjustments */
1825  --w;
1826  --x;
1827  /* Functiontion Body */
1828  np = n + 1;
1829  nptm = npt - np;
1830  if (npt < n + 2 || npt > (n + 2) * np / 2) {
1831  DEBUG_LOG("NEWUOA: npt is not in the required interval.\n");
1832  return 0.0;
1833  }
1834  ndim = npt + n;
1835  ixb = 1;
1836  ixo = ixb + n;
1837  ixn = ixo + n;
1838  ixp = ixn + n;
1839  ifv = ixp + n * npt;
1840  igq = ifv + npt;
1841  ihq = igq + n;
1842  ipq = ihq + n * np / 2;
1843  ibmat = ipq + npt;
1844  izmat = ibmat + ndim * n;
1845  id = izmat + npt * nptm;
1846  ivl = id + n;
1847  iw = ivl + ndim;
1848  /* The above settings provide a partition of W for subroutine
1849  * NEWUOB. The partition requires the first NPT*(NPT+N)+5*N*(N+3)/2
1850  * elements of W plus the space that is needed by the last array of
1851  * NEWUOB. */
1852  return newuob(n, npt, &x[1], rhobeg, rhoend, maxfun, &w[ixb], &w[ixo],
1853  &w[ixn], &w[ixp], &w[ifv], &w[igq], &w[ihq], &w[ipq],
1854  &w[ibmat], &w[izmat], &ndim, &w[id], &w[ivl], &w[iw],
1855  std::forward<Function>(function));
1856 }
1857 
1858 } // namespace newuoa_detail
1859 
1860 // Function function should take long n and const double * x.
1861 /* This subroutine seeks the least value of a function of many variables,
1862  * by a trust region method that forms quadratic models by interpolation.
1863  * There can be some freedom in the interpolation conditions, which is
1864  * taken up by minimizing the Frobenius norm of the change to the second
1865  * derivative of the quadratic model, beginning with a zero matrix. The
1866  * arguments of the subroutine are as follows. */
1867 
1868 /* N must be set to the number of variables and must be at least two.
1869  * NPT is the number of interpolation conditions. Its value must be in the
1870  * interval [N+2,(N+1)(N+2)/2].
1871  * Initial values of the variables must be set in X(1),X(2),...,X(N). They
1872  * will be changed to the values that give the least calculated F.
1873  * RHOBEG and RHOEND must be set to the initial and final values of a trust
1874  * region radius, so both must be positive with RHOEND<=RHOBEG. Typically
1875  * RHOBEG should be about one tenth of the greatest expected change to a
1876  * variable, and RHOEND should indicate the accuracy that is required in
1877  * the final values of the variables.
1878  * MAXFUN must be set to an upper bound on the number of calls of CALFUN.
1879  * The array W will be used for working space. Its length must be at least
1880  * (NPT+13)*(NPT+N)+3*N*(N+3)/2. */
1881 template <typename Function>
1882 inline double newuoa(Function &&function, long n, long npt, double *x,
1883  double rhobeg, double rhoend, long maxfun, double *w) {
1884  return newuoa_detail::newuoa_impl(std::forward<Function>(function), n, npt,
1885  x, rhobeg, rhoend, maxfun, w);
1886 }
1887 
1888 namespace detail {
1890 template <typename Derived>
1892 
1893  static_assert(
1894  std::is_same<typename Derived::Scalar, double>::value,
1895  "NEWUOA operates only on doubles, and you passed a different type.");
1896  static_assert(Derived::IsVectorAtCompileTime, "NEWUOA must be passed x "
1897  "which is known to be a "
1898  "vector at compile time.");
1899  static_assert(Derived::SizeAtCompileTime != Eigen::Dynamic,
1900  "Vector passed to NEWUOA must be fixed-size at compile "
1901  "time.");
1902 }
1903 template <typename Derived>
1904 inline long computeReasonableNPT(Eigen::MatrixBase<Derived> &) {
1905  return static_cast<long>(2 * Derived::SizeAtCompileTime + 1);
1906 }
1907 } // namespace detail
1910 template <typename Function, typename Derived>
1911 inline double ei_newuoa(long npt, Eigen::MatrixBase<Derived> &x,
1912  std::pair<double, double> rho, long maxfun,
1913  Function &&f) {
1914  detail::checkStaticAssertions(x);
1915 
1916  double rhoBeg, rhoEnd;
1917  std::tie(rhoBeg, rhoEnd) = rho;
1918  if (rhoEnd > rhoBeg) {
1919  std::swap(rhoBeg, rhoEnd);
1920  }
1921  const auto n = Derived::SizeAtCompileTime;
1922  auto workingSpaceNeeded = (npt + 13) * (npt + n) + 3 * n * (n + 3) / 2;
1923  Eigen::VectorXd workingSpace(workingSpaceNeeded);
1924 
1925  return newuoa(std::forward<Function>(f), n, npt, x.derived().data(), rhoBeg,
1926  rhoEnd, maxfun, workingSpace.data());
1927 }
1928 
1931 template <typename Function, typename Derived>
1933  std::pair<double, double> rho, long maxfun,
1934  Function &&f) {
1935  detail::checkStaticAssertions(x);
1936  return ei_newuoa(detail::computeReasonableNPT(x), x, rho, maxfun,
1937  std::forward<Function>(f));
1938 }
1939 
1942 template <typename Function, typename Derived>
1944  std::pair<double, double> rho, long maxfun,
1945  Function &&f) {
1946  detail::checkStaticAssertions(x);
1947 
1949  Vec xCopy = Vec::Zero();
1950  auto wrappedFunc = [&f, &xCopy](long n, const double *x) {
1951  assert(n == Derived::SizeAtCompileTime &&
1952  "Should always be getting back the same size");
1956  xCopy = Vec::Map(x);
1957  return std::forward<Function>(f)(const_cast<const Vec &>(xCopy));
1958  };
1959  return ei_newuoa(npt, x, rho, maxfun, wrappedFunc);
1960 }
1961 
1964 template <typename Function, typename Derived>
1966  std::pair<double, double> rho, long maxfun,
1967  Function &&f) {
1968  detail::checkStaticAssertions(x);
1969  return ei_newuoa_wrapped(detail::computeReasonableNPT(x), x, rho, maxfun,
1970  std::forward<Function>(f));
1971 }
1972 
1973 #endif // INCLUDED_newuoa_h_GUID_F9E56CF3_7B12_41A0_4A09_E2A02B48FAC1
double ei_newuoa(long npt, Eigen::MatrixBase< Derived > &x, std::pair< double, double > rho, long maxfun, Function &&f)
Friendly wrapper around newuoa: takes a vector for x.
Definition: newuoa.h:1911
Definition: newuoa.h:91
double ei_newuoa_wrapped(long npt, Eigen::MatrixBase< Derived > &x, std::pair< double, double > rho, long maxfun, Function &&f)
Friendlier wrapper around newuoa: takes a vector for x, and the function takes a reference to const v...
Definition: newuoa.h:1943
Definition: newuoa.h:1888
void checkStaticAssertions(Eigen::MatrixBase< Derived > &)
Checks shared static assertions about vectors to be optimized by NEWUOA.
Definition: newuoa.h:1891
const int Dynamic
This value means that a positive quantity (e.g., a size) is not known at compile-time, and that instead the value is stored in some runtime variable.
Definition: Constants.h:21
The matrix class, also used for vectors and row-vectors.
Definition: Matrix.h:127
Base class for all dense matrices, vectors, and expressions.
Definition: MatrixBase.h:48