Ejemplo n.º 1
0
ASL *readASLfg (char **argv) {

  // read .nl file from first argument //////////////////////////

  char *stub;

  // Create the ASL structure
  ASL* asl = (ASL*) ASL_alloc (ASL_read_fg);
  FILE *nl = NULL;
  stub = getstub (&argv, &Oinfo);

  // Although very intuitive, we shall explain why the second argument
  // is passed with a minus sign: it is to tell the ASL to retrieve
  // the nonlinear information too.
  nl = jac0dim (stub, - (fint) strlen (stub));

  // Set options in the asl structure
  want_xpi0 = 1 | 2;  // allocate initial values for primal and dual if available
  obj_no = 0;         // always want to work with the first (and only?) objective

  // allocate space for initial values
  X0      = new real [n_var];
  havex0  = new char [n_var];
  pi0     = new real [n_con];
  havepi0 = new char [n_con];

  // read the rest of the nl file
  fg_read (nl, ASL_return_read_err | ASL_findgroups);

  return asl;
}
Ejemplo n.º 2
0
 int
jacdim_(const char *stub, fint *M, fint *N, fint *NO, fint *NZ,
		fint *MXROW, fint *MXCOL, ftnlen stub_len)
{
	ASL *asl;

	if (cur_ASL)
		return already_ASL("jacdim");
	asl = ASL_alloc(ASL_read_fg);
	return jac1dim_ASL(asl, stub, M, N, NO, NZ, MXROW, MXCOL, stub_len);
	}
Ejemplo n.º 3
0
 void
MAIN__(VOID)
{
	fint N, liv, lv;
	fint *iv;
	real *D, *v;
	int i;
	char **av = xargv;
	static fint L2 = 2;

	ASL_alloc(ASL_read_f);
	progname = *av++;
	if (*av && !strcmp(*av,"-AMPL")) {
		amplflag = 1;
		av++;
		}

	if (n_con) {
		fprintf(Stderr, "Ignoring %d constraints.\n", n_con);
		fflush(Stderr);
		}

	N = n_var;
	liv = 59 + N;
	lv = 71 + N*(N + 21)/2;
	v = (real *)Malloc((N + lv)*sizeof(real) + liv*sizeof(fint));
	D = v + lv;
	iv = (fint *)(D + N);

	for(i = 0; i < N; i++)
		D[i] = 1.;

	divset_(&L2, iv, &liv, &lv, v);	/* set default iv and v values */
	iv[mxfcal] = iv[mxiter] = 1200;	/* increase defaults */

	if (amplflag) {
		/* Turn off printing (unless requested in $mng_options). */
		iv[outlev] = 0;
		/* iv[solprt] = 0; */
		iv[statpr] = 0;
		iv[x0prt] = 0;
		}
	 /* call vivvals to process command-line arguments */
	vivvals("mngnlc", "mng_options", av, iv, v);

	Nprob = nprob;
	if (nprob >= 0 && nprob < n_obj && objtype[nprob]) {
		maximize = 1;
		objsign = -1.;
		}

	dmngb_(&N, D, X0, LUv, (U_fp)calcf, (U_fp)calcg, iv, &liv, &lv, v,
		iv, v, (U_fp)calcf);
	}
