/**
* Computes the overall period of the variables I for (MI) mod |d|, where M is
* a matrix and |d| a vector. Produce a diagonal matrix S = (s_k) where s_k is
* the overall period of i_k
* @param M the set of affine functions of I (row-vectors)
* @param d the column-vector representing the modulos
*/
Matrix * affine_periods(Matrix * M, Matrix * d) {
Matrix * S;
unsigned int i,j;
Value tmp;
Value * periods = (Value *)malloc(sizeof(Value) * M->NbColumns);
value_init(tmp);
for(i=0; i< M->NbColumns; i++) {
value_init(periods[i]);
value_set_si(periods[i], 1);
}
for (i=0; i<M->NbRows; i++) {
for (j=0; j< M->NbColumns; j++) {
value_gcd(tmp, d->p[i][0], M->p[i][j]);
value_divexact(tmp, d->p[i][0], tmp);
value_lcm(periods[j], periods[j], tmp);
}
}
value_clear(tmp);
/* 2- build S */
S = Matrix_Alloc(M->NbColumns, M->NbColumns);
for (i=0; i< M->NbColumns; i++)
for (j=0; j< M->NbColumns; j++)
if (i==j) value_assign(S->p[i][j],periods[j]);
else value_set_si(S->p[i][j], 0);
/* 3- clean up */
for(i=0; i< M->NbColumns; i++) value_clear(periods[i]);
free(periods);
return S;
} /* affine_periods */
/*
* Given (m x n) integer matrix 'X' and n x (k+1) rational matrix 'P', compute
* the rational m x (k+1) rational matrix 'S'. The last column in each row of
* the rational matrices is used to store the common denominator of elements
* in a row.
*/
void rat_prodmat(Matrix *S,Matrix *X,Matrix *P) {
int i,j,k;
int last_column_index = P->NbColumns - 1;
Value lcm, old_lcm,gcd,last_column_entry,s1;
Value m1,m2;
/* Initialize all the 'Value' variables */
value_init(lcm); value_init(old_lcm); value_init(gcd);
value_init(last_column_entry); value_init(s1);
value_init(m1); value_init(m2);
/* Compute the LCM of last column entries (denominators) of rows */
value_assign(lcm,P->p[0][last_column_index]);
for(k=1;k<P->NbRows;++k) {
value_assign(old_lcm,lcm);
value_assign(last_column_entry,P->p[k][last_column_index]);
value_gcd(gcd, lcm, last_column_entry);
value_divexact(m1, last_column_entry, gcd);
value_multiply(lcm,lcm,m1);
}
/* S[i][j] = Sum(X[i][k] * P[k][j] where Sum is extended over k = 1..nbrows*/
for(i=0;i<X->NbRows;++i)
for(j=0;j<P->NbColumns-1;++j) {
/* Initialize s1 to zero. */
value_set_si(s1,0);
for(k=0;k<P->NbRows;++k) {
/* If the LCM of last column entries is one, simply add the products */
if(value_one_p(lcm)) {
value_addmul(s1, X->p[i][k], P->p[k][j]);
}
/* Numerator (num) and denominator (denom) of S[i][j] is given by :- */
/* numerator = Sum(X[i][k]*P[k][j]*lcm/P[k][last_column_index]) and */
/* denominator= lcm where Sum is extended over k = 1..nbrows. */
else {
value_multiply(m1,X->p[i][k],P->p[k][j]);
value_division(m2,lcm,P->p[k][last_column_index]);
value_addmul(s1, m1, m2);
}
}
value_assign(S->p[i][j],s1);
}
for(i=0;i<S->NbRows;++i) {
value_assign(S->p[i][last_column_index],lcm);
/* Normalize the rows so that last element >=0 */
Vector_Normalize_Positive(&S->p[i][0],S->NbColumns,S->NbColumns-1);
}
/* Clear all the 'Value' variables */
value_clear(lcm); value_clear(old_lcm); value_clear(gcd);
value_clear(last_column_entry); value_clear(s1);
value_clear(m1); value_clear(m2);
return;
} /* rat_prodmat */
/*
* 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 */
