/* * Return the component of 'p' with minimum non-zero absolute value. 'index' * points to the component index that has the minimum value. If no such value * and index is found, Value 1 is returned. */ void Vector_Min_Not_Zero(Value *p,unsigned length,int *index,Value *min) { Value aux; int i; i = First_Non_Zero(p, length); if (i == -1) { value_set_si(*min,1); return; } *index = i; value_absolute(*min, p[i]); value_init(aux); for (i = i+1; i < length; i++) { if (value_zero_p(p[i])) continue; value_absolute(aux, p[i]); if (value_lt(aux,*min)) { value_assign(*min,aux); *index = i; } } value_clear(aux); } /* Vector_Min_Not_Zero */
/* * 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 */
/* * 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 */
/* * 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 */