/*
* Reduce a vector by dividing it by GCD and making sure its pos-th
* element is positive.
*/
void Vector_Normalize_Positive(Value *p,int length,int pos) {
Value gcd;
int i;
value_init(gcd);
Vector_Gcd(p,length,&gcd);
if (value_neg_p(p[pos]))
value_oppose(gcd,gcd);
if(value_notone_p(gcd))
Vector_AntiScale(p, p, gcd, length);
value_clear(gcd);
} /* Vector_Normalize_Positive */
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 */
/*
* Reduce a vector by dividing it by GCD. There is no restriction on
* components of Vector 'p'. Making the last element positive is *not* OK
* for equalities.
*/
void Vector_Normalize(Value *p,unsigned length) {
Value gcd;
int i;
value_init(gcd);
Vector_Gcd(p,length,&gcd);
if (value_notone_p(gcd))
Vector_AntiScale(p, p, gcd, length);
value_clear(gcd);
} /* Vector_Normalize */
/*
* Replaces constraint a x >= c by x >= ceil(c/a)
* where "a" is a common factor in the coefficients
* old is the constraint; v points to an initialized
* value that this procedure can use.
* Return non-zero if something changed.
* Result is placed in newp.
*/
int ConstraintSimplify(Value *old, Value *newp, int len, Value* v)
{
/* first remove common factor of all coefficients (including "c") */
Vector_Gcd(old+1, len - 1, v);
if (value_notone_p(*v))
Vector_AntiScale(old+1, newp+1, *v, len-1);
Vector_Gcd(old+1, len - 2, v);
if (value_one_p(*v))
return 0;
Vector_AntiScale(old+1, newp+1, *v, len-2);
value_pdivision(newp[len-1], old[len-1], *v);
return 1;
}
/*
* 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 */
/*
* 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 */
/* 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 */