Ejemplo n.º 4
0
void *jampl_init(char *stub) {
  ASL_pfgh *asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
  if (!asl) return NULL;

  FILE *ampl_file = jac0dim(stub, (fint)strlen(stub));

  // Allocate room to store problem data
  if (! (asl->i.X0_    = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
  if (! (asl->i.LUv_   = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
  if (! (asl->i.Uvx_   = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
  if (! (asl->i.pi0_   = (real *)M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;
  if (! (asl->i.LUrhs_ = (real *)M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;
  if (! (asl->i.Urhsx_ = (real* )M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;

  // Read in ASL structure
  asl->i.want_xpi0_ = 3;        // Read primal and dual estimates
  pfgh_read(ampl_file , 0);     // pfgh_read closes the file.

  return (void *)asl;
}
Ejemplo n.º 5
0
 void
MAIN__(void)
{
	FILE *nl;
	fint *iv, liv, lv;
	fint N, NZ, P;
	real *rhsLU, *v;
	int i, j;
	extern int xargc;
	extern char **xargv;
	char *stub;
	static fint L1 = 1;
	static char *rvmsg[9] = {
		"X-Convergence", /* 3 */
		"Relative Function Convergence",
		"X- and Relative Function Convergence",
		"Absolute Function Convergence",
		"Singular Convergence",
		"False Convergence",
		"Function Evaluation Limit",
		"Iteration Limit",
		"Unexpected return code"
		};
	char buf[256];

	if (xargc < 2) {
		fprintf(Stderr, "usage: %s stub\n", xargv[0]);
		exit(1);
		}
	stub = xargv[1];

	ASL_alloc(ASL_read_fg);

	amplflag = xargc >= 3 && !strncmp(xargv[2], "-AMPL", 5);

	nl = jac0dim(stub, (fint)strlen(stub));
	if (n_obj) {
		fprintf(Stderr, "Ignoring %d objectives.\n", n_obj);
		fflush(Stderr);
		}

	N = n_con;
	P = n_var;
	NZ = nzc;
	liv = 82 + 4*P;
	lv = 105 + P*(N + 2*P + 21) + 2*N;
	v = (real *)Malloc((lv + P)*sizeof(real) + liv*sizeof(fint));
	X0 = v + lv;
	iv = (fint *)(X0 + P);

	fg_read(nl,0);

	/* Check for valid problem: all equality constraints. */

	for(i = j = 0, rhsLU = LUrhs; i++ < N; rhsLU += 2)
		if (rhsLU[0] != rhsLU[1]) {
			if (j++ > 4) {
				/* Stop chattering if > 4 errors. */
				fprintf(Stderr, "...\n");
				exit(2);
				}
			fprintf(Stderr, "Lrhs(%d) = %g < Urhs(%d) = %g\n",
				i, rhsLU[0], i, rhsLU[1]);
			}
	if (j)
		exit(2);

	dense_j();	/* Tell jacval_ we want a dense Jacobian. */

	divset_(&L1, iv, &liv, &lv, v);	/* set default iv and v values */
	if (amplflag)
		iv[prunit] = 0; /* Turn off printing . */

	dn2gb_(&N, &P, X0, LUv, (U_fp)calcr, (U_fp)calcj,
		iv, &liv, &lv, v, &NZ, LUrhs, (U_fp)calcr);

	j = iv[0] >= 3 && iv[0] <= 10 ? (int)iv[0] - 3 : 8;
	i = Sprintf(buf, "nl21: %s", rvmsg[j]);
	if (j == 8)
		i += Sprintf(buf+i, " %ld", iv[0]);
	i += Sprintf(buf+i,
		"\n%ld function, %ld gradient evaluations",
		iv[nfcall], iv[ngcall]);
	i += Sprintf(buf+i, "\nFinal sum of squares = ");
	g_fmtop(buf+i, 2*v[f]);
	write_sol(buf, X0, 0, 0);
	}
Ejemplo n.º 6
0
Archivo: spamfunc.c Proyecto: ampl/mp
 void
mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
	ASL_pfgh *asl = (ASL_pfgh*)cur_ASL;
	FILE *nl;
	Jmp_buf err_jmp0;
	cgrad *cg, **cgp;
	char *buf1, buf[512], *what, **whatp;
	fint *hcs, *hr, i, nerror;
	int *cs;
	mwIndex *Ir, *Jc;
	real *H, *He, *J1, *W, *c, *f, *g, *v, *t, *x;
	static fint n, nc, nhnz, nz;
	static real *Hsp;
	static char ignore_complementarity[] =
		"Warning: ignoring %d complementarity conditions.\n";

	if (nrhs == 1 && mxIsChar(prhs[0])) {
		if (nlhs < 6 || nlhs > 7)
			usage();
		if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
			mexErrMsgTxt("Expected 'stub' as argument\n");
		at_end();
		mexAtExit(at_end);
		asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
		return_nofile = 1;
		if (!(nl = jac0dim(buf1,strlen(buf)))) {
			sprintf(msgbuf, "Can't open %.*s\n",
				sizeof(msgbuf)-20, buf);
			mexErrMsgTxt(msgbuf);
			}
		if (n_obj <= 0)
			printf("Warning: objectve == 0\n");
		n = n_var;
		nc = n_con;
		nz = nzc;
		X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
		LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL));
		Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL));
		pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		if (nlhs == 7) {
			cvar = (int*)M1alloc(nc*sizeof(int));
			plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL);
			x = mxGetPr(plhs[6]);
			}
		else if (n_cc)
			printf(ignore_complementarity, n_cc);
		pfgh_read(nl, ASL_findgroups);
		if (nlhs == 7)
			for(i = 0; i < nc; i++)
				x[i] = cvar[i];

		/* Arrange to compute the whole sparese Hessian */
		/* of the Lagrangian function (both triangles). */

		nhnz = sphsetup(0, 0, nc > 0, 0);
		Hsp = (real *)M1alloc(nhnz*sizeof(real));
		return;
		}

	if (!asl)
		mexErrMsgTxt("spamfunc(\"stub\") has not been called\n");
	nerror = -1;
	err_jmp1 = &err_jmp0;
	what = "(?)";
	whatp = &what;
	if (nlhs == 2) {
		if (nrhs != 2)
			usage();
		x = sizechk(prhs[0],"x",n);
		t = sizechk(prhs[1],"0 or 1", 1);
		if (setjmp(err_jmp0.jb)) {
			sprintf(msgbuf, "Trouble evaluating %s\n", *whatp);
			mexErrMsgTxt(msgbuf);
			}
		if (t[0] == 0.) {
			f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
			c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL));
			what = "f";
			*f = n_obj > 0 ? objval(0, x, &nerror) : 0;
			what = "c";
			conval(x, c, &nerror);
			return;
			}
		g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
		J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, mxREAL));
		what = "g";
		if (n_obj > 0)
			objgrd(0, x, g, &nerror);
		else
			memset(g, 0, n*sizeof(real));
		if (nc) {
			what = "J";
			jacval(x, J1, &nerror);
			Ir = mxGetIr(plhs[1]);
			/*memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int));*/
			for(Jc = mxGetJc(plhs[1]), cs = A_colstarts, i = 0; i <= n; ++i)
				Jc[i] = cs[i];
			cgp = Cgrad;
			for(i = 0; i < nc; i++)
				for(cg = *cgp++; cg; cg = cg->next)
					Ir[cg->goff] = i;
			}
		return;
		}
	if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) {
		/* eval2('solution message', x, v): x = primal, v = dual */
		/* optional 4th arg = solve_result_num */
		if (!mxIsChar(prhs[0]))
			usage();
		x = sizechk(prhs[1],"x",n);
		v = sizechk(prhs[2],"v",nc);
		if (mxGetString(prhs[0], buf, sizeof(buf)))
			mexErrMsgTxt(
			 "Expected 'solution message' as first argument\n");
		solve_result_num = nrhs == 3 ? -1 /* unknown */
			: (int)*sizechk(prhs[3],"solve_result_num",1);
		write_sol(buf, x, v, 0);
		return;
		}
	if (nlhs != 1 || nrhs != 1)
		usage();
	v = sizechk(prhs[0],"v",nc);
	W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, mxREAL));

	what = "W";
	sphes(H = Hsp, 0, 0, v);

	/* Expand the Hessian lower triangle into the full Hessian... */

	Ir = mxGetIr(plhs[0]);
	Jc = mxGetJc(plhs[0]);
	hcs = sputinfo->hcolstarts;
	hr = sputinfo->hrownos;
	for(i = 0; i <= n; i++)
		Jc[i] = hcs[i];
	He = H + hcs[n];
	while(H < He) {
		*W++ = *H++;
		*Ir++ = *hr++;
		}
	}
