/*--------------------------------------------------------------------------*/ 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; }