main(int argc, char **argv)
#endif
{
char *stub;
ASL *asl;
FILE *nl;
lprec *lp;
ograd *og;
int ct, i, intmin, *is, j, j0, j1, k, nalt, rc;
short *basis, *lower;
real *LU, *c, lb, objadj, *rshift, *shift, t, ub, *x, *x0, *x1;
char buf[256];
typedef struct { char *msg; int code; } Sol_info;
static Sol_info solinfo[] = {
{ "optimal", 0 },
{ "integer programming failure", 502 },
{ "infeasible", 200 },
{ "unbounded", 300 },
{ "failure", 501 },
{ "bug", 500 }
};
sprintf(lp_solve_version+9, "%.*s", (int)sizeof(lp_solve_version)-10,
PATCHLEVEL);
sprintf(lp_solve_vversion, "%s, driver(20001002)", lp_solve_version);
asl = ASL_alloc(ASL_read_f);
stub = getstub(&argv, &Oinfo);
nl = jac0dim(stub, (fint)strlen(stub));
suf_declare(suftab, sizeof(suftab)/sizeof(SufDecl));
/* set A_vals to get the constraints column-wise */
A_vals = (real *)M1alloc(nzc*sizeof(real));
f_read(nl,0);
lp = make_lp(n_con, 0);
Oinfo.uinfo = (char *)lp;
if (getopts(argv, &Oinfo))
return 1;
i = n_var + n_con + 1;
x = (real*)M1alloc(i*sizeof(real)); /* scratch vector */
memset(x, 0, i*sizeof(real));
x0 = x++;
c = x + n_con;
/* supply objective */
objadj = 0;
if (--nobj >= 0 && nobj < n_obj) {
for(og = Ograd[nobj]; og; og = og->next)
c[og->varno] = og->coef;
if (objtype[nobj])
set_maxim(lp);
objadj = objconst(nobj);
}
/* supply columns and variable bounds */
LU = LUv;
intmin = n_var - (nbv + niv);
j1 = nalt = 0;
rshift = shift = 0;
for(i = 1; i <= n_var; i++, LU += 2) {
lb = LU[0];
ub = LU[1];
j0 = j1;
j1 = A_colstarts[i];
*x0 = *c++; /* cost coefficient */
if (lb <= negInfinity && ub < Infinity) {
/* negate this variable */
nalt++;
lb = -ub;
ub = -LU[0];
for(j = j0; j < j1; j++)
x[A_rownos[j]] = -A_vals[j];
*x0 = -*x0;
add_column(lp, x0);
if (lb)
goto shift_check;
}
else {
for(j = j0; j < j1; j++)
x[A_rownos[j]] = A_vals[j];
add_column(lp, x0);
if (lb <= negInfinity) {
nalt++;
if (i > intmin)
set_int(lp, lp->columns, TRUE);
/* split free variable */
*x0 = -*x0;
for(j = j0; j < j1; j++)
x[A_rownos[j]] *= -1.;
add_column(lp,x0);
}
else if (lb) {
shift_check:
if (lb > 0)
set_lowbo(lp, lp->columns, lb);
else {
if (!rshift) {
rshift = (real*)M1zapalloc(
(n_var+n_con)*sizeof(real));
shift = rshift + n_con - 1;
}
shift[i] = lb;
for(j = j0; j < j1; j++) {
k = A_rownos[j];
rshift[k] += lb*x[k];
}
if (ub < Infinity)
ub -= lb;
objadj += lb**x0;
}
}
if (ub < Infinity)
set_upbo(lp, lp->columns, ub);
}
for(j = j0; j < j1; j++)
x[A_rownos[j]] = 0;
if (i > intmin)
set_int(lp, lp->columns, TRUE);
}
if (objadj) {
/* add a fixed variable to adjust the objective value */
*x0 = objadj;
add_column(lp, x0);
set_lowbo(lp, i, 1.);
set_upbo(lp, i, 1.);
}
/* supply constraint rhs */
LU = LUrhs;
for(i = 1; i <= n_con; i++, LU += 2) {
t = LU[0];
if (t == LU[1])
ct = EQ;
else if (t <= negInfinity) {
t = LU[1];
if (t >= Infinity) {
/* This is possible only with effort: */
/* one must turn presolve off and */
/* explicitly specify a constraint */
/* with infinite bounds. */
fprintf(Stderr,
"Sorry, can't handle free rows.\n");
exit(1);
}
ct = LE;
}
else
ct = GE;
set_constr_type(lp, i, ct);
set_rh(lp, i, rshift ? t - *rshift++ : t);
if (ct == GE && LU[1] < Infinity)
lp->orig_upbo[i] = LU[1] - t;
}
if (prlp)
print_lp(lp);
if (scaling)
auto_scale(lp);
/* Unfortunately, there seems to be no way to suggest */
/* a starting basis to lp_solve; thus we must ignore */
/* any incoming .sstatus values. */
rc = solve(lp);
if (rc < 0 || rc > 5)
rc = 5;
solve_result_num = solinfo[rc].code;
i = sprintf(buf, "%s: %s", Oinfo.bsname, solinfo[rc].msg);
if (rc == OPTIMAL)
i += sprintf(buf+i, ", objective %.*g", obj_prec(),
lp->best_solution[0]);
i += sprintf(buf+i,"\n%d simplex iterations", lp->total_iter);
if (lp->max_level > 1 || lp->total_nodes > 1)
sprintf(buf+i, "\n%d branch & bound nodes: depth %d",
lp->total_nodes, lp->max_level);
/* Prepare to report solution: deal with split free variables. */
x1 = lp->best_solution+lp->rows+1;
if (nalt || shift) {
x = x0;
LU = LUv;
for(i = 0; i < n_var; i++, LU += 2) {
if (LU[0] > negInfinity)
x[i] = *x1++;
else if (LU[1] < Infinity)
x[i] = -*x1++;
else {
x[i] = x1[0] - x1[1];
x1 += 2;
}
if (shift)
x[i] += *++shift;
}
}
else
x = x1;
if (solinfo[rc].code < 500 && !(nbv + niv)) {
/* return .sstatus values */
basis = lp->basis;
lower = lp->lower;
is = M1alloc((n_var + n_con)*sizeof(int));
suf_iput("sstatus", ASL_Sufkind_con, is);
for(i = 0; i < n_con; i++) {
j = *++lower;
*is++ = *++basis ? 1 : j ? 3 : 4;
}
suf_iput("sstatus", ASL_Sufkind_var, is);
LU = LUv;
for(i = 0; i < n_var; i++, LU += 2) {
j0 = *++basis;
j1 = *++lower;
if (LU[0] > negInfinity)
j = j0 ? 1 : j1 ? 3 : 4;
else if (LU[1] < Infinity)
j = j0 ? 1 : j1 ? 4 : 3;
else {
++lower;
j = *++basis || j0;
}
*is++ = j;
}
}
write_sol(buf, x, lp->duals+1, &Oinfo);
/* The following calls would only be needed */
/* if execution were to continue... */
delete_lp(lp);
ASL_free(&asl);
return 0;
}
nl_write(int m, int n, cgrad **cg0, real *LU_bounds, real *LU_ranges, int Max)
#endif
{
cgrad *cg, **cgt, *nextcg;
int c, i, j, k, kg, nr;
int *x;
char *fmt;
double *lu, *lue;
size_t zaplen;
if (binary_nl) {
c = 'b';
pr = bprintf;
fmt = "wb";
}
else {
c = 'g';
pr = aprintf;
fmt = "w";
}
fd = openfo(".nl", fmt);
zaplen = (m+1)*sizeof(cgrad *);
cgt = (cgrad **)Malloc(zaplen + n*sizeof(int));
x = (int *)(cgt + m + 1);
memset((char *)cgt, 0, zaplen);
for(i = k = kg = 0; i < n; i++) {
for(cg = cg0[i]; cg; cg = cg->next)
if (--cg->varno < m)
k++;
else
kg++;
x[i] = k;
}
while(--i >= 0)
for(cg = cg0[i]; cg; cg = nextcg) {
nextcg = cg->next;
cg->next = cgt[j = cg->varno];
cgt[j] = cg;
cg->varno = i;
}
lue = LU_ranges + 2*m;
for(lu = LU_ranges, nr = 0; lu < lue; lu += 2)
if (lu[0] > negInfinity
&& lu[1] < Infinity
&& lu[0] < lu[1])
nr++;
fprintf(fd, "%c3 0 0 0\n", c);
fprintf(fd, " %d %d 1 %d\n 0 0\n 0 0\n 0 0\n 0 0 %d %d\n 0 0\n",
n, m, nr, binary_nl ? Arith_Kind_ASL : 0, asl->i.flags);
fprintf(fd, " %d %d\n 0 0\n 0 0 0 0 0\n", k, kg);
for(i = 0; i < m; i++) {
pr("C%d\n", i);
pr("n%g\n", 0.);
}
pr("O%d %d\n", 0, 1-Max);
pr("n%g\n", objconst(objno));
brout('r', m, LU_ranges);
brout('b', n, LU_bounds);
pr("k%d\n", --n);
for(i = 0; i < n; i++)
pr("%d\n", x[i]);
for(i = 0; i < m; i++) {
cg = cgt[i];
pr("J%d %d\n", i, cglen(cg));
for(; cg; cg = cg->next)
pr("%d %g\n", cg->varno, cg->coef);
}
cg = cgt[m];
pr("G%d %d\n", 0, cglen(cg));
for(; cg; cg = cg->next)
pr("%d %g\n", cg->varno, cg->coef);
fclose(fd);
}
dfmt(int op)
#endif
{
cgrad **cg0, **cg01, *cgi, *cgi0, *cgi00, *cgj, **cgnew,
**cgprev, **cgx, *free_cg;
ograd *og;
real *LU, *LUdv, *LUdvi, *LUdrhs, *LUdvxi, *LUrhse, *LUve;
int Max, aextra, i, m, me, n, n1, nextra;
FILE *f;
real t;
char *dvtype, *dvt;
static char *AXIN[2] = { "AX", "IN" };
dvthead dvth;
char buf[32];
n = c_vars;
if (n < o_vars)
n = o_vars;
n1 = n + 1;
m = n_con;
LUrhse = LUrhs + 2*m;
LUve = LUv + 2*n;
aextra = nextra = 0;;
for (LU = LUrhs, cgx = Cgrad; LU < LUrhse; LU += 2, cgx++)
if (LU[0] > negInfinity) {
if (LU[0])
aextra++;
if (LU[0] < LU[1] && LU[1] < Infinity) {
nextra++;
if (LU[1])
aextra++;
for(cgi = *cgx; cgi; cgi = cgi->next)
aextra++;
}
else if (LU[0])
aextra++;
}
else if (LU[1])
aextra++;
for (LU = LUv; LU < LUve; LU += 2) {
if (LU[0] > negInfinity) {
aextra++;
nextra++;
if (LU[0])
aextra++;
}
if (LU[1] < Infinity) {
aextra++;
nextra++;
if (LU[1])
aextra++;
}
}
me = m + nextra;
LUdvi = LUdv = (real *)Malloc((me + n)*2*sizeof(real)
+ me*sizeof(cgrad *)
+ aextra*sizeof(cgrad)
+ m);
LUdvxi = LUdv + 2*m;
LUdrhs = LUdvxi + 2*nextra;
free_cg = (cgrad *)(LUdrhs + 2*n);
cg0 = cg01 = (cgrad **)(free_cg + aextra);
cgnew = cg0 + m;
dvt = dvtype = (char *)(cgnew + nextra);
for (LU = LUrhs, cgx = Cgrad; LU < LUrhse; LU += 2, cgx++) {
cgi0 = 0;
for(cgi = cgi00 = *cgx; cgi; cgi = cgj) {
cgj = cgi->next;
cgi->next = cgi0;
cgi0 = cgi;
cgi->varno++;
}
*cg01++ = cgi0;
if (LU[0] > negInfinity) {
*LUdvi++ = LU[0] == LU[1] ? negInfinity : 0;
*LUdvi++ = Infinity;
if (LU[0] < LU[1] && LU[1] < Infinity) {
*LUdvxi++ = 0;
*LUdvxi++ = Infinity;
cgprev = cgnew++;
for(cgi = *cgx; cgi; cgi = cgi->next) {
*cgprev = cgj = free_cg++;
cgprev = &cgj->next;
cgj->varno = cgi->varno;
cgj->coef = -cgi->coef;
}
if (LU[1]) {
cgi = *cgprev = free_cg++;
cgi->varno = n1;
cgi->coef = -LU[1];
cgprev = &cgi->next;
}
*cgprev = 0;
*dvt++ = 2;
}
else
*dvt++ = LU[0] == LU[1] ? 3 : 0;
if (LU[0]) {
cgi = cgi00->next = free_cg++;
cgi->varno = n1;
cgi->coef = LU[0];
cgi->next = 0;
}
}
else {
*dvt++ = 1;
*LUdvi++ = 0;
*LUdvi++ = Infinity;
for(cgi = cgi0; cgi; cgi = cgi->next)
cgi->coef = -cgi->coef;
if (LU[1]) {
cgi = cgi00->next = free_cg++;
cgi->varno = n1;
cgi->coef = -LU[1];
cgi->next = 0;
}
}
}
for (LU = LUv, i = 1; LU < LUve; LU += 2, i++) {
if (LU[0] > negInfinity) {
*LUdvxi++ = 0;
*LUdvxi++ = Infinity;
*cgnew++ = cgi = free_cg++;
cgi->varno = i;
cgi->coef = 1;
if (LU[0]) {
cgi = cgi->next = free_cg++;
cgi->varno = n1;
cgi->coef = LU[0];
}
cgi->next = 0;
}
if (LU[1] < Infinity) {
*LUdvxi++ = 0;
*LUdvxi++ = Infinity;
*cgnew++ = cgi = free_cg++;
cgi->varno = i;
cgi->coef = -1;
if (LU[1]) {
cgi = cgi->next = free_cg++;
cgi->varno = n1;
cgi->coef = -LU[1];
}
cgi->next = 0;
}
}
memset(LUdrhs, 0, n*2*sizeof(real));
if (objno >= 0)
for(og = Ograd[objno]; og; og = og->next) {
LU = LUdrhs + 2*og->varno;
LU[0] = LU[1] = og->coef;
}
if (Max = objtype[objno])
for(LU = LUdv; LU < LUdrhs; LU += 2) {
t = LU[0];
LU[0] = -LU[1];
LU[1] = -t;
}
/* Negate columns with lower bound -Infinity, finite upper bound. */
/* This shouldn't be necessary, but shortens the MPS file */
/* and may avoid bugs in some solvers. */
for(cg01 = cg0, LU = LUdv; LU < LUdrhs; LU += 2, cg01++)
if (LU[0] <= negInfinity && LU[1] < Infinity) {
t = LU[0];
LU[0] = -LU[1];
LU[1] = -t;
for(cgi = *cg01; cgi; cgi = cgi->next)
cgi->coef = -cgi->coef;
}
if (op != 'm') {
switch(op) {
case 'b':
binary_nl = 1;
break;
case 'g':
binary_nl = 0;
}
nl_write(n, me, cg0, LUdv, LUdrhs, Max);
}
else {
mps(n, me, cg0, LUdv, LUdrhs);
f = openfo(".spc", "w");
fprintf(f, "BEGIN %s\nROWS %d\nCOLUMNS %d\n",
Basename, n + 1, me+1);
fprintf(f, "*true value: COLUMNS %d\n", me);
fprintf(f, "ELEMENTS %d\nM%sIMIZE\nOBJECTIVE DUMMY\n",
nzc + aextra, AXIN[Max]);
fprintf(f, "END %s\n", Basename);
fclose(f);
f = openfo(".adj", "w");
g_fmt(buf, objconst(objno));
fprintf(f, "'objective' %s\n", buf);
fclose(f);
}
f = openfo(".duw", "wb");
for(i = 0; i < 10; i++)
dvth.Options[i] = ampl_options[i];
dvth.vbtol = ampl_vbtol;
dvth.m = m;
dvth.n = n;
dvth.nextra = nextra;
dvth.maxobj = Max;
dvth.binary = binary_nl;
fwrite(&dvth, sizeof(dvthead), 1, f);
fwrite(dvtype, m, 1, f);
fclose(f);
}
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
//Possible Inputs
char fpath[FLEN];
char msg[FLEN];
char cmd[FLEN]; //user commmand
int sp = 0;
//Outputs
const char *fnames[15] = {"H","f","lb","ub","A","cl","cu","Q","l","qcind","x0","v0","sense","objbias","conlin"};
double *sizes;
//Internal Vars
int ii; size_t i,j,k; //indexing vars
char *what, **whatp; //error message vars
static FILE *nl; //file handle
ASL *asl = cur_ASL; //Current ASL instance
int icmd = ASLCMD_ERROR; //Command Integer
double *sense; //Objective sense
double *objbias; //Objective bias
int obj_lin; //linearity of the objectiuve (see ASL_DEGREE_ defines)
double *con_lin; //linearity of the constraints (see ASL_DEGREE_ defines)
double *isopen; //Is ASL open
bool nlcon = false; //indicates whether any constraint is nonlinear
double *x; //Evaluation point
double *f, *g, *c = NULL; //Return pointers
int nerror; //eval errors
//Sparse Indexing
mwIndex *Ir, *Jc;
double *Pr;
//QP Checking Vars
int nqpz = 0; //number of nzs in quadratic objective
int nqc_con = 0; //number of quadratic constraints
int *QP_ir, *QP_jc; //Pointers used when calling nqpcheck
double *QP_pr;
double *pqi; //pointer to quadratic index vector
ograd *og; //objective gradient structure
//Jacobian Vars
static double *J = NULL; //Memory to store intermediate Jacobian Values when using Dense Mode
static double *J1 = NULL; //Memory to store Jacobian Values
cgrad *cg, **cgp, **cgpe; //constraint gradient structures
int *cs; //Column starts
//Hessian Vars
static double *Hsp = NULL; //Memory to store Hessian Values
static int nhnz; //Number of Hessian nz
double *s, *v; //Sigma, Lambda
int *hcs, *hr; //Hessian column starts, row indexs
double *H, *He, *W;
//Error catching
Jmp_buf err_jmp0;
//If no inputs, just return info
if(nrhs < 1)
{
if (nlhs >= 1)
{
sprintf(msgbuf,"%s %s",__TIME__,__DATE__);
plhs[0] = mxCreateString(msgbuf);
plhs[1] = mxCreateDoubleScalar(OPTI_VER);
}
else
{
printUtilityInfo();
}
return;
}
//Get User Command
icmd = getCommand(prhs[0]);
//Switch Yard for Command
switch(icmd)
{
case ASLCMD_ISOPEN:
isopen = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
if(asl)
*isopen = 1;
else
*isopen = 0;
break;
case ASLCMD_OPEN:
//Check for Errors
if(nrhs < 2)
mexErrMsgTxt("Expected two arguments to open a file! [x0,v0,lb,ub,cl,cu,sense,sizes] = asl('open','file path')\n");
if(!mxIsChar(prhs[1]))
mexErrMsgTxt("File path must be a char array!");
//Get String
CHECK(mxGetString(prhs[1], fpath, FLEN) == 0,"error reading file path!");
//Clear any existing objects
if (cur_ASL)
ASL_free(&cur_ASL);
//Set MEX exit function
mexAtExit(mexExit);
//Open file for LP/QP/QCQP checking
asl = ASL_alloc(ASL_read_fg); //allocate for qp read
return_nofile = 1; //return 0 if stub doesn't exist
nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read in passed file
//Check we got the file
if(!nl) {
sprintf(msgbuf, "Can't open (or error opening) %s\n", fpath);
mexErrMsgTxt(msgbuf);
}
//Allocate Vector Memory
pPROB = mxCreateStructMatrix(1,1,15,fnames);
mxSetField(pPROB,0,fnames[eX0],mxCreateDoubleMatrix(n_var,1, mxREAL));
mxSetField(pPROB,0,fnames[eV0],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eLB],mxCreateDoubleMatrix(n_var, 1, mxREAL));
mxSetField(pPROB,0,fnames[eUB],mxCreateDoubleMatrix(n_var, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCL],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCU],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eSENSE],mxCreateDoubleMatrix(1, 1, mxREAL));
mxSetField(pPROB,0,fnames[eOBJBIAS],mxCreateDoubleMatrix(1, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCONLIN],mxCreateDoubleMatrix(n_con, 1, mxREAL));
//Get Fields (ASL will fill)
X0 = mxGetPr(mxGetField(pPROB,0,fnames[eX0]));
pi0 = mxGetPr(mxGetField(pPROB,0,fnames[eV0]));
LUv = mxGetPr(mxGetField(pPROB,0,fnames[eLB]));
Uvx = mxGetPr(mxGetField(pPROB,0,fnames[eUB]));
LUrhs = mxGetPr(mxGetField(pPROB,0,fnames[eCL]));
Urhsx = mxGetPr(mxGetField(pPROB,0,fnames[eCU]));
sense = mxGetPr(mxGetField(pPROB,0,fnames[eSENSE]));
objbias = mxGetPr(mxGetField(pPROB,0,fnames[eOBJBIAS]));
con_lin = mxGetPr(mxGetField(pPROB,0,fnames[eCONLIN]));
//Other Output Args
sizes = mxGetPr(pSIZE = mxCreateDoubleMatrix(16, 1, mxREAL));
//Check for complementarity problems
if(n_cc)
mexWarnMsgTxt("Ignoring Complementarity Constraints!");
//Assign asl problem sizes
sizes[0] = (double)n_var; sizes[1] = (double)n_con; sizes[2] = (double)nzc;
sizes[3] = (double)lnc; sizes[4] = (double)nbv; sizes[5] = (double)niv;
sizes[6] = (double)nlc; sizes[7] = (double)nlnc; sizes[8] = (double)nlo;
sizes[9] = (double)nlvb; sizes[10] = (double)nlvc; sizes[11] = (double)nlvo;
sizes[12] = (double)nlvbi; sizes[13] = (double)nlvci; sizes[14] = (double)nlvoi;
sizes[15] = (double)nwv;
//Read In For QP Checking
qp_read(nl,0);
//Assign sense
if(objtype[0] == 1)
*sense = -1; //max
else
*sense = 1; //min
//Determine Objective Linearity
obj_lin = linCheck(asl, 0);
//Determine Constraints Linearity
for(ii = 0; ii < n_con; ii++) {
con_lin[ii] = linCheck(asl, -(ii+1));
//Check if nonlinear or quadratic
if(con_lin[ii] >= ASL_DEGREE_NLIN)
nlcon = true;
else if(con_lin[ii] == ASL_DEGREE_QUAD)
{
//con_lin indicates quadratic constraint, ensure is inequality
if(LUrhs[ii] != Urhsx[ii])
nqc_con++;
else
nlcon = true; //quadratic equalities not currently handled by any explicit QCQP solver (I know of), make nl
}
}
//Check to force to read as nonlinear problem
if(nrhs > 2 && *mxGetPr(prhs[2])==1)
nlcon = true;
//If objective or any constraint is nonlinear, then we have to process as an NLP
if(obj_lin == ASL_DEGREE_NLIN || nlcon) {
//Free the QP read memory
ASL_free(&asl);
//Re-open for full NLP read
asl = ASL_alloc(ASL_read_pfgh); //allocate memory for pfgh read
nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read passed file (full nl read)
//Allocate Jacobian Memory [note use M1alloc to let ASL clean it up if multiple instances opened]
J = (double*)M1alloc(nzc*sizeof(double)); //Memory to store Jacobian nzs
//Assign memory for saving obj + con x
objx = (double*)M1alloc(n_var*sizeof(double));
conx = (double*)M1alloc(n_var*sizeof(double));
//Read File (f + g + H)
pfgh_read(nl, ASL_findgroups);
//Assign Hessian Memory
nhnz = sphsetup(1, 1, n_con > 0, 0); //one obj, use sigma, optionally use lambda, full hessian
Hsp = (double*)M1alloc(nhnz*sizeof(double)); //memory to store hessian nzs
}
//Otherwise we can process as a LP, QP or QCQP
else {
//Assign objective bias
*objbias = objconst(0);
//Check for quadratic objective
if(obj_lin == ASL_DEGREE_QUAD) {
//Capture Pointers
nqpz = nqpcheck(0, &QP_ir, &QP_jc, &QP_pr); //check objective for qp
//Create QP H
mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,nqpz,mxREAL));
//Copy in Objective Quadratic Elements (copy-cast where appropriate)
memcpy(mxGetPr(mxGetField(pPROB,0,fnames[eH])),QP_pr,nqpz*sizeof(double));
Jc = mxGetJc(mxGetField(pPROB,0,fnames[eH]));
Ir = mxGetIr(mxGetField(pPROB,0,fnames[eH]));
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)QP_jc[i];
for(i = 0; i < nqpz; i++)
Ir[i] = (mwIndex)QP_ir[i];
}
else //create an empty sparse matrix
mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,0,mxREAL));
//Create QP f
mxSetField(pPROB,0,fnames[eF],mxCreateDoubleMatrix(n_var,1,mxREAL));
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eF]));
//Copy in Objective Linear Elements
for( og = Ograd[0]; og; og = og->next )
Pr[og->varno] = og->coef;
//Create A (linear constraints)
mxSetField(pPROB,0,fnames[eA],mxCreateSparse(n_con, n_var, nzc, mxREAL));
if(n_con) {
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eA]));
Ir = mxGetIr(mxGetField(pPROB,0,fnames[eA]));;
//Fill in A (will double on quadratic linear sections, but easier to remove once in MATLAB)
for(Jc = mxGetJc(mxGetField(pPROB,0,fnames[eA])), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next) {
Ir[cg->goff] = (mwIndex)i;
Pr[cg->goff] = cg->coef;
}
}
//Add quadratic constraints if present
if(nqc_con) {
//Allocate a Cell Array to store the quadratic constraint Qs, and vector to store indices
mxSetField(pPROB,0,fnames[eQ],mxCreateCellMatrix(nqc_con,1)); //Q
mxSetField(pPROB,0,fnames[eL],mxCreateDoubleMatrix(n_var, nqc_con,mxREAL)); //l
mxSetField(pPROB,0,fnames[eQCIND],mxCreateDoubleMatrix(nqc_con,1,mxREAL)); //ind
pqi = mxGetPr(mxGetField(pPROB,0,fnames[eQCIND]));
//Fill In Constraints
for(ii=0,j=0;ii<n_con;ii++) {
//Quadratic Constraints
if(con_lin[ii] == ASL_DEGREE_QUAD) {
//Create index
pqi[j] = ii+1; //increment for matlab index
//Capture Pointers
nqpz = nqpcheck(-(ii+1), &QP_ir, &QP_jc, &QP_pr); //check constraint for qp;
if(nqpz <= 0)
mexErrMsgTxt("Error reading quadratic constraints. Assumed constraint was quadratic based on prescan, now appears not?");
//Create QC Q
mxSetCell(mxGetField(pPROB,0,fnames[eQ]),j,mxCreateSparse(n_var,n_var,nqpz,mxREAL));
//Copy in Constraint Quadratic Elements (copy-cast where appropriate)
Pr = mxGetPr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
Jc = mxGetJc(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
Ir = mxGetIr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
for(k = 0; k <= n_var; k++)
Jc[k] = (mwIndex)QP_jc[k];
for(k = 0; k < nqpz; k++) {
Ir[k] = (mwIndex)QP_ir[k];
Pr[k] = 0.5*QP_pr[k]; //to QP form
}
//Create QC l (not sure why we can't extract this from Jacobian, values are wrong)
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eL]));
for( cg = Cgrad[ii]; cg; cg = cg->next )
Pr[j*n_var + cg->varno] = cg->coef;
//Increment for next cell / col
j++;
}
}
}
//Put back into function eval mode (just in case)
qp_opify();
}
break;
case ASLCMD_CLOSE:
//Check for Errors
CHECKASL(asl);
//Call Exit Function
mexExit();
break;
case ASLCMD_FUN:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(objx) memcpy(objx,x,n_var*sizeof(double));
//Create objective val memory and get it from ASL
SETERRJMP(); what = "objective";
f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
*f = objval(0, x, &nerror);
break;
case ASLCMD_GRAD:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(objx) memcpy(objx,x,n_var*sizeof(double));
//Create objective grad memory and get it from ASL
SETERRJMP(); what = "gradient";
g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, n_var, mxREAL));
objgrd(0, x, g, &nerror);
break;
case ASLCMD_CON:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(conx) memcpy(conx,x,n_var*sizeof(double));
//Create constraint memory and get it from ASL
SETERRJMP(); what = "constraints";
c = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, 1, mxREAL));
if(n_con)
conval(x, c, &nerror);
break;
case ASLCMD_JAC:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(conx) memcpy(conx,x,n_var*sizeof(double));
//Create constraint jac memory and get it from ASL
SETERRJMP(); what = "Jacobian";
//Check for sparsity
if(nrhs > 2 && *mxGetPr(prhs[2])) {
sp = 1;
J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL));
}
else {
sp = 0;
J1 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, n_var, mxREAL));
}
//Evaluate if we have constraints
if (n_con) {
//Sparse
if(sp) {
jacval(x, J1, &nerror);
Ir = mxGetIr(plhs[0]);
for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = (mwIndex)i;
}
//Dense
else {
jacval(x, J, &nerror);
cgp = Cgrad;
for(cgpe = cgp + n_con; cgp < cgpe; J1++)
for(cg = *cgp++; cg; cg = cg->next)
J1[n_con*cg->varno] = J[cg->goff];
}
}
break;
case ASLCMD_JACSTR:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,1);
//Create constraint jacstr memory and get it from ASL
SETERRJMP(); what = "Jacobian Structure)";
J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL));
//Fill In Structure
for(i=0;i<nzc;i++)
J1[i] = 1.0;
for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
Ir = mxGetIr(plhs[0]);
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = (mwIndex)i;
break;
case ASLCMD_HES:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,4); //assume hess(x,sigma,lambda) and optionally sparse
//Check dimensions & get args
x = sizechk(prhs[1],"x",n_var);
s = sizechk(prhs[2],"sigma",1);
v = sizechk(prhs[3],"lambda",n_con);
//Check for sparsity
if(nrhs > 4 && *mxGetPr(prhs[4])) {
sp = 1;
W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL));
}
else {
sp = 0;
W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_var, n_var, mxREAL));
}
//Check if we need to recalculate objective / constraints
if(!comp_x(objx,x,n_var)) {
//Setup Error Catching
SETERRJMP(); what = "Objective for Hessian";
//Re-evaluate Objective
objval(0, x, &nerror);
}
if(!comp_x(conx,x,n_var)){
if(!c)
c = mxGetPr(mxCreateDoubleMatrix(n_con, 1, mxREAL));
//Setup Error Catching
SETERRJMP(); what = "Constraints for Hessian";
//Re-evaluate Constraints
conval(x, c, &nerror);
}
//Setup Error Catching
SETERRJMP(); what = "Hessian";
//Sparse
if(sp) {
//This function returns the full (symmetric) Hessian as setup above
sphes(H = Hsp, 1, s, v);
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)hcs[i];
He = H + hcs[n_var];
while(H < He) {
*W++ = *H++;
*Ir++ = (mwIndex)*hr++;
}
}
//Dense
else
fullhes(W, n_var, 1, s, v);
break;
case ASLCMD_HESSTR:
//mexPrintf("CMD: Get Hessian Structure\n");
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,1);
//Create hessianstr memory and get it from ASL
SETERRJMP(); what = "Hessian Structure";
W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL));
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
//Get Sparse Info
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
//Assign col starts
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)hcs[i];
//Assign rows + 1.0 for nz positions
H = Hsp; //Start of nz Hsp elements
He = H + hcs[n_var]; //End of nz Hsp elements
while(H < He) {
*W++ = 1.0;
*Ir++ = (mwIndex)*hr++;
*H++; //increment nz element position
}
break;
case ASLCMD_WRITESOL:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2); //asl('writesol',msg,x)
//Get Input Args
CHECK(mxGetString(prhs[1], msg, FLEN) == 0,"error reading message!");
x = sizechk(prhs[2],"x",n_var);
//Write to solution stub file
write_sol(msg,x,NULL,NULL);
break;
default:
mexExit(); //clean up
mxGetString(prhs[0], cmd, FLEN);
sprintf(msgbuf, "ASL Command Error! Unknown Command: '%s'\n", cmd);
mexErrMsgTxt(msgbuf);
break;
}
}