Ejemplo n.º 7
0
Archivo: bb.c Proyecto: TheLoutre/nomad
int main ( int argc, char **argv ) {

  FILE * nl;
  char * stub;
  FILE * point_file;
  char * point_file_name;
  int    point_file_name_size;
  fint   nerror = (fint)0;
  int    n_badvals = 0;
  int    n_con_tmp = 0;
  int    i;
  real   f;
  real * R;

  if( argc < 2 ) {
    fprintf ( stderr , "Usage: %s x.txt\n" , argv[0] );
    return 1;
  }

  // get the point file name:
  point_file_name_size = strlen(argv[1]) + 1;
  point_file_name      = (char*)Malloc(point_file_name_size * sizeof(char));
  strcpy ( point_file_name , argv[1] );
  strcpy ( argv[1] , MODEL_NAME );

  // Read objectives and first derivative information.
  if( !(asl = ASL_alloc(ASL_read_fg)) ) exit(1);
  stub = getstub(&argv, &Oinfo);
  nl   = jac0dim(stub, (fint)strlen(stub));

  // Get command-line options.
  if (getopts(argv, &Oinfo)) exit(1);

  // Check command-line options.
  if( showgrad < 0 || showgrad > 1 ) {
    Printf("Invalid value for showgrad: %d\n", showgrad);
    n_badvals++;
  }
  if( showname < 0 || showname > 1 ) {
    Printf("Invalid value for showgrad: %d\n", showgrad);
    n_badvals++;
  }

  if(n_badvals) {
    Printf("Found %d errors in command-line options.\n", n_badvals);
    exit(1);
  }

  // Allocate memory for problem data.
  // The variables below must have precisely THESE names.
  X0    = (real*)Malloc(n_var * sizeof(real));  // Initial guess
  pi0   = (real*)Malloc(n_con * sizeof(real));  // Initial multipliers
  LUv   = (real*)Malloc(n_var * sizeof(real));  // Lower bounds on variables
  Uvx   = (real*)Malloc(n_var * sizeof(real));  // Upper bounds on variables
  LUrhs = (real*)Malloc(n_con * sizeof(real));  // Lower bounds on constraints
  Urhsx = (real*)Malloc(n_con * sizeof(real));  // Upper bounds on constraints
  R     = (real*)Malloc(n_con * sizeof(real));  // constraints

  want_xpi0 = 3;

  // Read in ASL structure - trap read errors
  if( fg_read(nl, 0) ) {
    fprintf(stderr, "Error fg-reading nl file\n");
    goto bailout;
  }

#ifdef DISPLAY

  n_con_tmp = 0;
  for ( i = 0 ; i < n_con ; ++i ) {
    if ( LUrhs[i] > -Infinity )
      ++n_con_tmp;
    if ( Urhsx[i] < Infinity )
      ++n_con_tmp;
  }

  printf ( "n_obj=%i\nn_var=%i\nn_con=%i\nx0=[" , n_obj , n_var , n_con_tmp );
  for ( i = 0 ; i < n_var ; ++i )
    printf ( "%g " , X0[i] );
  printf ( "]\n" );
#endif

  // read x:
  if ((point_file = fopen(point_file_name,"r")) == NULL) {
    fprintf(stderr, "Cannot open file %s.\n",point_file_name);
    goto bailout;
  }

  for ( i = 0 ; i < n_var ; ++i )
    fscanf ( point_file , "%lf" , &X0[i] );

  fclose(point_file);
  free ( point_file_name );


#ifdef DISPLAY
  printf ( "x =[" );
  for ( i = 0 ; i < n_var ; ++i )
    printf ( "%g " , X0[i] );
  printf ( "]\n" );
#endif

  // objective functions:
  for ( i = 0 ; i < n_obj ; ++i ) {
    f = objval ( i , X0 , &nerror ); 

    if ( nerror ) {
      fprintf(stderr, "Error while evaluating objective.\n");
      goto bailout;
    }

#ifdef DISPLAY
    Printf("f%i(x) = %21.15e\n", i , f );
#else
    Printf("%21.15e\n", f );
#endif
  }

  // constraints:
  conval ( X0 , R , &nerror );

  for ( i = 0 ; i < n_con ; ++i ) {

#ifdef DISPLAY
    printf ("%g <= %g <= %g\n" ,  LUrhs[i] , R[i] , Urhsx[i] );
#else
    if ( LUrhs[i] > -Infinity )
      Printf("%21.15e\n", LUrhs[i]-R[i] );
    if ( Urhsx[i] < Infinity )
      Printf("%21.15e\n", R[i]-Urhsx[i] );
#endif
  }

 bailout:
  // Free data structure. DO NOT use free() on X0, pi0, etc.
  ASL_free((ASL**)(&asl));

  return 0;
}
Ejemplo n.º 8
0
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;
	}
