/* nag_opt_qpconvex2_sparse_option_file (e04nrc) Example Program.
*
* Copyright 2024 Numerical Algorithms Group.
*
* Mark 30.1, 2024.
*/
#include <nag.h>
#include <stdio.h>
#include <string.h>
#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL qphx(Integer ncolh, const double x[], double hx[],
Integer nstate, Nag_Comm *comm);
#ifdef __cplusplus
}
#endif
int main(void) {
const char *optionsfile = "e04nrce.opt";
Integer exit_status = 0;
/* Scalars */
double bndinf, featol, obj, objadd, sinf;
Integer elmode, i, icol, iobj, j, jcol, lenc, m, n, ncolh, ne;
Integer ninf, nname, ns;
/* Arrays */
static double ruser[1] = {-1.0};
char nag_enum_arg[40];
char *cuser = 0, *prob = 0;
char **names = 0;
double *acol = 0, *bl = 0, *bu = 0, *c = 0, *pi = 0, *rc = 0;
double *x = 0;
Integer *helast = 0, *hs = 0, *inda = 0, *iuser = 0, *loca = 0;
/* Nag Types */
Nag_E04State state;
Nag_Start start;
Nag_Comm comm;
Nag_FileID fileidin;
NagError fail;
/* By default e04nrc does not print monitoring information.
Define SHOW_MONITORING_INFO to turn it on - see further below. */
#ifdef SHOW_MONITORING_INFO
Nag_FileID fileidout;
#endif
INIT_FAIL(fail);
printf("%s", "nag_opt_qpconvex2_sparse_option_file (e04nrc) Example"
" Program Results\n");
printf("\n");
/* For communication with user-supplied functions: */
comm.user = ruser;
/* This program demonstrates the use of routines to set and
* get values of optional parameters associated with
* nag_opt_qpconvex2_sparse_solve (e04nqc).
*/
/* Skip heading in data file. */
scanf("%*[^\n] ");
scanf("%" NAG_IFMT " %" NAG_IFMT " ", &n, &m);
scanf("%*[^\n] ");
if (n >= 1 && m >= 1) {
/* Read ne, iobj, ncolh, start and nname from data file. */
scanf("%" NAG_IFMT " %" NAG_IFMT " %" NAG_IFMT " %39s %" NAG_IFMT "", &ne,
&iobj, &ncolh, nag_enum_arg, &nname);
scanf("%*[^\n] ");
/* nag_enum_name_to_value (x04nac).
* Converts NAG enum member name to value
*/
start = (Nag_Start)nag_enum_name_to_value(nag_enum_arg);
/* Allocate memory */
if (!(names = NAG_ALLOC(n + m, char *)) || !(prob = NAG_ALLOC(9, char)) ||
!(acol = NAG_ALLOC(ne, double)) || !(bl = NAG_ALLOC(m + n, double)) ||
!(bu = NAG_ALLOC(m + n, double)) || !(c = NAG_ALLOC(1, double)) ||
!(pi = NAG_ALLOC(m, double)) || !(rc = NAG_ALLOC(n + m, double)) ||
!(x = NAG_ALLOC(n + m, double)) ||
!(helast = NAG_ALLOC(n + m, Integer)) ||
!(hs = NAG_ALLOC(n + m, Integer)) || !(inda = NAG_ALLOC(ne, Integer)) ||
!(iuser = NAG_ALLOC(1, Integer)) ||
!(loca = NAG_ALLOC(n + 1, Integer))) {
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
} else {
printf("Invalid n or nf or nea or neg\n");
exit_status = 1;
goto END;
}
/* Read names from data file. */
for (i = 1; i <= nname; ++i) {
names[i - 1] = NAG_ALLOC(9, char);
scanf(" ' %8s '", names[i - 1]);
}
scanf("%*[^\n] ");
/* Read the matrix acol from data file. Set up loca. */
jcol = 1;
loca[jcol - 1] = 1;
for (i = 1; i <= ne; ++i) {
/* Element ( inda[i-1], icol ) is stored in acol[i-1]. */
scanf("%lf %" NAG_IFMT " %" NAG_IFMT "", &acol[i - 1], &inda[i - 1], &icol);
scanf("%*[^\n] ");
if (icol < jcol) {
/* Elements not ordered by increasing column index. */
printf("%s %5" NAG_IFMT " %s %5" NAG_IFMT "", "Element in column", icol,
" found after element in column", jcol);
printf("%s\n\n", ". Problem abandoned.");
} else if (icol == jcol + 1) {
/* Index in acol of the start of the icol-th column equals i. */
loca[icol - 1] = i;
jcol = icol;
} else if (icol > jcol + 1) {
/* Index in acol of the start of the icol-th column equals i,
* but columns jcol+1,jcol+2,...,icol-1 are empty. Set the
* corresponding elements of loca to i.
*/
for (j = jcol + 1; j <= icol - 1; ++j) {
loca[j - 1] = i;
}
loca[icol - 1] = i;
jcol = icol;
}
}
loca[n] = ne + 1;
if (n > icol) {
/* Columns n,n-1,...,icol+1 are empty. Set the corresponding */
/* elements of loca accordingly. */
for (i = n; i >= icol + 1; --i) {
loca[i - 1] = loca[i];
}
}
/* Read bl, bu, hs and x from data file. */
for (i = 1; i <= n + m; ++i) {
scanf("%lf", &bl[i - 1]);
}
scanf("%*[^\n] ");
for (i = 1; i <= n + m; ++i) {
scanf("%lf", &bu[i - 1]);
}
scanf("%*[^\n] ");
if (start == Nag_Cold) {
for (i = 1; i <= n; ++i) {
scanf("%" NAG_IFMT "", &hs[i - 1]);
}
scanf("%*[^\n] ");
} else if (start == Nag_Warm) {
for (i = 1; i <= n + m; ++i) {
scanf("%" NAG_IFMT "", &hs[i - 1]);
}
scanf("%*[^\n] ");
}
for (i = 1; i <= n; ++i) {
scanf("%lf", &x[i - 1]);
}
scanf("%*[^\n] ");
/* We have no explicit objective vector so set lenc = 0; the
* objective vector is stored in row iobj of acol.
*/
lenc = 0;
objadd = 0.;
strcpy(prob, " ");
/* nag_opt_qpconvex2_sparse_init (e04npc).
* Initialization function for
* nag_opt_qpconvex2_sparse_solve (e04nqc)
*/
nag_opt_qpconvex2_sparse_init(&state, &fail);
if (fail.code != NE_NOERROR) {
printf("Initialization of nag_opt_qpconvex2_sparse_solve (e04nqc)"
" failed.\n%s\n",
fail.message);
exit_status = 1;
goto END;
}
#ifdef SHOW_MONITORING_INFO
/* Call nag_file_open (x04acc) to set the print file fileidout */
/* nag_file_open (x04acc).
* Open unit number for reading, writing or appending, and
* associate unit with named file
*/
nag_file_open("", 2, &fileidout, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 2;
goto END;
}
/* nag_opt_qpconvex2_sparse_option_integer_set (e04ntc).
* Set a single option for nag_opt_qpconvex2_sparse_solve
* (e04nqc) from an integer argument
*/
fflush(stdout);
nag_opt_qpconvex2_sparse_option_integer_set("Print file", fileidout, &state,
&fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
#endif
/* Set input to options file to read. */
/* nag_file_open (x04acc), see above. */
nag_file_open(optionsfile, 0, &fileidin, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
/* nag_opt_qpconvex2_sparse_option_file (e04nrc).
* Supply optional parameter values for
* nag_opt_qpconvex2_sparse_solve (e04nqc) from external
* file
*/
nag_opt_qpconvex2_sparse_option_file(fileidin, &state, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
nag_file_close(fileidin, &fail); /* Close Library output */
/* Use nag_opt_qpconvex2_sparse_option_integer_get (e04nxc) to find the value
* of Integer-valued option 'Elastic mode'.
*/
/* nag_opt_qpconvex2_sparse_option_integer_get (e04nxc).
* Get the setting of an integer valued option of
* nag_opt_qpconvex2_sparse_solve (e04nqc)
*/
nag_opt_qpconvex2_sparse_option_integer_get("Elastic mode", &elmode, &state,
&fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
printf("Option 'Elastic mode' has the value %3" NAG_IFMT ".\n", elmode);
/* Use nag_opt_qpconvex2_sparse_option_double_set (e04nuc) to set the value of
* real-valued option 'Infinite bound size'.
*/
bndinf = 1e10;
/* nag_opt_qpconvex2_sparse_option_double_set (e04nuc).
* Set a single option for nag_opt_qpconvex2_sparse_solve
* (e04nqc) from a double argument
*/
nag_opt_qpconvex2_sparse_option_double_set("Infinite bound size", bndinf,
&state, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
/* Use nag_opt_qpconvex2_sparse_option_double_get (e04nyc) to find the value
* of real-valued option 'Feasibility tolerance'.
*/
/* nag_opt_qpconvex2_sparse_option_double_get (e04nyc).
* Get the setting of a double valued option of
* nag_opt_qpconvex2_sparse_solve (e04nqc)
*/
nag_opt_qpconvex2_sparse_option_double_get("Feasibility tolerance", &featol,
&state, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
printf("Option 'Feasibility tolerance' has the value %14.5e.\n", featol);
/* Use nag_opt_qpconvex2_sparse_option_string (e04nsc) to set the option
* 'Iterations limit'.
*/
/* nag_opt_qpconvex2_sparse_option_string (e04nsc).
* Set a single option for nag_opt_qpconvex2_sparse_solve
* (e04nqc) from a character string
*/
nag_opt_qpconvex2_sparse_option_string("Iterations limit 50", &state, &fail);
if (fail.code != NE_NOERROR) {
exit_status = 1;
goto END;
}
printf("\n");
fflush(stdout);
#ifdef SHOW_MONITORING_INFO
nag_file_open("", 2, &fileidout, &fail);
fflush(stdout);
#endif
/* Solve the QP problem. */
/* nag_opt_qpconvex2_sparse_solve (e04nqc).
* LP or QP problem (suitable for sparse problems)
*/
nag_opt_qpconvex2_sparse_solve(start, qphx, m, n, ne, nname, lenc, ncolh,
iobj, objadd, prob, acol, inda, loca, bl, bu,
c, (const char **)names, helast, hs, x, pi, rc,
&ns, &ninf, &sinf, &obj, &state, &comm, &fail);
if (n >= 1 && m >= 1) {
for (i = 1; i <= nname; ++i) {
NAG_FREE(names[i - 1]);
}
}
if (fail.code == NE_NOERROR) {
printf("Final objective value = %12.3e\n", obj);
printf("Optimal X = ");
for (i = 1; i <= n; ++i) {
printf("%8.2f%s", x[i - 1], i % 7 == 0 || i == n ? "\n" : " ");
}
} else {
printf("Error from nag_opt_qpconvex2_sparse_solve (e04nqc).\n%s\n",
fail.message);
exit_status = 1;
goto END;
}
if (fail.code != NE_NOERROR) {
exit_status = 2;
}
END:
NAG_FREE(cuser);
NAG_FREE(names);
NAG_FREE(prob);
NAG_FREE(acol);
NAG_FREE(bl);
NAG_FREE(bu);
NAG_FREE(c);
NAG_FREE(pi);
NAG_FREE(rc);
NAG_FREE(x);
NAG_FREE(helast);
NAG_FREE(hs);
NAG_FREE(inda);
NAG_FREE(iuser);
NAG_FREE(loca);
return exit_status;
}
static void NAG_CALL qphx(Integer ncolh, const double x[], double hx[],
Integer nstate, Nag_Comm *comm) {
/* Routine to compute H*x. (In this version of qphx, the Hessian
* matrix H is not referenced explicitly.)
*/
/* Parameter adjustments */
#define HX(I) hx[(I)-1]
#define X(I) x[(I)-1]
/* Function Body */
if (comm->user[0] == -1.0) {
fflush(stdout);
printf("(User-supplied callback qphx, first invocation.)\n");
comm->user[0] = 0.0;
fflush(stdout);
}
HX(1) = X(1) * 2;
HX(2) = X(2) * 2;
HX(3) = (X(3) + X(4)) * 2;
HX(4) = HX(3);
HX(5) = X(5) * 2;
HX(6) = (X(6) + X(7)) * 2;
HX(7) = HX(6);
return;
} /* qphx */