#################################################
# sffge(A) 
#
# Input:        sffge(A, 'rank', 'det');
#                 sffge(A, rmar);
# Output:      reduced matrix
#                 'rank' (optional)  rank of A
#                 'det'  (optional)  determinant of A
#
#
# Author: Igor Berchtold, ETHZ, SS93
# Date:  2.8.93
#
# Change(s): Michael Monagan, October 1993
#
# ################################################
sffge := proc(A,rank,det)
   local  B,H,n,m,sign,r,k,i,j,temp,q,l,piv,rmarg,lim;
   option `Copyright 1993 by I. Berchtold and M.B. Monagan, ETH Zuerich`;
   # Compute dimensions of A
   n:= linalg[rowdim](A);
   m:= linalg[coldim](A);

   if nargs>1 and type(args[2],'integer') then
       rmarg := args[2];
       if rmarg<0 or nargs>2 then ERROR(`invalid arguments`) fi;
   else
       rmarg := m
   fi;

   # Initialization
   r:= 1; sign:=1;
   B:= array(1..n,1..m);
   for i to n do
       H[i]:= 1;
       for j to m do
         if not type(A[i,j],polynom(rational)) then
            ERROR(`matrix entries must be polynomials over the rationals`);
         else
            B[i,j]:= expand(A[i,j]);
         fi;
       od;
   od;

   piv:= 1;
   # Eliminate below row r, with pivot in column k
   for k to min(m,rmarg) while r <= n do

    # Find a nonzero and smallest pivot
    for i from r to n  while B[i,k]=0 do od;
    if i <= n then
        lim := length(B[i,k]);
        for j from i+1 to n do
            l:= length(B[j,k]); 
            if l=0 then next fi;
            if l<lim then lim:= l; i:= j; fi;
        od;
        if r<>i then 
            # Pivot is in row i, so switch rows i and r
            for j from k to m do
                  temp:= B[i,j]; B[i,j]:= B[r,j]; B[r,j]:= temp;
            od;
            temp:= H[i]; H[i]:= H[r]; H[r]:= temp;
            sign:= -sign;
        fi;
        if H[r]<>piv then   # B[k,k]  not up to date
	     if divide(piv,H[r],'q') then
	         for i from k to m do
                       B[r,i]:= B[r,i]*q;
                    od;
                else
                   for i from k to m do
                       if B[r,i]<>0 then
                          divide(B[r,i]*piv,H[r],evaln(B[r,i]));
	            fi;
                   od;
                fi;
        fi;
        for i from r+1 to n do
               if B[i,k] <> 0 then
                   if piv<>H[i] then           # B[i,k] not up to date
	          if divide(piv,H[i],'q') then
                         for l from k to m do
                            B[i,l]:= B[i,l]*q;
                         od;
                     else
                         for l from k to m do
  		     if B[i,l]<>0 then
                              divide(B[i,l]*piv,H[i],evaln(B[i,l]));
		     fi;
                        od;
                     fi;
                   fi;
                   for j from k+1 to m do
 		divide(B[r,k]*B[i,j]-B[r,j]*B[i,k],piv,evaln(B[i,j]));
                   od;
                   H[i]:= B[r,k]; 
                   B[i,k]:= 0; 
               fi;
        od;
        piv:= B[r,k];
        r:=r+1;
    fi;
   od;
   if nargs>1 and not type(args[2],'integer') then rank:= r-1 fi;
   if nargs>2 then
        if n+1 = r then
           det:= sign*piv;
        else
           det:= 0;
        fi;
   fi;
   RETURN(eval(B));
end:

`help/text/sffge` := TEXT(
`FUNCTION: sffge - sparse fraction free Gaussian elimination`,
`      `,`CALLING SEQUENCE:`,`    sffge(A)`,`    sffge(A, 'r')`,
`    sffge(A, 'r', 'd')`,`    sffge(A, rmar)`,`      `,`PARAMETERS:`,
`   A    - a rectangular matrix`,
`   'r'  - (optional) for returning the rank of A`,
`   'd'  - (optional) for returning the determinant of A`,
`   rmar - (optional) non-negative integer`,`      `,`SYNOPSIS:   `,
`-  This function performs so called ````fraction-free'' Gaussian elimination`,
`   with row pivoting on A, an n by m matrix of multivariate polynomials with`,
`   rational or integer coefficients.`,
`   This routine is designed in the same spirit as linalg[ffgausselim] to`,
`   avoid computing any GCD's by doing only exact polynomial divisions.`,
`   It differs in that it is especially designed for large sparse matrices`,
`   where it avoids redundant computations and tries to use a smarter`,
`   pivoting strategy.`,`   `,
`-  This function has the same functionality as the Maple library routine`,
`   linalg[ffgausselim].  The output is an upper triangular matrix of`,
`   multivariate polynomials.`,`   `,
`   If an optional second parameter is specified, and it is a name, it is`,
`   assigned the rank of A.  The rank of A is the number of non-zero rows in`,
`   the resulting matrix.`,`      `,
`   If an optional third parameter is also specified, and the rank of A = n,`,
`   then it is assigned the determinant of submatrix(A, 1..n, 1..n).`,`      `,
`   If an optional second parameter is specified, and it is an integer, the`,
`   elimination is terminated at this column position.`,`   `,`REFERENCES   `,
`-  Lee and Saunders, Fraction Free Gaussian Elimination for Sparse Matrices,`,
`   preprint, June 1991.`,
`-  Bareiss, Sylvester's identity and multistep integer-preserving Gaussian`,
`   elimination. Mathematics of Computation, 22:565-578, 1968.`,`      `,
`EXAMPLES:   `,`> with(linalg):`,`> A := matrix(3,3, [x,1,0,0,0,1,1,y,1]);`,
`   `,`                                     [ x  1  0 ]`,
`                                     [         ]`,
`                                A := [ 0  0  1 ]`,
`                                     [         ]`,
`                                     [ 1  y  1 ]`,`      `,
`> sffge(A,'r','d');`,`                            [ x     1        0    ]`,
`                            [                     ]`,
`                            [ 0  y x - 1     x    ]`,
`                            [                     ]`,
`                            [ 0     0     y x - 1 ]`,`      `,`> r;      `,
`                                       3`,`      `,`> d;      `,
`                                    1 - y x`,`   `,
`> A := toeplitz([x,0,0,x-y,0,0,y]);`,`   `,
`                 [   x      0      0    x - y    0      0      y   ]`,
`                 [                                                 ]`,
`                 [   0      x      0      0    x - y    0      0   ]`,
`                 [                                                 ]`,
`                 [   0      0      x      0      0    x - y    0   ]`,
`                 [                                                 ]`,
`            A := [ x - y    0      0      x      0      0    x - y ]`,
`                 [                                                 ]`,
`                 [   0    x - y    0      0      x      0      0   ]`,
`                 [                                                 ]`,
`                 [   0      0    x - y    0      0      x      0   ]`,
`                 [                                                 ]`,
`                 [   y      0      0    x - y    0      0      x   ]`,`   `,
`> sffge(A,'r','d');`,`   `,
`                           [x, 0, 0, x - y, 0, 0, y]`,`   `,
`                             2`,
`                        [0, x , 0, 0, x (x - y), 0, 0]`,`   `,
`                                3                 2`,
`                        [0, 0, x , 0, 0, (x - y) x , 0]`,`   `,
`                                2   2          2            2   2`,
`            [0, 0, 0, (2 y x - y ) x , 0, 0, (x  - 2 y x + y ) x ]`,`   `,
`                                  2      2            2`,
`               [0, 0, 0, 0, (2 y x  - x y ) (2 y x - y ), 0, 0]`,`   `,
`                                3  3       2  4      5      6`,
`             [0, 0, 0, 0, 0, 8 x  y  - 12 x  y  + 6 y  x - y , 0]`,`   `,`   \
                     2  5       3  4       4  3       5  2       6        7`,`\
[0, 0, 0, 0, 0, 0, - 4 y  x  + 28 y  x  - 53 y  x  + 42 y  x  - 15 y  x + 2 y \
]`,`   `,`> r;   `,`                                       7`,`   `,`> d;   `,
`   `,`               2  5       3  4       4  3       5  2       6        7`,
`          - 4 y  x  + 28 y  x  - 53 y  x  + 42 y  x  - 15 y  x + 2 y`,`   `,
`SEE ALSO:  linalg[ffgausselim], linalg[gausselim]`):

#save `sffge.m`;
#quit