Ejemplo n.º 9
0
int main(int argc, char **argv) {

  FILE *nl;
  char *stub;
  fint nerror = (fint)0;
  int n_badvals = 0;
  real f;

  if( argc < 2 ) {
    fprintf(stderr, "Usage: %s stub\n", argv[0]);
    return 1;
  }

  // Read objectives and first derivative information.
  if( !(asl = ASL_alloc(ASL_read_fg)) ) exit(1);
  stub = getstub(&argv, &Oinfo);
  nl   = jac0dim(stub, (fint)strlen(stub));

  // Get command-line options.
  if (getopts(argv, &Oinfo)) exit(1);

  // Check command-line options.
  if( showgrad < 0 || showgrad > 1 ) {
    Printf("Invalid value for showgrad: %d\n", showgrad);
    n_badvals++;
  }
  if( showname < 0 || showname > 1 ) {
    Printf("Invalid value for showname: %d\n", showname);
    n_badvals++;
  }

  if(n_badvals) {
    Printf("Found %d errors in command-line options.\n", n_badvals);
    exit(1);
  }

  // Allocate memory for problem data.
  // The variables below must have precisely THESE names.
  X0    = (real*)Malloc(n_var * sizeof(real));  // Initial guess
  pi0   = (real*)Malloc(n_con * sizeof(real));  // Initial multipliers
  LUv   = (real*)Malloc(n_var * sizeof(real));  // Lower bounds on variables
  Uvx   = (real*)Malloc(n_var * sizeof(real));  // Upper bounds on variables
  LUrhs = (real*)Malloc(n_con * sizeof(real));  // Lower bounds on constraints
  Urhsx = (real*)Malloc(n_con * sizeof(real));  // Upper bounds on constraints
  want_xpi0 = 3;

  // Read in ASL structure - trap read errors
  if( fg_read(nl, 0) ) {
    fprintf(stderr, "Error fg-reading nl file\n");
    goto bailout;
  }

  if(showname) { // Display objective name if requested.
    Printf("Objective name: %s\n", obj_name(0));
  }

  // This "solver" outputs the objective function value at X0.
  f = objval(0, X0, &nerror);
  if(nerror) {
    fprintf(stderr, "Error while evaluating objective.\n");
    goto bailout;
  }
  Printf("f(x0) = %21.15e\n", f);

  // Optionally also output objective gradient at X0.
  if(showgrad) {
    real *g = (real*)malloc(n_var * sizeof(real));
    objgrd(0, X0, g, &nerror);
    Printf("g(x0) = [ ");
    for(int i=0; i<n_var; i++) Printf("%8.1e ", g[i]);
    Printf("]\n");
    free(g);
  }

  // Write solution to file. Here we just write the initial guess.
  Oinfo.wantsol = 9;  // Suppress message echo. Force .sol writing
  write_sol(CHR"And the winner is", X0, pi0, &Oinfo);

 bailout:
  // Free data structure. DO NOT use free() on X0, pi0, etc.
  ASL_free((ASL**)(&asl));

  return 0;
}
Ejemplo n.º 10
0
int main(int argc, char **argv)
{
	FILE *nl;
	char *stub;
	ASL *asl;
	fint nerror = 0;
	real *X;
	real objVal;
	int i, j, k, je;
	real* J;
	cgrad *cg;
	char *fmt;

	if (argc < 2) {
		printf("Usage: %s stub\n", argv[0]);
		return 1;
	}
	
	double t0 = clock_now();
	asl = ASL_alloc(ASL_read_fg);
	stub = argv[1];
	nl = jac0dim(stub, (fint)strlen(stub));
	fg_read(nl,0);
	
	J = (real *)Malloc(nzc*sizeof(real));
	X = (real *)Malloc(n_var*sizeof(real));
	for (i = 0; i < n_var; i++) X[i] = 1.0;

	// include one jacobian call for consistency
	jacval(X, J, &nerror);

	t0 = clock_now() - t0;
	
	//objVal = objval(0, X, &nerror);
	//printf("Objective %.5f\n", objVal);
	
	double jactime = 1e30;
	for (k = 0; k < 10; k++) {
		double t1 = clock_now();
		jacval(X, J, &nerror);
		t1 = clock_now() - t1;
		jactime = (t1 < jactime) ? t1 : jactime;
	}

	double norm = 0;
	for (i = 0; i < nzc; i++) {
		norm += J[i]*J[i];
	}
	norm = sqrt(norm);


	char *bname = basename(argv[1]);
	// Initialization time, 1 jacobian evaluation
	printf("### %s %f %g\n",bname,t0,jactime);
	printf("## %s Jacobian norm: %.10g (nnz = %d)\n",bname,norm,nzc);


	
	/*printf("nzc %d\n",nzc);
	for(i = 0; i < nzc; i++) {
		printf("%d %g\n",i,J[i]);
	}*/
	/*
	for(i = 0; i < n_con; i++) {
		printf("\nRow %d:", i+1);
		//fmt = " J[%d]=%g*X%d";
		//for(cg = Cgrad[i]; cg; cg = cg->next, fmt = " + J[%d]=%g*X%d") {
		//	printf(fmt, cg->goff, J[cg->goff], cg->varno+1);
		//}
		fmt = " %g*X%d";
		for(cg = Cgrad[i]; cg; cg = cg->next, fmt = " + %g*X%d") {
			printf(fmt, J[cg->goff], cg->varno+1);
		}
		printf("\n");
	}*/

	return 0;
}
Ejemplo n.º 11
0
 void
