#
#--> pffge(A,'rank','det')
#--> pffge(A,m);
#
# Reduce the rectangular matrix A to upper triangular form by
# doing a primitive fraction-free Gaussian elimination.
#
# Input:	A: Matrix of polynomials over a number field
#		rank: (optional name)
#		det: (optional name)
#		rmar: (optional non-negative integer)
#
# Output:	Function value:   reduced matrix
#		rank (optional)  rank of A
#		det  (optional)  determinant of A
#
# In the ordinary version of Bareiss's fraction free Gaussian elimination
# one does not care about coefficient growth.  However, for some matrices
# e.g. Vandermonde matrices, it may be computationally greatly advantageous
# to make each row of the matrix primitive at each step of the elimination,
# i.e. to divide out by the gcd of the polynomials in each row.  This idea
# was suggested to me by Walter Gander.
#
# Author: MBM Jul/91
#
# See also: linalg[ffgausselim], linalg[gausselim]
#

pffge := proc(AA,rank,det)
local A,B,T,D,n,m,i,j,k,r,d,g,s,t,rmar;

option `Copyright 1990 by the University of Waterloo`;
A := AA; if not type(A,'matrix') then A := evalm(AA) fi;
if not type(A,'matrix') then ERROR(`1st argument must be a matrix`) fi;

n := linalg[rowdim](A);
m := linalg[coldim](A);

B := array(1..n,1..m);
for i to n do
    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;

D := 1;
for i to n do
    g := 0;
    for j to m while g <> 1 do if B[i,j] <> 0 then g := gcd(g,B[i,j]) fi od;
    if g = 0 then D := 0
    elif g <> 1 then
        if nargs > 2 then D := D*g fi;
	for j to m do divide(B[i,j],g,evaln(B[i,j])) od
    fi
od;

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

T := array(1..m);
d := 1;
s := 1;
r := 1;
for k to min(m,rmar) while r <= n do

    if printlevel>2 then lprint(`pffge: elimination at row`,k) fi;

    # Search for a pivot element.  Choose the simplest.
    for i from r to n while B[i,k] = 0 do od;
    for j from i+1 to n do
	if B[j,k] = 0 then next fi;
	if length(B[j,k]) < length(B[i,k]) then i := j fi
    od;

    if i <= n then

	# interchange row i with row r is necessary
	if i <> r then s := -s; for j from k to m do
	    t := B[i,j]; B[i,j] := B[r,j]; B[r,j] := t
	od fi;

	if nargs > 2 then D := D*B[r,k] fi;
	for i from r+1 to n do
	    if B[i,k] = 0 then next fi;
	    if nargs > 2 then D := D/B[r,k] fi;
    	    for j from k+1 to m do
		B[i,j] := expand(B[i,j]*B[r,k]-B[r,j]*B[i,k]);
	    od;
	    # Try to divide out by d the previous pivot
	    for j from k+1 to m while divide(B[i,j],d,evaln(T[j])) do od;
	    if j > m then # division succeeded
		if nargs > 2 then D := D*d fi;
		for j from k+1 to m do B[i,j] := T[j] od;
	    fi;
	    # Compute and divide out by the gcd of row i
	    g := 0;
	    for j from k+1 to m while g <> 1 do
		if B[i,j] <> 0 then g := gcd(g,B[i,j]) fi;
	    od;
	    if g = 0 then D := 0
	    elif g <> 1 then
		if nargs > 2 then D := D*g fi;
		for j from k+1 to m do divide(B[i,j],g,evaln(B[i,j])) od
	    fi;
	    B[i,k] := 0;
        od;

	t := lcoeff(B[r,k]);
	if t <> 1 then # Make leading entry primitive
	    for i from k to m do B[r,i] := B[r,i]/t od;
	fi;

	if nargs > 2 then D := normal(D) fi;
        d := B[r,k];
        r := r + 1      	# go to next row
    fi
od;			  # go to next column

B := subs('A'=A,op(B));  D := subs('A'=A,D);
if has(op(B),'A') or has(D,'A') then ERROR(`undefined matrix elements`) fi;
if nargs>1 and not type(args[2],'integer') then rank := r-1 fi;
if nargs>2 then if n = r-1 then det := normal(s*D) else det := 0 fi fi;
op(B)

