1## Copyright (C) 2014-2019 Olaf Till <i7tiol@t-online.de>
2##
3## This program is free software; you can redistribute it and/or modify
4## it under the terms of the GNU General Public License as published by
5## the Free Software Foundation; either version 3 of the License, or
6## (at your option) any later version.
7##
8## This program is distributed in the hope that it will be useful,
9## but WITHOUT ANY WARRANTY; without even the implied warranty of
10## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11## GNU General Public License for more details.
12##
13## You should have received a copy of the GNU General Public License
14## along with this program; If not, see <http://www.gnu.org/licenses/>.
15
16function [p_res, objf, cvg, outp] = __octave_sqp_wrapper__ (f, pin, hook)
17
18  ## clear persisten variables
19  select_constr ();
20  select_d_constr ();
21
22  n = length (pin);
23
24  ## passed constraints
25  mc = hook.mc; # matrix of linear constraints
26  vc = hook.vc; # vector of linear constraints
27  f_cstr = hook.f_cstr; # function of all constraints
28  df_cstr = hook.df_cstr; # function of derivatives of all constraints
29  n_gencstr = hook.n_gencstr; # number of non-linear constraints
30  eq_idx = hook.eq_idx; # logical index of equality constraints in all
31                                # constraints
32  lbound = hook.lbound; # bounds, subset of linear inequality
33  ubound = hook.ubound; # constraints in mc and vc
34
35  ## passed function for gradient of objective function
36  grad_f = hook.dfdp;
37
38  ## passed function for hessian of objective function
39  hessian = hook.hessian;
40
41  ## passed options
42  tolerance = hook.octave_sqp_tolerance;
43  niter = hook.MaxIter;
44  fixed = hook.fixed;
45
46  ## some useful variables derived from passed variables
47  ##
48  n_cstr = size (vc, 1) + n_gencstr; # number of all constraints
49  ac_idx = true (n_cstr, 1); # index of all constraints
50
51  ## backend-specific checking of options and constraints
52  ##
53  ## ...
54
55  ## fill constant fields of hook for derivative-functions; some fields
56  ## may be backend-specific
57  dfdp_hook.fixed = fixed; # this may be handled by the frontend, but
58                                # the backend still may add to it
59
60  ## process arguments for calling sqp
61  grad_f = @  (p) grad_f (p, dfdp_hook)(:); # sqp expects column vector
62  f_cstr = @ (p) f_cstr (p, ac_idx);
63  df_cstr = @ (p) df_cstr (p, ac_idx,
64                           setfield (dfdp_hook, "f", f_cstr (p)));
65  if (isempty (hessian))
66    passed_f = {f, grad_f};
67  else
68    passed_f = {f, grad_f, hessian};
69  endif
70  inequc = @ (p) select_constr (f_cstr, p, ! eq_idx);
71  dinequc = @ (p) select_d_constr (df_cstr, p, ! eq_idx);
72  equc = @ (p) select_constr (f_cstr, p, eq_idx);
73  dequc = @ (p) select_d_constr (df_cstr, p, eq_idx);
74
75  ## call sqp
76  [p_res, objf, info, outp.niter, outp.nobjf, outp.lambda] = ...
77      sqp (pin, passed_f, {equc, dequc}, {inequc, dinequc}, -Inf, Inf,
78           niter, tolerance);
79
80  ## map return code
81  switch (info)
82    case 101
83      cvg = 1;
84    case 102
85      cvg = -4;
86    case 103
87      cvg = 0;
88    case 104
89      cvg = 2;
90    otherwise
91      warning ("return code %i of sqp not recognized", info);
92      cvg = NA;
93  endswitch
94
95endfunction
96
97function ret = select_constr (cf, p, idx)
98
99  persistent storep = struct ();
100  persistent storeret = [];
101
102  if (! nargin ())
103    storep = struct ();
104    return;
105  endif
106
107  if (! isequal (storep, p))
108    storep = p;
109    storeret = cf (p);
110  endif
111
112  ret = storeret(idx);
113
114endfunction
115
116function ret = select_d_constr (dcf, p, idx)
117
118  persistent storep = struct ();
119  persistent storeret = [];
120
121  if (! nargin ())
122    storep = struct ();
123    return;
124  endif
125
126  if (! isequal (storep, p))
127    storep = p;
128    storeret = dcf (p);
129  endif
130
131  ret = storeret(idx, :);
132
133endfunction
134