mexFunction(int nlhs, Matrix **plhs, int nrhs, Matrix **prhs)
{
	FILE *nl;
	char *buf1, buf[512], *what;
	static fint n, nc, nz;
	fint nerror;
	real *J1, *W, *c, *f, *g, *v, *t, *x;
	static real *J;
	cgrad *cg, **cgp;
	static size_t Jsize;
	Jmp_buf err_jmp0;
	ASL_pfgh *asl = (ASL_pfgh*)cur_ASL;
	static fint nhnz;
	static real *Hsp;
	real *H, *He;
	int *Ir, *Jc;
	fint *hcs, *hr, i;

	if (nrhs == 1 && mxIsString(prhs[0])) {
		if (nlhs != 6)
			usage();
		if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
			mexErrMsgTxt("Expected 'stub' as argument\n");
		at_end();
		mexAtExit(at_end);
		asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
		return_nofile = 1;
		if (!(nl = jac0dim(buf1,strlen(buf)))) {
			sprintf(msgbuf, "Can't open %.*s\n",
				sizeof(msgbuf)-20, buf);
			mexErrMsgTxt(msgbuf);
			}
		if (n_obj <= 0)
			printf("Warning: objectve == 0\n");
		n = n_var;
		nc = n_con;
		nz = nzc;
		J = (real *)M1alloc(nz*sizeof(real));
		X0 = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL));
		LUv = mxGetPr(plhs[1] = mxCreateFull(n, 1, REAL));
		Uvx = mxGetPr(plhs[2] = mxCreateFull(n, 1, REAL));
		pi0 = mxGetPr(plhs[3] = mxCreateFull(nc, 1, REAL));
		LUrhs = mxGetPr(plhs[4] = mxCreateFull(nc, 1, REAL));
		Urhsx = mxGetPr(plhs[5] = mxCreateFull(nc, 1, REAL));
		pfgh_read(nl, ASL_findgroups);
		Jsize = nc*n*sizeof(real);

		/* Arrange to compute the whole sparese Hessian */
		/* of the Lagrangian function (both triangles). */

		nhnz = sphsetup(0, 0, nc > 0, 0);
		Hsp = (real *)M1alloc(nhnz*sizeof(real));
		return;
		}

	if (!filename)
		mexErrMsgTxt("spamfunc(\"stub\") has not been called\n");
	nerror = -1;
	err_jmp1 = &err_jmp0;
	if (nlhs == 2) {
		if (nrhs != 2)
			usage();
		x = sizechk(prhs[0],"x",n);
		t = sizechk(prhs[1],"0 or 1", 1);
		if (t[0] == 0.) {
			f = mxGetPr(plhs[0] = mxCreateFull(1, 1, REAL));
			c = mxGetPr(plhs[1] = mxCreateFull(nc, 1, REAL));
			if (setjmp(err_jmp0.jb)) {
				sprintf(msgbuf, "Trouble evaluating %s\n",
					what);
				mexErrMsgTxt(msgbuf);
				}
			what = "f";
			*f = objval(0, x, &nerror);
			what = "c";
			conval(x, c, &nerror);
			return;
			}
		g = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL));
		J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, REAL));
		what = "g";
		objgrd(0, x, g, &nerror);
		if (nc) {
			what = "J";
			jacval(x, J1, &nerror);
			Ir = mxGetIr(plhs[1]);
			memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int));
			cgp = Cgrad;
			for(i = 0; i < nc; i++)
				for(cg = *cgp++; cg; cg = cg->next)
					Ir[cg->goff] = i;
			}
		return;
		}
	if (nlhs == 0 && nrhs == 3) {
		/* eval2('solution message', x, v): x = primal, v = dual */
		if (!mxIsString(prhs[0]))
			usage();
		x = sizechk(prhs[1],"x",n);
		v = sizechk(prhs[2],"v",nc);
		if (mxGetString(prhs[0], buf, sizeof(buf)))
			mexErrMsgTxt(
			 "Expected 'solution message' as first argument\n");
		write_sol(buf, x, v, 0);
		return;
		}
	if (nlhs != 1 || nrhs != 1)
		usage();
	v = sizechk(prhs[0],"v",nc);
	W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, REAL));

	what = "W";
	sphes(H = Hsp, 0, 0, v);

	/* Expand the Hessian lower triangle into the full Hessian... */

	Ir = mxGetIr(plhs[0]);
	Jc = mxGetJc(plhs[0]);
	hcs = sputinfo->hcolstarts;
	hr = sputinfo->hrownos;
	for(i = 0; i <= n; i++)
		Jc[i] = hcs[i];
	He = H + hcs[n];
	while(H < He) {
		*W++ = *H++;
		*Ir++ = *hr++;
		}
	}