end:
pffgausselim := ":

`help/text/pffge` := TEXT(
`FUNCTION: pffge - primitive fraction-free Gaussian elimination`,
`         `,
`CALLING SEQUENCE:`,
`   pffge(A)`,
`   pffge(A, 'r')`,
`   pffge(A, 'r', 'd')`,
`   pffge(A, rmar)`,
`         `,
`PARAMETERS:`,
`   A    - a rectangular matrix of multivariate polynomials`,
`   r    - for returning rank of A (optional)`,
`   d    - for returning the determinant of A (optional)`,
`   rmar - non-negative integer`,
`         `,
`SYNOPSIS:   `,
`- Primitive fraction-free Gaussian elimination with row pivoting is performed`,
`  on A, an n by m matrix of multivariate polynomials.  The result is an upper`,
`  triangular matrix of multivariate polynomials.  Note: the implementation`,
`  only works for multivariate polynomials over the rationals.`,
`         `,
`- This routine has the same functionality of the routine linalg[ffgausselim].`,
`  The ffgausselim routine does a Bareiss fraction-free elimination which`,
`  means that no polynomial gcd's are computed.  The only arithmetic`,
`  operations done during the elimination are polynomial +, -, *, and`,
`  exact polynomial division.  This is potentially more efficient`,
`  because polynomial multiplication and division are simple and efficient`,
`  operations compared with computing polynomial gcd's.`,
`   `,
`  The difference between the Bareiss fraction free elimination as`,
`  implemented in linalg[ffgausselim] and this routine is that the at each`,
`  step of the elimination, we make each row of the matrix "primitive".`,
`  That is, we divide through a row by the greatest common divisor of the`,
`  polynomials in the row so that we minimize the growth of the polynomials in`,
`  the intermediate calculations.  This is tradeoff.  At the cost of computing`,
`  polynomial gcd's, we hope to gain by reducing the size of the polynomials`,
`  that appear during the elimination, hence reducing the overall cost.`,
`   `,
`  Sometimes this can be very effective, e.g. for Vandermonde matrices`,
`  it means that we can triangularize a 10 by 10 matrix whereas the`,
`  routine linalg[ffgausselim] will not terminate because it will compute`,
`  the determinant in expanded form which has 10! = 3,628,800 terms.`,
`  The routine includes a trial division heuristic so that it should`,
`  never be significantly slower than linalg[ffgausselim].`,
`      `,
`- If an optional 2nd 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 3rd parameter is also specified, and the rank of A = n then it`,
`  is assigned the determinant of submatrix(A,1..n,1..n).  Note, the determinant`,
`  which is a polynomial, may be partially factored.`,
`         `,
`- If an optional 2nd parameter is specified, and it is an integer, the elimina-`,
`  tion is terminated at this column position.`,
`         `,
`EXAMPLES:   `,
`> read ``pffge.m``;`,
`> A := vandermonde([u,v,w,x]);`,
`                                  [        2   3 ]`,
`                                  [ 1  u  u   u  ]`,
`                                  [              ]`,
`                                  [        2   3 ]`,
`                                  [ 1  v  v   v  ]`,
`                             A := [              ]`,
`                                  [        2   3 ]`,
`                                  [ 1  w  w   w  ]`,
`                                  [              ]`,
`                                  [        2   3 ]`,
`                                  [ 1  x  x   x  ]`,
`         `,
`> pffge(A,'r','d');`,
`                         [          2          3      ]`,
`                         [ 1  u    u          u       ]`,
`                         [                            ]`,
`                         [               2          2 ]`,
`                         [ 0  1  u + v  u  + v u + v  ]`,
`                         [                            ]`,
`                         [ 0  0    1      v + u + w   ]`,
`                         [                            ]`,
`                         [ 0  0    0          1       ]`,
`      `,
`> r;      `,
`                                       4`,
`      `,
`> d;      `,
`      `,
`          - (- v + u) (- w + u) (- x + u) (- w + v) (- x + v) (x - w)`,
`         `,
`SEE ALSO:  linalg[ffgausselim], linalg[gausselim]`
):
`help/text/pffgausselim` := ":

#save `pffge.m`;
#quit
