/*--------------------------------------------------------------------------*/
int sci_qp_solve(char *fname, unsigned long fname_len)
{
SciErr sciErr;
static int un = 1, deux = 2;
// n : first dimension of Q
// nbis : second dimension of Q (nbis is expected to be equal to n)
static int n = 0, nbis = 0;
static int unbis = 0;
static int m = 0, next = 0;
static int mbis = 0;
static int pipo = 0;
static int nact = 0;
int r = 0;
static int lw = 0, k = 0;
static SciSparse Sp;
static int issparse = 0;
double *work = NULL;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr4 = NULL;
int* piAddr5 = NULL;
double* Q = NULL;
double* C = NULL;
double* p = NULL;
double* b = NULL;
int* me = NULL;
double* x = NULL;
int* iact = NULL;
int* iter = NULL;
double* crval = NULL;
int *ierr = NULL;
/* Check rhs and lhs */
CheckInputArgument(pvApiCtx, 5, 5) ;
CheckOutputArgument(pvApiCtx, 1, 5) ;
/*Warning this interface does not support arguments passed by reference */
/* RhsVar: qp_solve(Q,p,C,b,me) */
/* 1,2,3,4,5 */
next = nbInputArgument(pvApiCtx) + 1;
/* Variable 1 (Q) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &n, &nbis, &Q);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
//CheckSquare
if (n != nbis)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A square matrix expected.\n"), fname, 1);
return 1;
}
/* Variable 2 (p) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &nbis, &unbis, &p);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
//CheckLength
if (nbis * unbis != n)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 2, nbis * unbis);
return 1;
}
/* Variable 3 (C) */
issparse = (checkInputArgumentType(pvApiCtx, 3, 5));
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (!issparse)
{
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &nbis, &m, &C);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
}
else
{
if (isVarComplex(pvApiCtx, piAddr3))
{
Sp.it = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr3, &(Sp.m), &(Sp.n), &(Sp.nel), &(Sp.mnel), &(Sp.icol), &(Sp.R), &(Sp.I));
}
else
{
Sp.it = 0;
sciErr = getSparseMatrix(pvApiCtx, piAddr3, &(Sp.m), &(Sp.n), &(Sp.nel), &(Sp.mnel), &(Sp.icol), &(Sp.R));
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
nbis = Sp.m;
m = Sp.n;
}
if ( nbis != n ) // car C est passee en transposee dans la macro qpsolve
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d column(s) expected for matrix %s.\n"), fname, 3, n, "C");
return 0;
}
/* Variable 4 (b) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddr4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr4, &mbis, &unbis, &b);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 4);
printError(&sciErr, 0);
return 1;
}
//CheckLength
if (mbis * unbis != m)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 4, mbis * unbis);
return 1;
}
/* Variable 5 (me) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddr5);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 5.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddr5, &pipo, &unbis, &me);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 5);
printError(&sciErr, 0);
return 1;
}
//CheckScalar
if (pipo != 1 || unbis != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 5);
return 1;
}
if ((*(me) < 0) || (*(me) > n))
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be an integer in the range 0 to %d.\n"), fname, 5, "me", n);
return 0;
}
/* nbOutputArgument(pvApiCtx) variables: x, iact, iter, crval */
next = Rhs;
sciErr = allocMatrixOfDouble(pvApiCtx, next + 1, n, un, &x);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, next + 2, m, un, &iact);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, next + 3, deux, un, &iter);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDouble(pvApiCtx, next + 4, un, un, &crval);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, next + 5, un, un, &ierr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
r = Min(n, m);
lw = 2 * n + r * (r + 5) / 2 + 2 * m + 1;
if ((work = (double *)MALLOC(lw * sizeof(double))) == NULL)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 1;
}
/* change the sign of C and b.*/
*ierr = 0;
if (!issparse)
{
/* linear constraints matrix is stored full */
C2F(qpgen2)((Q), (p), &n, &n, (x), (crval), (C),
(b), &n, &m, (me), (iact), &nact, (iter), work,
(ierr));
}
else
{
/* linear constraints matrix is a sparse matrix */
/* Change the linear constraints matrix representation:
qpgen1sci requires column-compressed sparse matrix internal
representation while Scilab sparse matrices are row-compressed */
double *R = NULL, *I = NULL;
int *ind = NULL;
if ((R = (double *)MALLOC(Sp.nel * sizeof(double))) == NULL)
{
FREE(work);
work = NULL;
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 1;
}
if ((ind = (int *)MALLOC((m + Sp.nel) * sizeof(int))) == NULL)
{
FREE(work);
work = NULL;
FREE(R);
R = NULL;
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 1;
}
// Transpose the sparse matrix A
C2F(spt)(&n, &m, &(Sp.nel) , &(Sp.it), (int *)work,
Sp.R, Sp.I, Sp.mnel, Sp.icol, R, I, ind, ind + m);
C2F(qpgen1sci)((Q), (p), &n, &n, (x), (crval),
ind, ind + m, R,
(b), &m, (me), (iact), &nact, (iter),
work, (ierr));
FREE(work);
work = NULL;
FREE(R);
R = NULL;
FREE(ind);
ind = NULL;
}
for (k = nact; k < m; k++)
{
(iact)[k] = 0;
}
/* LhsVar: [x, iact, iter, f] = qp_solve(...) */
if (Lhs != 5)
{
if (*ierr == 0)
{
for (k = 0; k < Lhs; k++)
{
AssignOutputVariable(pvApiCtx, 1 + k) = next + 1 + k;
}
ReturnArguments(pvApiCtx);
}
else if (*ierr == 1)
{
Scierror(999, _("%s: The minimization problem has no solution.\n"), fname);
}
else if (*ierr == 2)
{
Scierror(999, _("%s: Q is not symmetric positive definite.\n"), fname);
}
}
else
{
for (k = 0; k < Lhs; k++)
{
AssignOutputVariable(pvApiCtx, 1 + k) = next + 1 + k;
}
if (*ierr == 1)
{
if (getWarningMode())
{
sciprint(_("\n%s: Warning: The minimization problem has no solution. The results may be inaccurate.\n\n"), fname);
}
}
else if (*ierr == 2)
{
if (getWarningMode())
{
sciprint(_("\n%s: Warning: Q is not symmetric positive definite. The results may be inaccurate.\n\n"), fname);
}
}
ReturnArguments(pvApiCtx);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_gsort(char *fname, unsigned long fname_len)
{
char iord[2];
char typex[10];
SciIntMat Im;
int Type = 0;
char **S = NULL;
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
int m3 = 0, n3 = 0, l3 = 0;
int ind_m1 = 0, ind_n1 = 0;
int *indices = NULL;
int iflag = 0;
int i;
iord[0] = DECREASE_COMMAND;
iord[1] = '\0';
typex[0] = GLOBAL_SORT;
typex[1] = '\0';
Rhs = Max(0, Rhs);
CheckRhs(1, 3);
CheckLhs(1, 2);
if (Rhs >= 1)
{
Type = VarType(1);
switch (Type)
{
case sci_strings:
GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &S);
break;
case sci_matrix:
{
#define COMPLEX 1
int *header = NULL;
int Cmplx = 0;
header = (int *)GetData(1);
Cmplx = header[3];
if (Cmplx == COMPLEX)
{
return gsort_complex(fname, typex, iord);
}
else
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ((m1 * n1) == 0) /* [] returns [] */
{
int m = 0, n = 0, l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
LhsVar(2) = Rhs + 2;
}
PutLhsVar();
return 0;
}
}
}
break;
case sci_ints:
GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &Im);
break;
case sci_sparse:
default:
OverLoad(1);
return 0;
break;
}
}
if (Rhs == 3)
{
int* piAddr = NULL;
char* pstData = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstData))
{
return 1;
}
if (strcmp(pstData, "i") && strcmp(pstData, "d"))
{
if (getWarningMode())
{
sciprint(_("WARNING: %s\n"), _("This usage of the third argument of gsort is obsolete."));
sciprint(_("WARNING: %s\n"), _("It will no more be available in Scilab 6."));
sciprint(_("WARNING: %s\n"), _("Please use 'd' or 'i' instead."));
}
}
iord[0] = pstData[0];
freeAllocatedSingleString(pstData);
}
if (Rhs >= 2)
{
int* piAddr = NULL;
char* pstData = NULL;
SciErr sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstData))
{
return 1;
}
if ((pstData[0] != ROW_SORT) && (pstData[0] != COLUMN_SORT) && (pstData[0] != GLOBAL_SORT) && (pstData[0] != LIST_SORT))
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s', '%s' or '%s' expected.\n"), fname, 2, "r", "c", "g", "lr", "lc");
return 1;
}
if (strcmp(pstData, "c") && strcmp(pstData, "r") && strcmp(pstData, "g") && strcmp(pstData, "lc") && strcmp(pstData, "lr"))
{
if (getWarningMode())
{
sciprint(_("WARNING: %s\n"), _("This usage of the second argument of gsort is obsolete."));
sciprint(_("WARNING: %s\n"), _("It will no more be available in Scilab 6."));
sciprint(_("WARNING: %s\n"), _("Please use 'r', 'c', 'g', 'lr' or 'lc' instead."));
}
}
strcpy(typex, pstData);
freeAllocatedSingleString(pstData);
}
if (typex[0] == LIST_SORT)
{
if (typex[1] == ROW_SORT)
{
ind_m1 = m1;
ind_n1 = 1;
if (ind_m1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_m1)); /* Only return in row */
}
}
else if (typex[1] == COLUMN_SORT)
{
ind_m1 = 1;
ind_n1 = n1;
if (ind_n1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_n1)); /*Only return in col */
}
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d.\n"), fname, 2);
return 0;
}
}
else
{
ind_m1 = m1;
ind_n1 = n1;
if (ind_m1 * ind_n1 != 0)
{
indices = (int *)MALLOC(sizeof(int) * (ind_m1 * ind_n1)); /* return a matrix */
}
}
if (Lhs == 2)
{
iflag = 1;
}
else
{
iflag = 0;
}
switch (Type)
{
case sci_matrix:
{
if (m1 * n1 != 0)
{
int lr;
double *matrix = stk(l1);
double *tmp_matrix = NULL;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
tmp_matrix = stk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortd) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
}
break;
case sci_ints:
{
int lr;
lr = Im.it;
/* next CreateVar and corresponding copy not needed if arg1 is not passed by reference */
if (!CreateVarNoCheck(Rhs + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &lr))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
switch (Im.it) /* Type defined in stack-c.h */
{
case I_CHAR:
{
char *matrix = Im.D;
char *tmp_matrix = (char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT32:
{
int *matrix = Im.D;
int *tmp_matrix = istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UCHAR:
{
unsigned char *matrix = Im.D;
unsigned char *tmp_matrix = (unsigned char *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortuchar) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_INT16:
{
short *matrix = Im.D;
short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortshort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT16:
{
unsigned short *matrix = Im.D;
unsigned short *tmp_matrix = (short *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortushort) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
case I_UINT32:
{
unsigned int *matrix = Im.D;
unsigned int *tmp_matrix = (unsigned int *)istk(lr);
for (i = 0; i < m1 * n1; i++)
{
tmp_matrix[i] = matrix[i];
}
C2F(gsortuint) (tmp_matrix, indices, &iflag, &m1, &n1, typex, iord);
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d: Unknown type.\n"), fname, 1);
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
PutLhsVar();
}
break;
case sci_strings:
{
C2F(gsorts) (S, indices, &iflag, &m1, &n1, typex, iord);
if (!CreateVarFromPtrNoCheck(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, S))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(1) = Rhs + 1;
if (Lhs == 2)
{
if (!CreateVarFromPtrNoCheck(Rhs + 2, MATRIX_OF_INTEGER_DATATYPE, &ind_m1, &ind_n1, &indices))
{
if (indices)
{
FREE(indices);
indices = NULL;
}
return 0;
}
LhsVar(2) = Rhs + 2;
}
if (indices)
{
FREE(indices);
indices = NULL;
}
freeArrayOfString(S, m1 * n1);
PutLhsVar();
}
break;
default:
if (indices)
{
FREE(indices);
indices = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
return 0;
break;
}
return 0;
}