Ejemplo n.º 12
0
	cgrad *cg, *cg0;
	ograd *og;
	real *b, *c, t;
	ASL *asl;

	dw = clen = rlen = 0;

	progname = *argv;
	if (argc < 2) {
 usage:
		fprintf(Stderr, "Usage: [-wnnn] %s stub\n\
	nnn = display width (overrides $display_width)\n", progname);
		return 1;
		}

	asl = ASL_alloc(ASL_read_f);
	stub = *++argv;
	if (*stub == '-')
		switch(stub[1]) {
		  case 'w':
			if (stub[2])
				stub += 2;
			else if (--argc < 2)
				goto usage;
			else
				stub = *++argv;
			dw = atoi(stub);
			if (--argc < 2)
				goto usage;
			stub = *++argv;
			break;
Ejemplo n.º 13
0
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;
    }
}
Ejemplo n.º 14
0
 void
mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
	FILE *nl;
	char *buf1, buf[512], *what, **whatp;
	static fint n, nc, nz;
	fint i, nerror;
	real *J1, *W, *c, *f, *g, *v, *t, *x;
	static real *J;
	cgrad *cg, **cgp, **cgpe;
	static size_t Jsize;
	Jmp_buf err_jmp0;
	ASL *asl = cur_ASL;
	static char ignore_complementarity[] =
		"Warning: ignoring %d complementarity conditions.\n";

	if (nrhs == 1 && mxIsChar(prhs[0])) {
		if (nlhs < 6 || nlhs > 7)
			usage();
		if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
			mexErrMsgTxt("Expected 'stub' as argument\n");
		at_end();
		mexAtExit(at_end);
		asl = ASL_alloc(ASL_read_pfgh);
		return_nofile = 1;
		if (!(nl = jac0dim(buf1,strlen(buf)))) {
			sprintf(msgbuf, "Can't open %.*s\n",
				sizeof(msgbuf)-20, buf);
			mexErrMsgTxt(msgbuf);
			}
		if (n_obj <= 0)
			printf("Warning: objectve == 0\n");
		n = n_var;
		nc = n_con;
		nz = nzc;
		J = (real *)M1alloc(nz*sizeof(real));
		X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
		LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL));
		Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL));
		pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL));
		if (nlhs == 7) {
			cvar = (int*)M1alloc(nc*sizeof(int));
			plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL);
			x = mxGetPr(plhs[6]);
			}
		else if (n_cc)
			printf(ignore_complementarity, n_cc);
		pfgh_read(nl, ASL_findgroups);
		Jsize = nc*n*sizeof(real);
		if (nlhs == 7)
			for(i = 0; i < nc; i++)
				x[i] = cvar[i];
		return;
		}

	if (!asl)
		mexErrMsgTxt("amplfunc(\"stub\") has not been called\n");
	nerror = -1;
	err_jmp1 = &err_jmp0;
	what = "(?)";
	whatp = &what;
	if (nlhs == 2) {
		if (nrhs != 2)
			usage();
		x = sizechk(prhs[0],"x",n);
		t = sizechk(prhs[1],"0 or 1", 1);
		if (setjmp(err_jmp0.jb)) {
			sprintf(msgbuf, "Trouble evaluating %s\n", *whatp);
			mexErrMsgTxt(msgbuf);
			}
		if (t[0] == 0.) {
			f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
			c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL));
			what = "f";
			*f = objval(0, x, &nerror);
			what = "c";
			conval(x, c, &nerror);
			return;
			}
		g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
		J1 = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, n, mxREAL));
		what = "g";
		objgrd(0, x, g, &nerror);
		if (nc) {
			memset(J1, 0, Jsize);
			what = "J";
			jacval(x, J, &nerror);
			cgp = Cgrad;
			for(cgpe = cgp + nc; cgp < cgpe; J1++)
				for(cg = *cgp++; cg; cg = cg->next)
					J1[nc*cg->varno] = J[cg->goff];
			}
		return;
		}
	if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) {
		/* eval2('solution message', x, v): x = primal, v = dual */
		/* optional 4th arg = solve_result_num */
		if (!mxIsChar(prhs[0]))
			usage();
		x = sizechk(prhs[1],"x",n);
		v = sizechk(prhs[2],"v",nc);
		if (mxGetString(prhs[0], buf, sizeof(buf)))
			mexErrMsgTxt(
			 "Expected 'solution message' as first argument\n");
		solve_result_num = nrhs == 3 ? -1 /* unknown */
			: (int)*sizechk(prhs[3],"solve_result_num",1);
		write_sol(buf, x, v, 0);
		return;
		}
	if (nlhs != 1 || nrhs != 1)
		usage();
	v = sizechk(prhs[0],"v",nc);
	W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, n, mxREAL));

	what = "W";
	fullhes(W, n, 0, 0, v);
	}