void
ppl_min_for_le_pointset (ppl_Pointset_Powerset_C_Polyhedron_t ps,
ppl_Linear_Expression_t le, Value res)
{
ppl_Coefficient_t num, denom;
Value dv, nv;
int minimum, err;
value_init (nv);
value_init (dv);
ppl_new_Coefficient (&num);
ppl_new_Coefficient (&denom);
err = ppl_Pointset_Powerset_C_Polyhedron_minimize (ps, le, num, denom, &minimum);
if (err > 0)
{
ppl_Coefficient_to_mpz_t (num, nv);
ppl_Coefficient_to_mpz_t (denom, dv);
gcc_assert (value_notzero_p (dv));
value_division (res, nv, dv);
}
value_clear (nv);
value_clear (dv);
ppl_delete_Coefficient (num);
ppl_delete_Coefficient (denom);
}
int Vector_IsZero(Value * v, unsigned length) {
unsigned i;
if (value_notzero_p(v[0])) return 0;
else {
value_set_si(v[0], 1);
for (i=length-1; value_zero_p(v[i]); i--);
value_set_si(v[0], 0);
return (i==0);
}
}
int in_domain(Polyhedron *P, Value *list_args) {
int col,row;
Value v; /* value of the constraint of a row when
parameters are instanciated*/
if( !P )
return( 0 );
POL_ENSURE_INEQUALITIES(P);
value_init(v);
/* P->Constraint constraint matrice of polyhedron P */
for(row=0;row<P->NbConstraints;row++) {
value_assign(v,P->Constraint[row][P->Dimension+1]); /*constant part*/
for(col=1;col<P->Dimension+1;col++) {
value_addmul(v, P->Constraint[row][col], list_args[col-1]);
}
if (value_notzero_p(P->Constraint[row][0])) {
/*if v is not >=0 then this constraint is not respected */
if (value_neg_p(v)) {
value_clear(v);
return( in_domain(P->next, list_args) );
}
}
else {
/*if v is not = 0 then this constraint is not respected */
if (value_notzero_p(v)) {
value_clear(v);
return( in_domain(P->next, list_args) );
}
}
}
/* if not return before this point => all the constraints are respected */
value_clear(v);
return 1;
} /* in_domain */
/*
* Return the smallest component index in 'p' whose value is non-zero
*/
int First_Non_Zero(Value *p,unsigned length) {
Value *cp;
int i;
cp = p;
for (i=0;i<length;i++) {
if (value_notzero_p(*cp))
break;
cp++;
}
return((i==length) ? -1 : i );
} /* First_Non_Zero */
double compute_evalue(evalue *e,Value *list_args) {
double res;
if (value_notzero_p(e->d)) {
if (value_notone_p(e->d))
res = VALUE_TO_DOUBLE(e->x.n) / VALUE_TO_DOUBLE(e->d);
else
res = VALUE_TO_DOUBLE(e->x.n);
}
else
res = compute_enode(e->x.p,list_args);
return res;
} /* compute_evalue */
/*
* Compute GCD of 'a' and 'b'
*/
void Gcd(Value a,Value b,Value *result) {
Value acopy, bcopy;
value_init(acopy);
value_init(bcopy);
value_assign(acopy,a);
value_assign(bcopy,b);
while(value_notzero_p(acopy)) {
value_modulus(*result,bcopy,acopy);
value_assign(bcopy,acopy);
value_assign(acopy,*result);
}
value_absolute(*result,bcopy);
value_clear(acopy);
value_clear(bcopy);
} /* Gcd */
enum lp_result PL_polyhedron_opt(Polyhedron *P, Value *obj, Value denom,
enum lp_dir dir, Value *opt)
{
int i;
int first = 1;
Value val, d;
enum lp_result res = lp_empty;
POL_ENSURE_VERTICES(P);
if (emptyQ(P))
return res;
value_init(val);
value_init(d);
for (i = 0; i < P->NbRays; ++ i) {
Inner_Product(P->Ray[i]+1, obj, P->Dimension+1, &val);
if (value_zero_p(P->Ray[i][0]) && value_notzero_p(val)) {
res = lp_unbounded;
break;
}
if (value_zero_p(P->Ray[i][1+P->Dimension])) {
if ((dir == lp_min && value_neg_p(val)) ||
(dir == lp_max && value_pos_p(val))) {
res = lp_unbounded;
break;
}
} else {
res = lp_ok;
value_multiply(d, denom, P->Ray[i][1+P->Dimension]);
if (dir == lp_min)
mpz_cdiv_q(val, val, d);
else
mpz_fdiv_q(val, val, d);
if (first || (dir == lp_min ? value_lt(val, *opt) :
value_gt(val, *opt)))
value_assign(*opt, val);
first = 0;
}
}
value_clear(d);
value_clear(val);
return res;
}
/*
* Return the GCD of components of Vector 'p'
*/
void Vector_Gcd(Value *p,unsigned length,Value *min) {
Value *q,*cq, *cp;
int i, Not_Zero, Index_Min=0;
q = (Value *)malloc(length*sizeof(Value));
/* Initialize all the 'Value' variables */
for(i=0;i<length;i++)
value_init(q[i]);
/* 'cp' points to vector 'p' and cq points to vector 'q' that holds the */
/* absolute value of elements of vector 'p'. */
cp=p;
for (cq = q,i=0;i<length;i++) {
value_absolute(*cq,*cp);
cq++;
cp++;
}
do {
Vector_Min_Not_Zero(q,length,&Index_Min,min);
/* if (*min != 1) */
if (value_notone_p(*min)) {
cq=q;
Not_Zero=0;
for (i=0;i<length;i++,cq++)
if (i!=Index_Min) {
/* Not_Zero |= (*cq %= *min) */
value_modulus(*cq,*cq,*min);
Not_Zero |= value_notzero_p(*cq);
}
}
else
break;
} while (Not_Zero);
/* Clear all the 'Value' variables */
for(i=0;i<length;i++)
value_clear(q[i]);
free(q);
} /* Vector_Gcd */
/** Removes the equalities that involve only parameters, by eliminating some
* parameters in the polyhedron's constraints and in the context.<p>
* <b>Updates M and Ctxt.</b>
* @param M1 the polyhedron's constraints
* @param Ctxt1 the constraints of the polyhedron's context
* @param renderSpace tells if the returned equalities must be expressed in the
* parameters space (renderSpace=0) or in the combined var/parms space
* (renderSpace = 1)
* @param elimParms the list of parameters that have been removed: an array
* whose 1st element is the number of elements in the list. (returned)
* @return the system of equalities that involve only parameters.
*/
Matrix * Constraints_Remove_parm_eqs(Matrix ** M1, Matrix ** Ctxt1,
int renderSpace,
unsigned int ** elimParms) {
int i, j, k, nbEqsParms =0;
int nbEqsM, nbEqsCtxt, allZeros, nbTautoM = 0, nbTautoCtxt = 0;
Matrix * M = (*M1);
Matrix * Ctxt = (*Ctxt1);
int nbVars = M->NbColumns-Ctxt->NbColumns;
Matrix * Eqs;
Matrix * EqsMTmp;
/* 1- build the equality matrix(ces) */
nbEqsM = 0;
for (i=0; i< M->NbRows; i++) {
k = First_Non_Zero(M->p[i], M->NbColumns);
/* if it is a tautology, count it as such */
if (k==-1) {
nbTautoM++;
}
else {
/* if it only involves parameters, count it */
if (k>= nbVars+1) nbEqsM++;
}
}
nbEqsCtxt = 0;
for (i=0; i< Ctxt->NbRows; i++) {
if (value_zero_p(Ctxt->p[i][0])) {
if (First_Non_Zero(Ctxt->p[i], Ctxt->NbColumns)==-1) {
nbTautoCtxt++;
}
else {
nbEqsCtxt ++;
}
}
}
nbEqsParms = nbEqsM + nbEqsCtxt;
/* nothing to do in this case */
if (nbEqsParms+nbTautoM+nbTautoCtxt==0) {
(*elimParms) = (unsigned int*) malloc(sizeof(int));
(*elimParms)[0] = 0;
if (renderSpace==0) {
return Matrix_Alloc(0,Ctxt->NbColumns);
}
else {
return Matrix_Alloc(0,M->NbColumns);
}
}
Eqs= Matrix_Alloc(nbEqsParms, Ctxt->NbColumns);
EqsMTmp= Matrix_Alloc(nbEqsParms, M->NbColumns);
/* copy equalities from the context */
k = 0;
for (i=0; i< Ctxt->NbRows; i++) {
if (value_zero_p(Ctxt->p[i][0])
&& First_Non_Zero(Ctxt->p[i], Ctxt->NbColumns)!=-1) {
Vector_Copy(Ctxt->p[i], Eqs->p[k], Ctxt->NbColumns);
Vector_Copy(Ctxt->p[i]+1, EqsMTmp->p[k]+nbVars+1,
Ctxt->NbColumns-1);
k++;
}
}
for (i=0; i< M->NbRows; i++) {
j=First_Non_Zero(M->p[i], M->NbColumns);
/* copy equalities that involve only parameters from M */
if (j>=nbVars+1) {
Vector_Copy(M->p[i]+nbVars+1, Eqs->p[k]+1, Ctxt->NbColumns-1);
Vector_Copy(M->p[i]+nbVars+1, EqsMTmp->p[k]+nbVars+1,
Ctxt->NbColumns-1);
/* mark these equalities for removal */
value_set_si(M->p[i][0], 2);
k++;
}
/* mark the all-zero equalities for removal */
if (j==-1) {
value_set_si(M->p[i][0], 2);
}
}
/* 2- eliminate parameters until all equalities are used or until we find a
contradiction (overconstrained system) */
(*elimParms) = (unsigned int *) malloc((Eqs->NbRows+1) * sizeof(int));
(*elimParms)[0] = 0;
allZeros = 0;
for (i=0; i< Eqs->NbRows; i++) {
/* find a variable that can be eliminated */
k = First_Non_Zero(Eqs->p[i], Eqs->NbColumns);
if (k!=-1) { /* nothing special to do for tautologies */
/* if there is a contradiction, return empty matrices */
if (k==Eqs->NbColumns-1) {
printf("Contradiction in %dth row of Eqs: ",k);
show_matrix(Eqs);
Matrix_Free(Eqs);
Matrix_Free(EqsMTmp);
(*M1) = Matrix_Alloc(0, M->NbColumns);
Matrix_Free(M);
(*Ctxt1) = Matrix_Alloc(0,Ctxt->NbColumns);
Matrix_Free(Ctxt);
free(*elimParms);
(*elimParms) = (unsigned int *) malloc(sizeof(int));
(*elimParms)[0] = 0;
if (renderSpace==1) {
return Matrix_Alloc(0,(*M1)->NbColumns);
}
else {
return Matrix_Alloc(0,(*Ctxt1)->NbColumns);
}
}
/* if we have something we can eliminate, do it in 3 places:
Eqs, Ctxt, and M */
else {
k--; /* k is the rank of the variable, now */
(*elimParms)[0]++;
(*elimParms)[(*elimParms[0])]=k;
for (j=0; j< Eqs->NbRows; j++) {
if (i!=j) {
eliminate_var_with_constr(Eqs, i, Eqs, j, k);
eliminate_var_with_constr(EqsMTmp, i, EqsMTmp, j, k+nbVars);
}
}
for (j=0; j< Ctxt->NbRows; j++) {
if (value_notzero_p(Ctxt->p[i][0])) {
eliminate_var_with_constr(Eqs, i, Ctxt, j, k);
}
}
for (j=0; j< M->NbRows; j++) {
if (value_cmp_si(M->p[i][0], 2)) {
eliminate_var_with_constr(EqsMTmp, i, M, j, k+nbVars);
}
}
}
}
/* if (k==-1): count the tautologies in Eqs to remove them later */
else {
allZeros++;
}
}
/* elimParms may have been overallocated. Now we know how many parms have
been eliminated so we can reallocate the right amount of memory. */
if (!realloc((*elimParms), ((*elimParms)[0]+1)*sizeof(int))) {
fprintf(stderr, "Constraints_Remove_parm_eqs > cannot realloc()");
}
Matrix_Free(EqsMTmp);
/* 3- remove the "bad" equalities from the input matrices
and copy the equalities involving only parameters */
EqsMTmp = Matrix_Alloc(M->NbRows-nbEqsM-nbTautoM, M->NbColumns);
k=0;
for (i=0; i< M->NbRows; i++) {
if (value_cmp_si(M->p[i][0], 2)) {
Vector_Copy(M->p[i], EqsMTmp->p[k], M->NbColumns);
k++;
}
}
Matrix_Free(M);
(*M1) = EqsMTmp;
EqsMTmp = Matrix_Alloc(Ctxt->NbRows-nbEqsCtxt-nbTautoCtxt, Ctxt->NbColumns);
k=0;
for (i=0; i< Ctxt->NbRows; i++) {
if (value_notzero_p(Ctxt->p[i][0])) {
Vector_Copy(Ctxt->p[i], EqsMTmp->p[k], Ctxt->NbColumns);
k++;
}
}
Matrix_Free(Ctxt);
(*Ctxt1) = EqsMTmp;
if (renderSpace==0) {/* renderSpace=0: equalities in the parameter space */
EqsMTmp = Matrix_Alloc(Eqs->NbRows-allZeros, Eqs->NbColumns);
k=0;
for (i=0; i<Eqs->NbRows; i++) {
if (First_Non_Zero(Eqs->p[i], Eqs->NbColumns)!=-1) {
Vector_Copy(Eqs->p[i], EqsMTmp->p[k], Eqs->NbColumns);
k++;
}
}
}
else {/* renderSpace=1: equalities rendered in the combined space */
EqsMTmp = Matrix_Alloc(Eqs->NbRows-allZeros, (*M1)->NbColumns);
k=0;
for (i=0; i<Eqs->NbRows; i++) {
if (First_Non_Zero(Eqs->p[i], Eqs->NbColumns)!=-1) {
Vector_Copy(Eqs->p[i], &(EqsMTmp->p[k][nbVars]), Eqs->NbColumns);
k++;
}
}
}
Matrix_Free(Eqs);
Eqs = EqsMTmp;
return Eqs;
} /* Constraints_Remove_parm_eqs */
/**
* Given a system of equalities, looks if it has an integer solution in the
* combined space, and if yes, returns one solution.
* <p>pre-condition: the equalities are full-row rank (without the constant
* part)</p>
* @param Eqs the system of equations (as constraints)
* @param I a feasible integer solution if it exists, else NULL. Allocated if
* initially set to NULL, else reused.
*/
void Equalities_integerSolution(Matrix * Eqs, Matrix **I) {
Matrix * Hm, *H=NULL, *U, *Q, *M=NULL, *C=NULL, *Hi;
Matrix *Ip;
int i;
Value mod;
unsigned int rk;
if (Eqs==NULL){
if ((*I)!=NULL) Matrix_Free(*I);
I = NULL;
return;
}
/* we use: AI = C = (Ha 0).Q.I = (Ha 0)(I' 0)^T */
/* with I = Qinv.I' = U.I'*/
/* 1- compute I' = Hainv.(-C) */
/* HYP: the equalities are full-row rank */
rk = Eqs->NbRows;
Matrix_subMatrix(Eqs, 0, 1, rk, Eqs->NbColumns-1, &M);
left_hermite(M, &Hm, &Q, &U);
Matrix_Free(M);
Matrix_subMatrix(Hm, 0, 0, rk, rk, &H);
if (dbgCompParmMore) {
show_matrix(Hm);
show_matrix(H);
show_matrix(U);
}
Matrix_Free(Q);
Matrix_Free(Hm);
Matrix_subMatrix(Eqs, 0, Eqs->NbColumns-1, rk, Eqs->NbColumns, &C);
Matrix_oppose(C);
Hi = Matrix_Alloc(rk, rk+1);
MatInverse(H, Hi);
if (dbgCompParmMore) {
show_matrix(C);
show_matrix(Hi);
}
/* put the numerator of Hinv back into H */
Matrix_subMatrix(Hi, 0, 0, rk, rk, &H);
Ip = Matrix_Alloc(Eqs->NbColumns-2, 1);
/* fool Matrix_Product on the size of Ip */
Ip->NbRows = rk;
Matrix_Product(H, C, Ip);
Ip->NbRows = Eqs->NbColumns-2;
Matrix_Free(H);
Matrix_Free(C);
value_init(mod);
for (i=0; i< rk; i++) {
/* if Hinv.C is not integer, return NULL (no solution) */
value_pmodulus(mod, Ip->p[i][0], Hi->p[i][rk]);
if (value_notzero_p(mod)) {
if ((*I)!=NULL) Matrix_Free(*I);
value_clear(mod);
Matrix_Free(U);
Matrix_Free(Ip);
Matrix_Free(Hi);
I = NULL;
return;
}
else {
value_pdivision(Ip->p[i][0], Ip->p[i][0], Hi->p[i][rk]);
}
}
/* fill the rest of I' with zeros */
for (i=rk; i< Eqs->NbColumns-2; i++) {
value_set_si(Ip->p[i][0], 0);
}
value_clear(mod);
Matrix_Free(Hi);
/* 2 - Compute the particular solution I = U.(I' 0) */
ensureMatrix((*I), Eqs->NbColumns-2, 1);
Matrix_Product(U, Ip, (*I));
Matrix_Free(U);
Matrix_Free(Ip);
if (dbgCompParm) {
show_matrix(*I);
}
}
/* Compute integer hull of truncated linear cone C, i.e., of C with
* the origin removed.
* Here, we do this by first computing the Hilbert basis of C
* and then discarding elements from this basis that are rational
* overconvex combinations of other elements in the basis.
*/
Matrix *Cone_Hilbert_Integer_Hull(Polyhedron *C,
struct barvinok_options *options)
{
int i, j, k;
Matrix *hilbert = Cone_Hilbert_Basis(C, options->MaxRays);
Matrix *rays, *hull;
unsigned dim = C->Dimension;
Value tmp;
unsigned MaxRays = options->MaxRays;
/* When checking for redundant points below, we want to
* check if there are any _rational_ solutions.
*/
POL_UNSET(options->MaxRays, POL_INTEGER);
POL_ENSURE_VERTICES(C);
rays = Matrix_Alloc(C->NbRays-1, C->Dimension);
for (i = 0, j = 0; i < C->NbRays; ++i) {
if (value_notzero_p(C->Ray[i][1+C->Dimension]))
continue;
Vector_Copy(C->Ray[i]+1, rays->p[j++], C->Dimension);
}
/* We only sort the pointers into the big Value array */
qsort(rays->p, rays->NbRows, sizeof(Value *), lex_cmp);
qsort(hilbert->p, hilbert->NbRows, sizeof(Value *), lex_cmp);
/* Remove rays from Hilbert basis */
for (i = 0, j = 0, k = 0; i < hilbert->NbRows && j < rays->NbRows; ++i) {
if (Vector_Equal(hilbert->p[i], rays->p[j], C->Dimension))
++j;
else
hilbert->p[k++] = hilbert->p[i];
}
hilbert->NbRows = k;
/* Now remove points that are overconvex combinations of other points */
value_init(tmp);
for (i = 0; hilbert->NbRows > 1 && i < hilbert->NbRows; ++i) {
Matrix *LP;
Vector *obj;
int nray = rays->NbRows;
int npoint = hilbert->NbRows;
enum lp_result result;
LP = Matrix_Alloc(dim + 1 + nray + (npoint-1), 2 + nray + (npoint-1));
for (j = 0; j < dim; ++j) {
for (k = 0; k < nray; ++k)
value_assign(LP->p[j][k+1], rays->p[k][j]);
for (k = 0; k < npoint; ++k) {
if (k == i)
value_oppose(LP->p[j][1+nray+npoint-1], hilbert->p[k][j]);
else
value_assign(LP->p[j][1+nray+k-(k>i)], hilbert->p[k][j]);
}
}
value_set_si(LP->p[dim][0], 1);
for (k = 0; k < nray+npoint-1; ++k)
value_set_si(LP->p[dim][1+k], 1);
value_set_si(LP->p[dim][LP->NbColumns-1], -1);
for (k = 0; k < LP->NbColumns-2; ++k) {
value_set_si(LP->p[dim+1+k][0], 1);
value_set_si(LP->p[dim+1+k][1+k], 1);
}
/* Somewhat arbitrary objective function. */
obj = Vector_Alloc(LP->NbColumns-1);
value_set_si(obj->p[0], 1);
value_set_si(obj->p[obj->Size-1], 1);
result = constraints_opt(LP, obj->p, obj->p[0], lp_min, &tmp,
options);
/* If the LP is not empty, the point can be discarded */
if (result != lp_empty) {
hilbert->NbRows--;
if (i < hilbert->NbRows)
hilbert->p[i] = hilbert->p[hilbert->NbRows];
--i;
}
Matrix_Free(LP);
Vector_Free(obj);
}
value_clear(tmp);
hull = Matrix_Alloc(rays->NbRows + hilbert->NbRows, dim+1);
for (i = 0; i < rays->NbRows; ++i) {
Vector_Copy(rays->p[i], hull->p[i], dim);
value_set_si(hull->p[i][dim], 1);
}
for (i = 0; i < hilbert->NbRows; ++i) {
Vector_Copy(hilbert->p[i], hull->p[rays->NbRows+i], dim);
value_set_si(hull->p[rays->NbRows+i][dim], 1);
}
Matrix_Free(rays);
Matrix_Free(hilbert);
options->MaxRays = MaxRays;
return hull;
}
/*
* Given a rational matrix 'Mat'(k x k), compute its inverse rational matrix
* 'MatInv' k x k.
* The output is 1,
* if 'Mat' is non-singular (invertible), otherwise the output is 0. Note::
* (1) Matrix 'Mat' is modified during the inverse operation.
* (2) Matrix 'MatInv' must be preallocated before passing into this function.
*/
int Matrix_Inverse(Matrix *Mat,Matrix *MatInv ) {
int i, k, j, c;
Value x, gcd, piv;
Value m1,m2;
Value *den;
if(Mat->NbRows != Mat->NbColumns) {
fprintf(stderr,"Trying to invert a non-square matrix !\n");
return 0;
}
/* Initialize all the 'Value' variables */
value_init(x); value_init(gcd); value_init(piv);
value_init(m1); value_init(m2);
k = Mat->NbRows;
/* Initialise MatInv */
Vector_Set(MatInv->p[0],0,k*k);
/* Initialize 'MatInv' to Identity matrix form. Each diagonal entry is set*/
/* to 1. Last column of each row (denominator of each entry in a row) is */
/* also set to 1. */
for(i=0;i<k;++i) {
value_set_si(MatInv->p[i][i],1);
/* value_set_si(MatInv->p[i][k],1); /* denum */
}
/* Apply Gauss-Jordan elimination method on the two matrices 'Mat' and */
/* 'MatInv' in parallel. */
for(i=0;i<k;++i) {
/* Check if the diagonal entry (new pivot) is non-zero or not */
if(value_zero_p(Mat->p[i][i])) {
/* Search for a non-zero pivot down the column(i) */
for(j=i;j<k;++j)
if(value_notzero_p(Mat->p[j][i]))
break;
/* If no non-zero pivot is found, the matrix 'Mat' is non-invertible */
/* Return 0. */
if(j==k) {
/* Clear all the 'Value' variables */
value_clear(x); value_clear(gcd); value_clear(piv);
value_clear(m1); value_clear(m2);
return 0;
}
/* Exchange the rows, row(i) and row(j) so that the diagonal element */
/* Mat->p[i][i] (pivot) is non-zero. Repeat the same operations on */
/* matrix 'MatInv'. */
for(c=0;c<k;++c) {
/* Interchange rows, row(i) and row(j) of matrix 'Mat' */
value_assign(x,Mat->p[j][c]);
value_assign(Mat->p[j][c],Mat->p[i][c]);
value_assign(Mat->p[i][c],x);
/* Interchange rows, row(i) and row(j) of matrix 'MatInv' */
value_assign(x,MatInv->p[j][c]);
value_assign(MatInv->p[j][c],MatInv->p[i][c]);
value_assign(MatInv->p[i][c],x);
}
}
/* Make all the entries in column(i) of matrix 'Mat' zero except the */
/* diagonal entry. Repeat the same sequence of operations on matrix */
/* 'MatInv'. */
for(j=0;j<k;++j) {
if (j==i) continue; /* Skip the pivot */
value_assign(x,Mat->p[j][i]);
if(value_notzero_p(x)) {
value_assign(piv,Mat->p[i][i]);
value_gcd(gcd, x, piv);
if (value_notone_p(gcd) ) {
value_divexact(x, x, gcd);
value_divexact(piv, piv, gcd);
}
for(c=((j>i)?i:0);c<k;++c) {
value_multiply(m1,piv,Mat->p[j][c]);
value_multiply(m2,x,Mat->p[i][c]);
value_subtract(Mat->p[j][c],m1,m2);
}
for(c=0;c<k;++c) {
value_multiply(m1,piv,MatInv->p[j][c]);
value_multiply(m2,x,MatInv->p[i][c]);
value_subtract(MatInv->p[j][c],m1,m2);
}
/* Simplify row(j) of the two matrices 'Mat' and 'MatInv' by */
/* dividing the rows with the common GCD. */
Vector_Gcd(&MatInv->p[j][0],k,&m1);
Vector_Gcd(&Mat->p[j][0],k,&m2);
value_gcd(gcd, m1, m2);
if(value_notone_p(gcd)) {
for(c=0;c<k;++c) {
value_divexact(Mat->p[j][c], Mat->p[j][c], gcd);
value_divexact(MatInv->p[j][c], MatInv->p[j][c], gcd);
}
}
}
}
}
/* Find common denom for each row */
den = (Value *)malloc(k*sizeof(Value));
value_set_si(x,1);
for(j=0 ; j<k ; ++j) {
value_init(den[j]);
value_assign(den[j],Mat->p[j][j]);
/* gcd is always positive */
Vector_Gcd(&MatInv->p[j][0],k,&gcd);
value_gcd(gcd, gcd, den[j]);
if (value_neg_p(den[j]))
value_oppose(gcd,gcd); /* make denominator positive */
if (value_notone_p(gcd)) {
for (c=0; c<k; c++)
value_divexact(MatInv->p[j][c], MatInv->p[j][c], gcd); /* normalize */
value_divexact(den[j], den[j], gcd);
}
value_gcd(gcd, x, den[j]);
value_divexact(m1, den[j], gcd);
value_multiply(x,x,m1);
}
if (value_notone_p(x))
for(j=0 ; j<k ; ++j) {
for (c=0; c<k; c++) {
value_division(m1,x,den[j]);
value_multiply(MatInv->p[j][c],MatInv->p[j][c],m1); /* normalize */
}
}
/* Clear all the 'Value' variables */
for(j=0 ; j<k ; ++j) {
value_clear(den[j]);
}
value_clear(x); value_clear(gcd); value_clear(piv);
value_clear(m1); value_clear(m2);
free(den);
return 1;
} /* Matrix_Inverse */
/*
* Basic hermite engine
*/
static int hermite(Matrix *H,Matrix *U,Matrix *Q) {
int nc, nr, i, j, k, rank, reduced, pivotrow;
Value pivot,x,aux;
Value *temp1, *temp2;
/* T -1 T */
/* Computes form: A = Q H and U A = H and U = Q */
if (!H) {
errormsg1("Domlib", "nullH", "hermite: ? Null H");
return -1;
}
nc = H->NbColumns;
nr = H->NbRows;
temp1 = (Value *) malloc(nc * sizeof(Value));
temp2 = (Value *) malloc(nr * sizeof(Value));
if (!temp1 ||!temp2) {
errormsg1("Domlib", "outofmem", "out of memory space");
return -1;
}
/* Initialize all the 'Value' variables */
value_init(pivot); value_init(x);
value_init(aux);
for(i=0;i<nc;i++)
value_init(temp1[i]);
for(i=0;i<nr;i++)
value_init(temp2[i]);
#ifdef DEBUG
fprintf(stderr,"Start -----------\n");
Matrix_Print(stderr,0,H);
#endif
for (k=0, rank=0; k<nc && rank<nr; k=k+1) {
reduced = 1; /* go through loop the first time */
#ifdef DEBUG
fprintf(stderr, "Working on col %d. Rank=%d ----------\n", k+1, rank+1);
#endif
while (reduced) {
reduced=0;
/* 1. find pivot row */
value_absolute(pivot,H->p[rank][k]);
/* the kth-diagonal element */
pivotrow = rank;
/* find the row i>rank with smallest nonzero element in col k */
for (i=rank+1; i<nr; i++) {
value_absolute(x,H->p[i][k]);
if (value_notzero_p(x) &&
(value_lt(x,pivot) || value_zero_p(pivot))) {
value_assign(pivot,x);
pivotrow = i;
}
}
/* 2. Bring pivot to diagonal (exchange rows pivotrow and rank) */
if (pivotrow != rank) {
Vector_Exchange(H->p[pivotrow],H->p[rank],nc);
if (U)
Vector_Exchange(U->p[pivotrow],U->p[rank],nr);
if (Q)
Vector_Exchange(Q->p[pivotrow],Q->p[rank],nr);
#ifdef DEBUG
fprintf(stderr,"Exchange rows %d and %d -----------\n", rank+1, pivotrow+1);
Matrix_Print(stderr,0,H);
#endif
}
value_assign(pivot,H->p[rank][k]); /* actual ( no abs() ) pivot */
/* 3. Invert the row 'rank' if pivot is negative */
if (value_neg_p(pivot)) {
value_oppose(pivot,pivot); /* pivot = -pivot */
for (j=0; j<nc; j++)
value_oppose(H->p[rank][j],H->p[rank][j]);
/* H->p[rank][j] = -(H->p[rank][j]); */
if (U)
for (j=0; j<nr; j++)
value_oppose(U->p[rank][j],U->p[rank][j]);
/* U->p[rank][j] = -(U->p[rank][j]); */
if (Q)
for (j=0; j<nr; j++)
value_oppose(Q->p[rank][j],Q->p[rank][j]);
/* Q->p[rank][j] = -(Q->p[rank][j]); */
#ifdef DEBUG
fprintf(stderr,"Negate row %d -----------\n", rank+1);
Matrix_Print(stderr,0,H);
#endif
}
if (value_notzero_p(pivot)) {
/* 4. Reduce the column modulo the pivot */
/* This eventually zeros out everything below the */
/* diagonal and produces an upper triangular matrix */
for (i=rank+1;i<nr;i++) {
value_assign(x,H->p[i][k]);
if (value_notzero_p(x)) {
value_modulus(aux,x,pivot);
/* floor[integer division] (corrected for neg x) */
if (value_neg_p(x) && value_notzero_p(aux)) {
/* x=(x/pivot)-1; */
value_division(x,x,pivot);
value_decrement(x,x);
}
else
value_division(x,x,pivot);
for (j=0; j<nc; j++) {
value_multiply(aux,x,H->p[rank][j]);
value_subtract(H->p[i][j],H->p[i][j],aux);
}
/* U->p[i][j] -= (x * U->p[rank][j]); */
if (U)
for (j=0; j<nr; j++) {
value_multiply(aux,x,U->p[rank][j]);
value_subtract(U->p[i][j],U->p[i][j],aux);
}
/* Q->p[rank][j] += (x * Q->p[i][j]); */
if (Q)
for(j=0;j<nr;j++) {
value_addmul(Q->p[rank][j], x, Q->p[i][j]);
}
reduced = 1;
#ifdef DEBUG
fprintf(stderr,
"row %d = row %d - %d row %d -----------\n", i+1, i+1, x, rank+1);
Matrix_Print(stderr,0,H);
#endif
} /* if (x) */
} /* for (i) */
} /* if (pivot != 0) */
} /* while (reduced) */
/* Last finish up this column */
/* 5. Make pivot column positive (above pivot row) */
/* x should be zero for i>k */
if (value_notzero_p(pivot)) {
for (i=0; i<rank; i++) {
value_assign(x,H->p[i][k]);
if (value_notzero_p(x)) {
value_modulus(aux,x,pivot);
/* floor[integer division] (corrected for neg x) */
if (value_neg_p(x) && value_notzero_p(aux)) {
value_division(x,x,pivot);
value_decrement(x,x);
/* x=(x/pivot)-1; */
}
else
value_division(x,x,pivot);
/* H->p[i][j] -= x * H->p[rank][j]; */
for (j=0; j<nc; j++) {
value_multiply(aux,x,H->p[rank][j]);
value_subtract(H->p[i][j],H->p[i][j],aux);
}
/* U->p[i][j] -= x * U->p[rank][j]; */
if (U)
for (j=0; j<nr; j++) {
value_multiply(aux,x,U->p[rank][j]);
value_subtract(U->p[i][j],U->p[i][j],aux);
}
/* Q->p[rank][j] += x * Q->p[i][j]; */
if (Q)
for (j=0; j<nr; j++) {
value_addmul(Q->p[rank][j], x, Q->p[i][j]);
}
#ifdef DEBUG
fprintf(stderr,
"row %d = row %d - %d row %d -----------\n", i+1, i+1, x, rank+1);
Matrix_Print(stderr,0,H);
#endif
} /* if (x) */
} /* for (i) */
rank++;
} /* if (pivot!=0) */
} /* for (k) */
/* Clear all the 'Value' variables */
value_clear(pivot); value_clear(x);
value_clear(aux);
for(i=0;i<nc;i++)
value_clear(temp1[i]);
for(i=0;i<nr;i++)
value_clear(temp2[i]);
free(temp2);
free(temp1);
return rank;
} /* Hermite */
/* GaussSimplify --
Given Mat1, a matrix of equalities, performs Gaussian elimination.
Find a minimum basis, Returns the rank.
Mat1 is context, Mat2 is reduced in context of Mat1
*/
int GaussSimplify(Matrix *Mat1,Matrix *Mat2) {
int NbRows = Mat1->NbRows;
int NbCols = Mat1->NbColumns;
int *column_index;
int i, j, k, n, t, pivot, Rank;
Value gcd, tmp, *cp;
column_index=(int *)malloc(NbCols * sizeof(int));
if (!column_index) {
errormsg1("GaussSimplify", "outofmem", "out of memory space\n");
Pol_status = 1;
return 0;
}
/* Initialize all the 'Value' variables */
value_init(gcd); value_init(tmp);
Rank=0;
for (j=0; j<NbCols; j++) { /* for each column starting at */
for (i=Rank; i<NbRows; i++) /* diagonal, look down to find */
if (value_notzero_p(Mat1->p[i][j])) /* the first non-zero entry */
break;
if (i!=NbRows) { /* was one found ? */
if (i!=Rank) /* was it found below the diagonal?*/
Vector_Exchange(Mat1->p[Rank],Mat1->p[i],NbCols);
/* Normalize the pivot row */
Vector_Gcd(Mat1->p[Rank],NbCols,&gcd);
/* If (gcd >= 2) */
value_set_si(tmp,2);
if (value_ge(gcd,tmp)) {
cp = Mat1->p[Rank];
for (k=0; k<NbCols; k++,cp++)
value_division(*cp,*cp,gcd);
}
if (value_neg_p(Mat1->p[Rank][j])) {
cp = Mat1->p[Rank];
for (k=0; k<NbCols; k++,cp++)
value_oppose(*cp,*cp);
}
/* End of normalize */
pivot=i;
for (i=0;i<NbRows;i++) /* Zero out the rest of the column */
if (i!=Rank) {
if (value_notzero_p(Mat1->p[i][j])) {
Value a, a1, a2, a1abs, a2abs;
value_init(a); value_init(a1); value_init(a2);
value_init(a1abs); value_init(a2abs);
value_assign(a1,Mat1->p[i][j]);
value_absolute(a1abs,a1);
value_assign(a2,Mat1->p[Rank][j]);
value_absolute(a2abs,a2);
value_gcd(a, a1abs, a2abs);
value_divexact(a1, a1, a);
value_divexact(a2, a2, a);
value_oppose(a1,a1);
Vector_Combine(Mat1->p[i],Mat1->p[Rank],Mat1->p[i],a2,
a1,NbCols);
Vector_Normalize(Mat1->p[i],NbCols);
value_clear(a); value_clear(a1); value_clear(a2);
value_clear(a1abs); value_clear(a2abs);
}
}
column_index[Rank]=j;
Rank++;
}
} /* end of Gauss elimination */
if (Mat2) { /* Mat2 is a transformation matrix (i,j->f(i,j))....
can't scale it because can't scale both sides of -> */
/* normalizes an affine transformation */
/* priority of forms */
/* 1. i' -> i (identity) */
/* 2. i' -> i + constant (uniform) */
/* 3. i' -> constant (broadcast) */
/* 4. i' -> j (permutation) */
/* 5. i' -> j + constant ( ) */
/* 6. i' -> i + j + constant (non-uniform) */
for (k=0; k<Rank; k++) {
j = column_index[k];
for (i=0; i<(Mat2->NbRows-1);i++) { /* all but the last row 0...0 1 */
if ((i!=j) && value_notzero_p(Mat2->p[i][j])) {
/* Remove dependency of i' on j */
Value a, a1, a1abs, a2, a2abs;
value_init(a); value_init(a1); value_init(a2);
value_init(a1abs); value_init(a2abs);
value_assign(a1,Mat2->p[i][j]);
value_absolute(a1abs,a1);
value_assign(a2,Mat1->p[k][j]);
value_absolute(a2abs,a2);
value_gcd(a, a1abs, a2abs);
value_divexact(a1, a1, a);
value_divexact(a2, a2, a);
value_oppose(a1,a1);
if (value_one_p(a2)) {
Vector_Combine(Mat2->p[i],Mat1->p[k],Mat2->p[i],a2,
a1,NbCols);
/* Vector_Normalize(Mat2->p[i],NbCols); -- can't do T */
} /* otherwise, can't do it without mult lhs prod (2i,3j->...) */
value_clear(a); value_clear(a1); value_clear(a2);
value_clear(a1abs); value_clear(a2abs);
}
else if ((i==j) && value_zero_p(Mat2->p[i][j])) {
/* 'i' does not depend on j */
for (n=j+1; n < (NbCols-1); n++) {
if (value_notzero_p(Mat2->p[i][n])) { /* i' depends on some n */
value_set_si(tmp,1);
Vector_Combine(Mat2->p[i],Mat1->p[k],Mat2->p[i],tmp,
tmp,NbCols);
break;
} /* if 'i' depends on just a constant, then leave it alone.*/
}
}
}
}
/* Check last row of transformation Mat2 */
for (j=0; j<(NbCols-1); j++)
if (value_notzero_p(Mat2->p[Mat2->NbRows-1][j])) {
errormsg1("GaussSimplify", "corrtrans", "Corrupted transformation\n");
break;
}
if (value_notone_p(Mat2->p[Mat2->NbRows-1][NbCols-1])) {
errormsg1("GaussSimplify", "corrtrans", "Corrupted transformation\n");
}
}
value_clear(gcd); value_clear(tmp);
free(column_index);
return Rank;
} /* GaussSimplify */
