dd_MatrixPtr FromEigen (const cref_matrix_t& input)
{
if (dd_debug)
{
std::cout << "from eigen input " << input << std::endl;
}
dd_debug = false;
dd_MatrixPtr M=NULL;
dd_rowrange i;
dd_colrange j;
dd_rowrange m_input = (dd_rowrange)(input.rows());
dd_colrange d_input = (dd_colrange)(7);
dd_RepresentationType rep=dd_Generator;
mytype value;
dd_NumberType NT = dd_Real;;
dd_init(value);
M=dd_CreateMatrix(m_input, d_input);
M->representation=rep;
M->numbtype=NT;
for (i = 1; i <= input.rows(); i++)
{
dd_set_d(value, 0);
dd_set(M->matrix[i-1][0],value);
for (j = 2; j <= d_input; j++)
{
dd_set_d(value, input(i-1,j-2));
dd_set(M->matrix[i-1][j-1],value);
}
}
dd_clear(value);
return M;
}
void allvertices(int m_input, int d_input, double *a_input)
/* output vertices and incidences */
{
dd_PolyhedraPtr poly;
dd_MatrixPtr A=NULL,G=NULL;
dd_SetFamilyPtr GI=NULL;
dd_rowrange i,m;
dd_colrange j,d;
dd_ErrorType err;
m=(dd_rowrange)m_input; d=(dd_colrange)d_input;
A=dd_CreateMatrix(m,d);
for (i=0; i<m; i++){
for (j=0; j<d; j++) dd_set_d(A->matrix[i][j],a_input[i*d+j]);
}
A->representation=dd_Inequality;
poly=dd_DDMatrix2Poly(A, &err);
/* compute the second (generator) representation */
if (err==dd_NoError) {
G=dd_CopyGenerators(poly);
GI=dd_CopyIncidence(poly);
MLPutFunction(stdlink,"List",2);
dd_MLWriteMatrix(G);
dd_MLWriteSetFamily(GI);
} else {
dd_MLWriteError(poly);
}
dd_FreeMatrix(A);
dd_FreeMatrix(G);
dd_FreeSetFamily(GI);
}
void allfacets(int n_input, int d_input, double *g_input)
/* output facets and incidences */
{
dd_PolyhedraPtr poly;
dd_MatrixPtr A=NULL,G=NULL;
dd_SetFamilyPtr AI=NULL;
dd_rowrange i,n;
dd_colrange j,d;
dd_ErrorType err;
n=(dd_rowrange)n_input; d=(dd_colrange)d_input;
G=dd_CreateMatrix(n,d);
for (i=0; i<n; i++){
for (j=0; j<d; j++) dd_set_d(G->matrix[i][j],g_input[i*d+j]);
}
G->representation=dd_Generator;
poly=dd_DDMatrix2Poly(G, &err);
/* compute the second (inequality) representation */
if (err==dd_NoError){
A=dd_CopyInequalities(poly);
AI=dd_CopyIncidence(poly);
MLPutFunction(stdlink,"List",2);
dd_MLWriteMatrix(A);
dd_MLWriteSetFamily(AI);
} else {
dd_MLWriteError(poly);
}
dd_FreeMatrix(A);
dd_FreeMatrix(G);
dd_FreeSetFamily(AI);
}
/*
* Helper function to generate a matrix from init_vals
*/
static dd_MatrixPtr init_matrix(const double *init_vals, int rows,
int cols)
{
dd_MatrixPtr m = dd_CreateMatrix(rows, cols);
dd_rowrange i;
dd_colrange j;
/* Fill values */
for (i = 0; i < m->rowsize; i++) {
for (j = 0; j < m->colsize; j++) {
dd_set_d(m->matrix[i][j], init_vals[m->colsize * i + j]);
}
}
return m;
}
dd_MatrixPtr FT_get_H_MatrixPtr(const mxArray * in)
{
mxArray * tmpa;
mxArray * tmpb;
mxArray * tmpl;
dd_MatrixPtr A;
int eqsize, m, n, i, j;
double * a;
double * b;
double * lin;
if ((tmpa = mxGetField(in, 0, "A")) &&
(tmpb = mxGetField(in, 0, "B")) &&
(mxGetNumberOfDimensions(tmpa) == 2) && /* A must be a matrix */
(mxGetNumberOfDimensions(tmpb) == 2) && /* B must be a matrix */
(mxGetM(tmpa) == mxGetM(tmpb)) && /* Dimension must be compatible */
(mxGetN(tmpb) == 1)) { /* B must be a column vector */
m = mxGetM(tmpa);
n = mxGetN(tmpa) + 1; /* Create [b, -A] */
a = mxGetPr(tmpa);
b = mxGetPr(tmpb);
A = dd_CreateMatrix(m, n);
for (i = 0; i < m; i++) {
dd_set_d(A->matrix[i][0],b[i]); /* A[i,0] <- b[i] */
for (j = 0; j < n - 1; j++) {
dd_set_d(A->matrix[i][j + 1],- a[j * m + i]); /* A[i,j+1] <- a[i,j] */
}
}
A->representation = dd_Inequality;
A->numbtype = dd_Real;
/* set lineality if present */
if ((tmpl = mxGetField(in, 0, "lin")) &&
(mxGetNumberOfDimensions(tmpl) <= 2) &&
(mxGetM(tmpl) == 1)) {
lin = mxGetPr(tmpl);
eqsize = mxGetN(tmpl);
for (i = 0; i < eqsize; i++) {
if (lin[i] <= (double) m)
set_addelem(A->linset,(long) lin[i]); /* linset uses 1-based */
else
mexWarnMsgTxt("Error in the lineality vector ");
}
}
return A;
} else {
return 0;
}
}
dd_MatrixPtr FT_get_V_MatrixPtr(const mxArray * in)
{
mxArray * tmpv;
mxArray * tmpr;
dd_MatrixPtr V;
int mr, m, n, i, j;
double * v;
double * r;
if ((tmpv = mxGetField(in, 0, "V")) &&
(mxGetNumberOfDimensions(tmpv) <= 2)) {
if ((tmpr = mxGetField(in, 0, "R")) &&
(mxGetNumberOfDimensions(tmpv) <= 2)) {
mr = mxGetM(tmpr);
r = mxGetPr(tmpr);
} else mr = 0;
m = mxGetM(tmpv);
n = mxGetN(tmpv) + 1;
v = mxGetPr(tmpv);
V = dd_CreateMatrix(m + mr, n);
for (i = 0; i < m; i++) {
dd_set_si(V->matrix[i][0],1);
for (j = 0; j < n - 1; j++) {
dd_set_d(V->matrix[i][j + 1], v[i + j * m]);
}
}
for (i = m; i < m + mr; i++) {
dd_set_si(V->matrix[i][0],0);
for (j = 0; j < n - 1; j++) {
dd_set_d(V->matrix[i][j + 1], r[(i - m) + j * mr]);
}
}
V->representation = dd_Generator;
V->numbtype = dd_Real;
return V;
}
return 0;
}
/*
* Create a dd_MatrixPtr, filled with values from init_vals.
* length of init_vals must be rows*cols in row-major order
*
* This function adds a constraint: x > 0
*
* Caller must free returned matrix.
*/
static dd_MatrixPtr init_ineq_doubles(const double *init_vals,
const size_t rows, const size_t cols,
const float lower_bound,
const float upper_bound)
{
/* Only 3-column inputs supported */
assert(cols == 3);
dd_MatrixPtr m = dd_CreateMatrix(rows + 2, cols);
dd_rowrange i;
dd_colrange j;
/* Fill values */
for (i = 0; i < rows; i++) {
for (j = 0; j < m->colsize; j++) {
dd_set_d(m->matrix[i][j], init_vals[m->colsize * i + j]);
}
}
/* Add a row constraining solution space x >= lower_bound */
dd_set_d(m->matrix[rows][0], -lower_bound); /* intercept */
dd_set_d(m->matrix[rows][1], 1); /* coef of x */
dd_set_d(m->matrix[rows][2], 0); /* coef of y */
/* Add a row constraining solution space x <= upper_bound */
dd_set_d(m->matrix[rows + 1][0], upper_bound); /* intercept */
dd_set_d(m->matrix[rows + 1][1], -1); /* coef of x */
dd_set_d(m->matrix[rows + 1][2], 0); /* coef of y */
/* Mark the representation as inequalities */
m->representation = dd_Inequality;
/* Input types = reals */
m->numbtype = dd_Real;
return m;
}
SEXP redundant(SEXP m, SEXP h)
{
GetRNGstate();
if (! isString(m))
error("'m' must be character");
if (! isMatrix(m))
error("'m' must be matrix");
if (! isLogical(h))
error("'h' must be logical");
if (LENGTH(h) != 1)
error("'h' must be scalar");
SEXP m_dim;
PROTECT(m_dim = getAttrib(m, R_DimSymbol));
int nrow = INTEGER(m_dim)[0];
int ncol = INTEGER(m_dim)[1];
UNPROTECT(1);
#ifdef WOOF
printf("nrow = %d\n", nrow);
printf("ncol = %d\n", ncol);
#endif /* WOOF */
if (nrow < 2)
error("less than 2 rows, cannot be redundant");
if (ncol <= 2)
error("no cols in m[ , - c(1, 2)]");
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column one of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column one of 'm' not zero-or-one valued");
}
if (! LOGICAL(h)[0])
for (int i = nrow; i < 2 * nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column two of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column two of 'm' not zero-or-one valued");
}
dd_set_global_constants();
/* note actual type of "value" is mpq_t (defined in cddmp.h) */
mytype value;
dd_init(value);
dd_MatrixPtr mf = dd_CreateMatrix(nrow, ncol - 1);
/* note our matrix has one more column than Fukuda's */
/* representation */
if(LOGICAL(h)[0])
mf->representation = dd_Inequality;
else
mf->representation = dd_Generator;
mf->numbtype = dd_Rational;
/* linearity */
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (foo[0] == '1')
set_addelem(mf->linset, i + 1);
/* note conversion from zero-origin to one-origin indexing */
}
/* matrix */
for (int j = 1, k = nrow; j < ncol; j++)
for (int i = 0; i < nrow; i++, k++) {
const char *rat_str = CHAR(STRING_ELT(m, k));
if (mpq_set_str(value, rat_str, 10) == -1)
ERROR_WITH_CLEANUP_3("error converting string to GMP rational");
mpq_canonicalize(value);
dd_set(mf->matrix[i][j - 1], value);
/* note our matrix has one more column than Fukuda's */
}
dd_rowset impl_linset, redset;
dd_rowindex newpos;
dd_ErrorType err = dd_NoError;
dd_MatrixCanonicalize(&mf, &impl_linset, &redset, &newpos, &err);
if (err != dd_NoError) {
rr_WriteErrorMessages(err);
ERROR_WITH_CLEANUP_6("failed");
}
int mrow = mf->rowsize;
int mcol = mf->colsize;
if (mcol + 1 != ncol)
ERROR_WITH_CLEANUP_6("Cannot happen! computed matrix has"
" wrong number of columns");
#ifdef WOOF
printf("mrow = %d\n", mrow);
printf("mcol = %d\n", mcol);
#endif /* WOOF */
SEXP bar;
PROTECT(bar = allocMatrix(STRSXP, mrow, ncol));
/* linearity output */
for (int i = 0; i < mrow; i++)
if (set_member(i + 1, mf->linset))
SET_STRING_ELT(bar, i, mkChar("1"));
else
SET_STRING_ELT(bar, i, mkChar("0"));
/* note conversion from zero-origin to one-origin indexing */
/* matrix output */
for (int j = 1, k = mrow; j < ncol; j++)
for (int i = 0; i < mrow; i++, k++) {
dd_set(value, mf->matrix[i][j - 1]);
/* note our matrix has one more column than Fukuda's */
char *zstr = NULL;
zstr = mpq_get_str(zstr, 10, value);
SET_STRING_ELT(bar, k, mkChar(zstr));
free(zstr);
}
if (mf->representation == dd_Inequality) {
SEXP attr_name, attr_value;
PROTECT(attr_name = ScalarString(mkChar("representation")));
PROTECT(attr_value = ScalarString(mkChar("H")));
setAttrib(bar, attr_name, attr_value);
UNPROTECT(2);
}
if (mf->representation == dd_Generator) {
SEXP attr_name, attr_value;
PROTECT(attr_name = ScalarString(mkChar("representation")));
PROTECT(attr_value = ScalarString(mkChar("V")));
setAttrib(bar, attr_name, attr_value);
UNPROTECT(2);
}
int impl_size = set_card(impl_linset);
int red_size = set_card(redset);
int nresult = 1;
int iresult = 1;
SEXP baz = NULL;
if (impl_size > 0) {
PROTECT(baz = rr_set_fwrite(impl_linset));
nresult++;
}
SEXP qux = NULL;
if (red_size > 0) {
PROTECT(qux = rr_set_fwrite(redset));
nresult++;
}
SEXP fred = NULL;
{
PROTECT(fred = allocVector(INTSXP, nrow));
for (int i = 1; i <= nrow; i++)
INTEGER(fred)[i - 1] = newpos[i];
nresult++;
}
#ifdef WOOF
fprintf(stderr, "impl_size = %d\n", impl_size);
fprintf(stderr, "red_size = %d\n", red_size);
fprintf(stderr, "nresult = %d\n", nresult);
if (baz)
fprintf(stderr, "LENGTH(baz) = %d\n", LENGTH(baz));
if (qux)
fprintf(stderr, "LENGTH(qux) = %d\n", LENGTH(qux));
#endif /* WOOF */
SEXP result, resultnames;
PROTECT(result = allocVector(VECSXP, nresult));
PROTECT(resultnames = allocVector(STRSXP, nresult));
SET_STRING_ELT(resultnames, 0, mkChar("output"));
SET_VECTOR_ELT(result, 0, bar);
if (baz) {
SET_STRING_ELT(resultnames, iresult, mkChar("implied.linearity"));
SET_VECTOR_ELT(result, iresult, baz);
iresult++;
}
if (qux) {
SET_STRING_ELT(resultnames, iresult, mkChar("redundant"));
SET_VECTOR_ELT(result, iresult, qux);
iresult++;
}
{
SET_STRING_ELT(resultnames, iresult, mkChar("new.position"));
SET_VECTOR_ELT(result, iresult, fred);
iresult++;
}
namesgets(result, resultnames);
set_free(redset);
set_free(impl_linset);
free(newpos);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
PutRNGstate();
UNPROTECT(nresult + 2);
return result;
}
SEXP allfaces(SEXP hrep)
{
GetRNGstate();
if (! isMatrix(hrep))
error("'hrep' must be matrix");
if (! isString(hrep))
error("'hrep' must be character");
SEXP hrep_dim;
PROTECT(hrep_dim = getAttrib(hrep, R_DimSymbol));
int nrow = INTEGER(hrep_dim)[0];
int ncol = INTEGER(hrep_dim)[1];
UNPROTECT(1);
if (nrow <= 0)
error("no rows in 'hrep'");
if (ncol <= 3)
error("three or fewer cols in hrep");
for (int i = 0; i < nrow; ++i) {
const char *foo = CHAR(STRING_ELT(hrep, i));
if (strlen(foo) != 1)
error("column one of 'hrep' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column one of 'hrep' not zero-or-one valued");
}
dd_set_global_constants();
/* note actual type of "value" is mpq_t (defined in cddmp.h) */
mytype value;
dd_init(value);
dd_MatrixPtr mf = dd_CreateMatrix(nrow, ncol - 1);
/* note our matrix has one more column than Fukuda's */
mf->representation = dd_Inequality;
mf->numbtype = dd_Rational;
/* linearity */
for (int i = 0; i < nrow; ++i) {
const char *foo = CHAR(STRING_ELT(hrep, i));
if (foo[0] == '1')
set_addelem(mf->linset, i + 1);
/* note conversion from zero-origin to one-origin indexing */
}
/* matrix */
for (int j = 1, k = nrow; j < ncol; ++j)
for (int i = 0; i < nrow; ++i, ++k) {
const char *rat_str = CHAR(STRING_ELT(hrep, k));
if (mpq_set_str(value, rat_str, 10) == -1) {
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("error converting string to GMP rational");
}
mpq_canonicalize(value);
dd_set(mf->matrix[i][j - 1], value);
/* note our matrix has one more column than Fukuda's */
}
SEXP result;
PROTECT(result = FaceEnum(mf));
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
if (result == R_NilValue)
error("failed");
PutRNGstate();
UNPROTECT(1);
return result;
}
dd_MatrixPtr dd_BlockElimination(dd_MatrixPtr M, dd_colset delset, dd_ErrorType *error)
/* Eliminate the variables (columns) delset by
the Block Elimination with dd_DoubleDescription algorithm.
Given (where y is to be eliminated):
c1 + A1 x + B1 y >= 0
c2 + A2 x + B2 y = 0
1. First construct the dual system: z1^T B1 + z2^T B2 = 0, z1 >= 0.
2. Compute the generators of the dual.
3. Then take the linear combination of the original system with each generator.
4. Remove redundant inequalies.
*/
{
dd_MatrixPtr Mdual=NULL, Mproj=NULL, Gdual=NULL;
dd_rowrange i,h,m,mproj,mdual,linsize;
dd_colrange j,k,d,dproj,ddual,delsize;
dd_colindex delindex;
mytype temp,prod;
dd_PolyhedraPtr dualpoly;
dd_ErrorType err=dd_NoError;
dd_boolean localdebug=dd_FALSE;
*error=dd_NoError;
m= M->rowsize;
d= M->colsize;
delindex=(long*)calloc(d+1,sizeof(long));
dd_init(temp);
dd_init(prod);
k=0; delsize=0;
for (j=1; j<=d; j++){
if (set_member(j, delset)){
k++; delsize++;
delindex[k]=j; /* stores the kth deletion column index */
}
}
if (localdebug) dd_WriteMatrix(stdout, M);
linsize=set_card(M->linset);
ddual=m+1;
mdual=delsize + m - linsize; /* #equalitions + dimension of z1 */
/* setup the dual matrix */
Mdual=dd_CreateMatrix(mdual, ddual);
Mdual->representation=dd_Inequality;
for (i = 1; i <= delsize; i++){
set_addelem(Mdual->linset,i); /* equality */
for (j = 1; j <= m; j++) {
dd_set(Mdual->matrix[i-1][j], M->matrix[j-1][delindex[i]-1]);
}
}
k=0;
for (i = 1; i <= m; i++){
if (!set_member(i, M->linset)){
/* set nonnegativity for the dual variable associated with
each non-linearity inequality. */
k++;
dd_set(Mdual->matrix[delsize+k-1][i], dd_one);
}
}
/* 2. Compute the generators of the dual system. */
dualpoly=dd_DDMatrix2Poly(Mdual, &err);
Gdual=dd_CopyGenerators(dualpoly);
/* 3. Take the linear combination of the original system with each generator. */
dproj=d-delsize;
mproj=Gdual->rowsize;
Mproj=dd_CreateMatrix(mproj, dproj);
Mproj->representation=dd_Inequality;
set_copy(Mproj->linset, Gdual->linset);
for (i=1; i<=mproj; i++){
k=0;
for (j=1; j<=d; j++){
if (!set_member(j, delset)){
k++; /* new index of the variable x_j */
dd_set(prod, dd_purezero);
for (h = 1; h <= m; h++){
dd_mul(temp,M->matrix[h-1][j-1],Gdual->matrix[i-1][h]);
dd_add(prod,prod,temp);
}
dd_set(Mproj->matrix[i-1][k-1],prod);
}
}
}
if (localdebug) printf("Size of the projection system: %ld x %ld\n", mproj, dproj);
dd_FreePolyhedra(dualpoly);
free(delindex);
dd_clear(temp);
dd_clear(prod);
dd_FreeMatrix(Mdual);
dd_FreeMatrix(Gdual);
return Mproj;
}
dd_MatrixPtr dd_FourierElimination(dd_MatrixPtr M,dd_ErrorType *error)
/* Eliminate the last variable (column) from the given H-matrix using
the standard Fourier Elimination.
*/
{
dd_MatrixPtr Mnew=NULL;
dd_rowrange i,inew,ip,in,iz,m,mpos=0,mneg=0,mzero=0,mnew;
dd_colrange j,d,dnew;
dd_rowindex posrowindex, negrowindex,zerorowindex;
mytype temp1,temp2;
dd_boolean localdebug=dd_FALSE;
*error=dd_NoError;
m= M->rowsize;
d= M->colsize;
if (d<=1){
*error=dd_ColIndexOutOfRange;
if (localdebug) {
printf("The number of column is too small: %ld for Fourier's Elimination.\n",d);
}
goto _L99;
}
if (M->representation==dd_Generator){
*error=dd_NotAvailForV;
if (localdebug) {
printf("Fourier's Elimination cannot be applied to a V-polyhedron.\n");
}
goto _L99;
}
if (set_card(M->linset)>0){
*error=dd_CannotHandleLinearity;
if (localdebug) {
printf("The Fourier Elimination function does not handle equality in this version.\n");
}
goto _L99;
}
/* Create temporary spaces to be removed at the end of this function */
posrowindex=(long*)calloc(m+1,sizeof(long));
negrowindex=(long*)calloc(m+1,sizeof(long));
zerorowindex=(long*)calloc(m+1,sizeof(long));
dd_init(temp1);
dd_init(temp2);
for (i = 1; i <= m; i++) {
if (dd_Positive(M->matrix[i-1][d-1])){
mpos++;
posrowindex[mpos]=i;
} else if (dd_Negative(M->matrix[i-1][d-1])) {
mneg++;
negrowindex[mneg]=i;
} else {
mzero++;
zerorowindex[mzero]=i;
}
} /*of i*/
if (localdebug) {
dd_WriteMatrix(stdout, M);
printf("No of (+ - 0) rows = (%ld, %ld, %ld)\n", mpos,mneg, mzero);
}
/* The present code generates so many redundant inequalities and thus
is quite useless, except for very small examples
*/
mnew=mzero+mpos*mneg; /* the total number of rows after elimination */
dnew=d-1;
Mnew=dd_CreateMatrix(mnew, dnew);
dd_CopyArow(Mnew->rowvec, M->rowvec, dnew);
/* set_copy(Mnew->linset,M->linset); */
Mnew->numbtype=M->numbtype;
Mnew->representation=M->representation;
Mnew->objective=M->objective;
/* Copy the inequalities independent of x_d to the top of the new matrix. */
for (iz = 1; iz <= mzero; iz++){
for (j = 1; j <= dnew; j++) {
dd_set(Mnew->matrix[iz-1][j-1], M->matrix[zerorowindex[iz]-1][j-1]);
}
}
/* Create the new inequalities by combining x_d positive and negative ones. */
inew=mzero; /* the index of the last x_d zero inequality */
for (ip = 1; ip <= mpos; ip++){
for (in = 1; in <= mneg; in++){
inew++;
dd_neg(temp1, M->matrix[negrowindex[in]-1][d-1]);
for (j = 1; j <= dnew; j++) {
dd_LinearComb(temp2,M->matrix[posrowindex[ip]-1][j-1],temp1,\
M->matrix[negrowindex[in]-1][j-1],\
M->matrix[posrowindex[ip]-1][d-1]);
dd_set(Mnew->matrix[inew-1][j-1],temp2);
}
dd_Normalize(dnew,Mnew->matrix[inew-1]);
}
}
free(posrowindex);
free(negrowindex);
free(zerorowindex);
dd_clear(temp1);
dd_clear(temp2);
_L99:
return Mnew;
}
SEXP impliedLinearity(SEXP m, SEXP h)
{
GetRNGstate();
if (! isMatrix(m))
error("'m' must be matrix");
if (! isLogical(h))
error("'h' must be logical");
if (LENGTH(h) != 1)
error("'h' must be scalar");
if (! isString(m))
error("'m' must be character");
SEXP m_dim;
PROTECT(m_dim = getAttrib(m, R_DimSymbol));
int nrow = INTEGER(m_dim)[0];
int ncol = INTEGER(m_dim)[1];
UNPROTECT(1);
if (nrow <= 1)
error("no use if only one row");
if (ncol <= 3)
error("no use if only one col");
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column one of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column one of 'm' not zero-or-one valued");
}
if (! LOGICAL(h)[0])
for (int i = nrow; i < 2 * nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column two of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column two of 'm' not zero-or-one valued");
}
dd_set_global_constants();
/* note actual type of "value" is mpq_t (defined in cddmp.h) */
mytype value;
dd_init(value);
dd_MatrixPtr mf = dd_CreateMatrix(nrow, ncol - 1);
/* note our matrix has one more column than Fukuda's */
/* representation */
if(LOGICAL(h)[0])
mf->representation = dd_Inequality;
else
mf->representation = dd_Generator;
mf->numbtype = dd_Rational;
/* linearity */
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (foo[0] == '1')
set_addelem(mf->linset, i + 1);
/* note conversion from zero-origin to one-origin indexing */
}
/* matrix */
for (int j = 1, k = nrow; j < ncol; j++)
for (int i = 0; i < nrow; i++, k++) {
const char *rat_str = CHAR(STRING_ELT(m, k));
if (mpq_set_str(value, rat_str, 10) == -1) {
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("error converting string to GMP rational");
}
mpq_canonicalize(value);
dd_set(mf->matrix[i][j - 1], value);
/* note our matrix has one more column than Fukuda's */
}
dd_ErrorType err = dd_NoError;
dd_rowset out = dd_ImplicitLinearityRows(mf, &err);
if (err != dd_NoError) {
rr_WriteErrorMessages(err);
set_free(out);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("failed");
}
SEXP foo;
PROTECT(foo = rr_set_fwrite(out));
set_free(out);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
PutRNGstate();
UNPROTECT(1);
return foo;
}
