#
# Implementation of Buchberger's algorithm for computing Grobner bases,
# main routine for version gb5 (implementation over Zp[x1,...,xn])
# A.Pirklbauer, June 16,1992
#	

infolevel[GB]:= 1:    # initialize global table infolevel. The user must 
                      # change this value to print more information. Example :
                      #   infolevel[GB] := 3;
                      #   GB(F,X,plex) mod 7;
                      # Possible values are : 
                      #   1 => only result (final Grobner basis) is printed
                      #   2 => + statistics about reductions and time
                      #   3 => + each reduction step is printed
                      #   4 => + F after each reduction if new polynomials added
                      #   5 => + Now, also each S-Polynomial is printed
                      #   6 => + new pairs in B after each step (if added)

macro(GB_iplex = `GB/GB_iplex`):
macro(GB_itdeg = `GB/GB_itdeg`):
macro(GB_pplex = `GB/GB_pplex`):
macro(GB_ptdeg = `GB/GB_ptdeg`):
macro(ComputeReducers_IL = `GB/ComputeReducers_IL`):
macro(ComputeReducers_IT = `GB/ComputeReducers_IT`):
macro(ComputeReducers_PL = `GB/ComputeReducers_PL`):
macro(ComputeReducers_PT = `GB/ComputeReducers_PT`):
macro(Crit1 = `GB/Crit1`):
macro(Crit2 = `GB/Crit2`):
macro(ExpNum_InvLex = `GB/ExpNum_InvLex`):
macro(ExpNum_Lex = `GB/ExpNum_Lex`):
macro(HCoeff_IT = `GB/HCoeff_IT`):
macro(HMonomial_IT = `GB/HMonomial_IT`):
macro(HMonomial_PL = `GB/HMonomial_PL`):
macro(HTerm_IT = `GB/HTerm_IT`):
macro(HTerm_PT = `GB/HTerm_PT`):
macro(InsertPair_L = `GB/InsertPair_L`):
macro(InsertPair_T = `GB/InsertPair_T`):
macro(InterReduce_IL = `GB/InterReduce_IL`):
macro(InterReduce_IT = `GB/InterReduce_IT`):
macro(InterReduce_PL = `GB/InterReduce_PL`):
macro(InterReduce_PT = `GB/InterReduce_PT`):
macro(NewBasis_IL = `GB/NewBasis_IL`):
macro(NewBasis_IT = `GB/NewBasis_IT`):
macro(NewBasis_PL = `GB/NewBasis_PL`):
macro(NewBasis_PT = `GB/NewBasis_PT`):
macro(NumToTerm_PL = `GB/NumToTerm_PL`):
macro(PolyToTab_PL = `GB/PolyToTab_PL`):
macro(PolyToTab_PT = `GB/PolyToTab_PT`):
macro(ReduceAll_IL = `GB/ReduceAll_IL`):
macro(ReduceAll_IT = `GB/ReduceAll_IT`):
macro(ReduceAll_PL = `GB/ReduceAll_PL`):
macro(ReduceAll_PT = `GB/ReduceAll_PT`):
macro(Reduce_IL = `GB/Reduce_IL`):
macro(Reduce_IT = `GB/Reduce_IT`):
macro(Reduce_PL = `GB/Reduce_PL`):
macro(Reduce_PT = `GB/Reduce_PT`):
macro(SPoly = `GB/SPoly`):
macro(SPoly_PL = `GB/SPoly_PL`):
macro(SPoly_PT = `GB/SPoly_PT`):
macro(SelectPair_L = `GB/SelectPair_L`):
macro(SelectPair_T = `GB/SelectPair_T`):
macro(SelectPoly_IL = `GB/SelectPoly_IL`):
macro(SelectPoly_IT = `GB/SelectPoly_IT`):
macro(SelectPoly_PL = `GB/SelectPoly_PL`):
macro(SelectPoly_PT = `GB/SelectPoly_PT`):
macro(THTerm_PT = `GB/THTerm_PT`):
macro(TabAddTo = `GB/TabAddTo`):
macro(TabCMul = `GB/TabCMul`):
macro(TabCTMul_PL = `GB/TabCTMul_PL`):
macro(TabCTMul_PT = `GB/TabCTMul_PT`):
macro(TabMod = `GB/TabMod`):
macro(TabRMul = `GB/TabRMul`):
macro(TabRemoveCont = `GB/TabRemoveCont`):
macro(TabSub = `GB/TabSub`):
macro(TabToPoly_PL = `GB/TabToPoly_PL`):
macro(TabToPoly_PT = `GB/TabToPoly_PT`):
macro(TermLcm = `GB/TermLcm`):
macro(TermToNum_PL = `GB/TermToNum_PL`):
macro(gb5_aux = `GB/gb5_aux`):
macro(gb5_iplex = `GB/gb5_iplex`):
macro(gb5_itdeg = `GB/gb5_itdeg`):
macro(gb5_pplex = `GB/gb5_pplex`):
macro(gb5_ptdeg = `GB/gb5_ptdeg`):


#===============================================================================
#  Main routine of the Grobner basis (GB) implementation (gb5)
#===============================================================================


`mod/GB` := proc (F,X,termorder) local p,F0,X0,V,D,T,answer;

 p := args[nargs];                                           # prime modulus
 if not isprime(p) then ERROR (`p must be a prime`) fi;

 # test procedure arguments

 if nargs < (2+1) then ERROR(`too few arguments`)            # p = last argument
 elif nops(X) < 1 then ERROR(`no indeterminates specified`)
 fi;
 if not type(X,{list(name),set(name)}) then ERROR(`bad variable list`) fi;
 if not type(F,{list(polynom(anything,X)), set(polynom(anything,X))}) then
   ERROR(`input must be polynomials over`,X)
 fi;
 
 # expand the polynomials, remove any zeros, take modulo p, make them primitive
 
 X0 := [op(X)];
 F0 := map(primpart,F,X0);          # necessary for Expand (AP 21/6/92)
 F0 := Expand (F0) mod p;           # expand polynomials modulo p
 F0 := {op(F0)} minus {0};          # remove any zeros
 F0 := [op(F0)];                    # convert to list (for GB_xxxx)
 F0 := map(primpart,F0,X0);         # make polynomials primitive
 
 # determine which procedure to call; the default term ordering is `plex`
 
 if nargs = (2+1) then T := 'plex' else T:= termorder fi;   # T:= term ordering
 V := indets(F0,name);                                      # V:= indeterminates
 if V minus {op(X)} <> {} then D:= 'p' else D:= 'i' fi;     # D:= coeff. domain
 
 # and call the appropriate procedure
 
 if T = 'plex' then
   if D = 'i' then answer := GB_iplex(F0,X0,p)        # coeff.domain = Q
   else answer := GB_pplex(F0,X0,p)                   # coeff.domain = Q(a,b,..)
   fi
 elif T = 'tdeg' then
   if D = 'i' then answer := GB_itdeg(F0,X0,p)        # coeff.domain = Q
   else answer := GB_ptdeg(F0,X0,p)                   # coeff.domain = Q(a,b,..)
   fi
 else ERROR (`term ordering must be ``plex`` or ``tdeg```)
 fi;

 answer;
    
end:

`mod/Normalform` := proc(poly, F, X, termorder)
   local answer, p, X0, F0, poly0, D, T, V;

 p := args[nargs];                                           # prime modulus
 if not isprime(p) then ERROR (`p must be a prime`) fi;

 if nargs < (3+1) then ERROR(`too few arguments`)            # p = last argument
 elif nops(X) < 1 then ERROR(`no indeterminates specified`)
 fi;
 if not type(X,{list(name),set(name)}) then ERROR(`bad variable list`) fi;
 if not type(F,{list(polynom(anything,X)), set(polynom(anything,X))}) then
   ERROR(`input must be polynomials in`,X)
 fi;
 if not type(poly,polynom(anything,X)) then
   ERROR(`first argument must be a polynomial in `,X)
 fi:

 # expand the polynomials, remove any zeros, take modulo p, make them primitive
 
 X0 := [op(X)];
 F0 := map(primpart,F,X0);          # necessary for Expand (AP 21/6/92)
 F0 := Expand (F0) mod p;           # expand polynomials modulo p
 F0 := {op(F0)} minus {0};          # remove any zeros
 F0 := [op(F0)];                    # convert to list (for GB_xxxx)
 F0 := map(primpart,F0,X0);         # make polynomials primitive
 
 poly0 := primpart(poly,X0):
 poly0 := Expand (poly0) mod p;

 
 # determine which procedure to call; the default term ordering is `plex`
 
 if nargs = (3+1) then T := 'plex' else T:= termorder fi;   # T:= term ordering
 V := indets(F0,name);                                      # V:= indeterminates
 if V minus {op(X)} <> {} then D:= 'p' else D:= 'i' fi;     # D:= coeff. domain
 
 # and call the appropriate procedure
 
 if T = 'plex' then
   if D = 'i' then answer := Reduce_IL(poly0,p,F0,X0)    # coeff.domain = Q
   else                                                  # coeff.domain = Q(a,b,..)
      F0 := map(PolyToTab_PL,F0,X);
      poly0 := PolyToTab_PL(poly0,X);
      answer := Reduce_PL(poly0,p,F0,X0);
      answer := TabToPoly_PL(answer,X);
   fi
 elif T = 'tdeg' then
   if D = 'i' then answer := Reduce_IT(poly0,p,F0,X0)    # coeff.domain = Q
   else                                                  # coeff.domain = Q(a,b,..)
      F0 := map(PolyToTab_PT,F0,X);
      poly0 := PolyToTab_PT(poly0,X);
      answer := Reduce_PT(poly0,p,F0,X0);
      answer := TabToPoly_PT(answer,X);
   fi
 else ERROR (`term ordering must be ``plex`` or ``tdeg```)
 fi;
 
 Primpart(answer,X) mod p;
    
end:

#===========================================================================
# Auxiliary procedures for Buchbergers's Algorithm (GB = Grobner Basis): 
# Some of them have been taken from the Maple implementation.
# They are used in the 'plex' as well as in the 'tdeg' implementation.
#===========================================================================   

Crit2 := proc(HT,i,j)  # returns (LCM(HTi,HTj) = HTi * HTj))
  evalb(indets(HT[i]) intersect indets(HT[j]) <> {} ) ;
end:

Crit1 := proc(HT,lcmij,i,j,memberB) local u,tmp;       # lcmij = LCMHT[i,j]
  # returns true if : ~E u: 1<=u<=k such that :
  #     {i<>u<>j:  [i,u],[u,j] not in B,  HT(u) | LCM ( HT(i),HT(j) )
  tmp:= true;
  for u from nops(HT) by -1 to 1 do
    if (u<>i and u<>j)        and                 #  i <> u <> j
       (memberB[i,u] <> true) and                 #  [i,u] not in B
       (memberB[u,j] <> true) and                 #  [u,j] not in B
       (divide(lcmij,HT[u]) )                     #  HT(u) | LCM ( HT(i),HT(j) )
       # Divide(..) mod p  not necessary because
       # the HT's are already in Zp[x1...xn]
    then
      tmp:= false;
      break;
    fi;
  od;
  tmp;
end:

TermLcm := proc(a,b,X)
  map( proc (x,a,b) x^max (degree(a,x), degree(b,x)) end, X, a,b);
  convert(",`*`)
end:

ExpNum_Lex := proc(term,X) local i,s,d; option system, remember;
  # result reflects lexicographic term ordering (used in SelectPair_L)
  s := degree(term,X[1]);
  for i from 2 to nops(X) do  d:= degree(term,X[i]);
    if d>999 then ERROR(`degree too large for ExpNum_Lex in`,term) fi;
    s := 1000*s + d
  od;
  s
end:

ExpNum_InvLex := proc(term,X) local i,s,d,n; option system, remember;
  # result reflects INVERSE lexicographic term ordering (used in SelectPair_T)
  n:= nops(X); s := degree(term,X[n]);
  for i from (n-1) by -1 to 1 do   d:= degree(term,X[i]);
    if d>999 then ERROR(`degree too large for ExpNum_InvLex in`,term) fi;
    s := 1000*s + d
  od;
  s
end:

#------------------------------------------------------------------------------
# Spoly, where HC's, HT's and the LCM(HT's) of the polynomials are known.
# This procedure is used in the 2 integer implementations 'itdeg' and 'iplex'.
#------------------------------------------------------------------------------

SPoly := proc (poly1,hc1,ht1, poly2,hc2,ht2, lcmij, p)      # p = prime modulus 
  local m1,m2,f1,f2;
  # precondition: hc/ht(i) = HC/HT(poly(i));  lcmij = LCM (hc1,hc2)
  gcd(hc1,hc2,'m2','m1');                   # m1,m2: cofactors of gcd(HT1,HT2)
  f1 := lcmij / ht1;                        # multiply HT(poly1) with f1  (term)
  f2 := lcmij / ht2;                        # multiply HT(poly2) with f2  (term)
  Expand(f1*m1*poly1 - f2*m2*poly2) mod p;
end:


#==============================================================================
#  Procedures operating on the index set B/memberB : SelectPair, InsertPair
#  There exist two versions: 1) lex. ordering (L)  2) total degree ordering (T)
#==============================================================================

SelectPair_L := proc(B,memberB,indB,i,j) local i0,j0, minI,pair;  # B # {}

  # Selects a pair [i,j] from the set B such that
  #   LCM(HT(Gi),HT(Gj)) = min { LCM(HT(Gu),HT(Gv)): [u,v] in B  },
  # where the minimum is with respect to the ordering of terms. (here:
  # lexicographical ordering): "Normal Selection Strategy" (NSS).
  # Additionally, the pair is removed from B and memberB.
  
  minI := min(op(indB));                   # Indices of table B (indB) reflect
  pair := op(1,B[minI]);                   # lex. ordering of the LCMHT's.
  i0:=pair[1]; j0:=pair[2]; i:=i0;j:=j0;   # Choosing the 'min' implements NSS
  # remove the pair from B and memberB
  if nops(B[minI]) = 1 then B[minI]:= evaln(B[minI])  # last => remove entry
  else B[minI] := subsop(1=NULL,B[minI]);             # else take one element
  fi;
  memberB[i0,j0]:= evaln(memberB[i0,j0]);  
end:

InsertPair_L := proc(i,j, B,memberB, LCMHT,HT, X) local k;     # B:= B + [i,j]
 
  # Inserts a new pair [i,j into the set B. The index of this table is the
  # 'lex.degree' (see TermToNum_PL) of the LCM(HT(Gi), HT(Gj)).  Each entry
  # in B is a list of pairs with the same LCM. This data structure is used
  # in procedure 'SelectPair_L' to implement the "Normal Selection Strategy".
  
  memberB[i,j]:=true;
  LCMHT[i,j]:= TermLcm(HT[i],HT[j],X);                # compute lcm(HTi,HTj)
  k := TermToNum_PL (LCMHT[i,j],X);                   # k:= index of table B
  if assigned(B[k]) then B[k]:= [op(B[k]), [i,j]]     # insert the pair [i,j]
  else B[k] := [ [i,j] ];
  fi;
end:

#----------------------------------------------------------------------------

SelectPair_T := proc(B,memberB,indB,i,j) local i0,j0, B0,indB0, d,maxI,pair;  
  # precondition: B # {}

  # Selects a pair [i,j] from the set B such that
  #   LCM(HT(Gi),HT(Gj)) = min { LCM(HT(Gu),HT(Gv)): [u,v] in B  },
  # where the minimum is with respect to the term ordering, here total degree
  # ordering with ties broken using inverse lexicographical ordering ("Normal
  # Selection Strategy" (NSS)). Additionally,the pair is removed from B/memberB.
  
  d := min(op(indB)); B0:= B[d];           # B0 := list with min. total degree 
  indB0:= map(op,{indices(B0)});           # min <=> Normal Selection Strategy 
  maxI := max(op(indB0));                  # Indices of table B0 (indB0) reflect
  pair := op(1,B0[maxI]);                  # inv.lex. ordering (ILO) of LCMHT's.
  i0:=pair[1]; j0:=pair[2]; i:=i0;j:=j0;   # Choosing 'max' implements ILO.
  # remove the pair from B and memberB
  if nops(B0[maxI]) = 1 then B0[maxI]:= evaln(B0[maxI]); # last => remove entry
    indB0:= indB0 minus {maxI};
    if indB0 = {} then B[d] := evaln(B[d]) fi;
  else B0[maxI] := subsop(1=NULL,B0[maxI]);              # else take one element
  fi;
  memberB[i0,j0]:= evaln(memberB[i0,j0]);  
end:

InsertPair_T := proc(i,j,B,memberB, LCMHT,HT, X) local B0,d,k;  # B:= B + [i,j]
 
  # Inserts a new pair [i,j into the set B. The first index of this table is
  # the 'total degree' of the LCM(HT(Gi), HT(Gj)). The 2nd index is the 'lex.
  # degree' (ExpNum_InvLex) of the lcm's, whose entries are lists of pairs with
  # this same LCM. (double indexed table, and not single indexed as in 'plex').
  # This is used in 'SelectPair_T' to implement the "Normal Selection Strategy"
  # with respect to total degree ordering (first index) and ties broken using
  # inverse lexicographical term ordering (second index), see 'SelectPair_T'.
  
  memberB[i,j]:=true;
  LCMHT[i,j]:= TermLcm(HT[i],HT[j],X);                # compute lcm(HTi,HTj)
  k := ExpNum_InvLex (LCMHT[i,j],X);                  # k:= 2nd index of table B
  d := degree(LCMHT[i,j], {op(X)});                   # d:= 1st index (tot. deg)
  if not assigned(B[d]) then B[d]:= table() fi;       # table for that degree
  B0:= B[d];
  if assigned(B0[k]) then B0[k]:= [op(B0[k]), [i,j]]  # insert the pair [i,j]
  else B0[k] := [ [i,j] ];
  fi;
end:


#===============================================================================
#  - Procedures operating on the specific "table" representation of polynomials
#    ("partially distributed form" : indices = terms, entries = coefficients)
#    used in the pplex (PL) and the ptdeg (PT) implementation, see [Czapor86].
#    Conversions (PolyToTab, TabToPoly) + Algebraic operations (Add,Mul,...).
#  - Note: a) Multiplication in this representation reduces to a simple addition
#          b) Division in this representation becomes a subtraction :
#    Example: f   = x^4 * y^2 * z    --> 4002001 (in pplex impl. (PL))
#             g   = x * z            --> 1000001
#          => f*g = x^5 * y^2 * z^2  --> 5002002 = 4002001 + 1000001
#             f/g = x^3 * y          --> 3002000 = 4002001 - 1000001
#  - PL = pplex implementation
#  - PT = ptdeg implementation
#===============================================================================

TermToNum_PL := proc(term,X)  local z,sum,d;      # converts a term to a number
  # returned number reflects lexicographic order
  option system, remember;
  sum := 0;
  for z in X do
    d := degree(term,z);
    if d>999 then print(`WARNING: degree too large in TermToNum_PL`) fi;
    sum := 1000*sum + d
  od;
  sum
end:

NumToTerm_PL := proc(n,X) local m,term,i,nx;       # converts a number to a term
  option system, remember;
  term := 1 ; m := n ; nx := nops(X) ;
  for i from (nx-1) by -1 to 0 do
    iquo(m, 1000^i, 'm') ; term := term*X[nx-i]^"
  od;
  term
end:

PolyToTab_PL := proc(p,X) local s,t,z,ind;     # converts a polynomial to table
  t := table('sparse'); s := expand(p); 
  if s = 0 then RETURN( op(t) ) fi;
  if type(s,`+`) then
    for z in s do
      ind := TermToNum_PL(z,X);                    # indices of t are the terms
      t[ind] := t[ind] + lcoeff(z,X)               # TermToNum <=> lex. ordering
    od
  else  t[ TermToNum_PL(s,X) ] := lcoeff(s,X)      # entries are coefficients
  fi;
  op(t)
end:

TabToPoly_PL := proc(t,X) local p,inds,z;     # converts a table to a polynomial
  inds := map(op, [indices(t)]) ; p := 0 ; 
  for z in inds do p := p + t[z]*NumToTerm_PL(z,X) od;
  p
end:

#------------------------------------------------------------------------------

PolyToTab_PT := proc(p,X) local s,t,z,sco,ste;
  t := table('sparse') ; s := expand(p) ; 
  if s = 0 then RETURN( op(t) ) fi;
  if type(s,`+`) then
    for z in s do
      sco := lcoeff(z,X); ste := z/sco ;       # indices of t are the terms
      t[ste] := t[ste] + sco                   # lcoeff <=> tot.degree ordering
    od
  else  sco := lcoeff(s,X) ; t[s/sco] := sco   # entries are coefficients
  fi;
  op(t)
end:

TabToPoly_PT := proc(t,X) local p,inds,z;
  inds := map(op, [indices(t)]) ; p := 0 ; 
  for z in inds do p := p + t[z]*z od;
  p
end:


#------------------------------------------------------------------------------
#  Algebraic operations: addition, multiplication, rescaling 
#------------------------------------------------------------------------------

TabAddTo := proc(a,b,m,p) local inds,x;   # add m*b to a (mod p)
  inds := map(op, [indices(b)] );         # where m is a constant number
  for x in inds do
    if assigned( a[x] ) then
      a[x] := (a[x] + m*b[x]) mod p;
    else
      a[x] := (m*b[x]) mod p;
    fi;
    if a[x]=0 then a[x] := evaln( a[x] ) fi;
  od;
end:

TabSub := proc(a,b,p) local t;         # returns (a-b)
  t := copy(a);
  TabAddTo(t,b,-1,p);
  op(t)
end:

TabCTMul_PL := proc(coeff,term,a,p)   # returns a*(c*t) mod p,  c*t a monomial
  local inds,r,x;  
  r := table('sparse') ;
  inds := map(op, [indices(a)] ) ;
  for x in inds do r[x+term] := Expand(a[x]*coeff) mod p od;  # '+' (in PT: '*')
  op(r)
end:

TabCTMul_PT := proc(coeff,term,a,p)   # returns a*(c*t) mod p,  c*t a monomial
  local inds,r,x;  
  r := table('sparse') ;
  inds := map(op, [indices(a)] ) ;
  for x in inds do r[x*term] := Expand(a[x]*coeff) mod p od;  # '*' (in PL: '+')
  op(r)
end:

TabCMul := proc(c,a,p)     # rescale poly. a by coeff. c (mod p), c a polynomial
  local inds,x;
  inds := map(op,[indices(a)]);
  for x in inds do a[x] := Expand(c*a[x]) mod p od;
end:

TabRMul := proc(r,a,p)      
  # rescale (mod p) polynomial a by coefficient r, r a rational function
  local inds,x;
  inds := map(op,[indices(a)]);
  for x in inds do a[x] := Normal(r*a[x]) mod p od;
end:

TabMod := proc(a,p) local inds,x;         # a := a mod p
  inds := map(op, [indices(a)] );
  for x in inds do
    a[x] := (a[x]) mod p;
    if a[x]=0 then a[x] := evaln( a[x] ) fi;
  od;
end:

#-------------------------------------------------------------
# to be simplified for Zp(a,b,..)[X] :   (TabMod possible ?)
#-------------------------------------------------------------
#adopted from pplex/gcont in Maple
TabRemoveCont := proc(t,hi,p)         # t:= Primpart(t) mod p; return content(t)
  local i,inds,g1,g,n;                # attention: t must be in Zp(a,b,...)[X]
  inds := map(op, {indices(t)});
  n := nops(inds);
  if n = 0 then RETURN(0)
  elif n = 1 then g:=(t[hi]) mod p; t[hi]:= 1; RETURN(g)       # content = coeff
  else g1 := 0 
  fi;
  for i to n while g1 <> 1 do               # g1 := GCD( contents(coeffs[t]) )
    g1 := igcd(g1,icontent(t[inds[i]])) 
  od;
  # remove content of coefficients mod p
  if g1 <> 1 then                                  # divide coeffs by g1 (mod p)
    for i to n do                 
      Divide(t[inds[i]],g1,evaln(t[inds[i]])) mod p;
    od 
  fi;
  # make lcoeff(t) as small as possible
  Divide(t[hi],icontent(t[hi]),'g') mod p;       # g := t[hi] / icontent(t[hi])
  for i to n while g <> 1 do
    if inds[i] = hi then next fi;
    if not (Divide(t[inds[i]],'g') mod p) then   # determine divisor g
      g := Gcd(g,t[inds[i]]) mod p               
    fi
  od;
  if g <> 1 then 
    for i to n do 
      Divide(t[inds[i]],g,evaln(t[inds[i]])) mod p; 
    od 
  fi;
  g1 * g                                   # return content of t
end:



#==============================================================================
# PURE LEXICOGRAPHIC TERM ORDERING OVER Zp[x1,...,xn] : iplex (IL)
# -----------------------------------------------------------------------------
# Implementation of Buchberger's algorithm for computing Grobner bases (GB)
# over Zp[x1,...xn] using lexicographic term ordering. GB(F,X) computes the
# reduced, mimimal Grobner basis for a set of polynomials F over Zp[X]. 
# Author : A. Pirklbauer June 14, 1992
# The implemented algorithm is :
#
#    procedure GB (F);	  			    #  F = {f1,...fn}
#      G := InterReduce(Q); k:= length(G);
#      B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
#      while B # {} do
#	 [i,j] := SelectPair (B,G);  B:= B - {[i,j]};
#	 if Crit1 ([i,j],B,G) then
#	   h := Reduce (SPoly(Gi,Gj),G);
#          if h # 0 then
#            G:= G + {h}; k:= k+1;
#            B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)};
#          endif;
#        endif;
#      endwhile;
#      redundant:= {h in G: R(h,G) # {h}};
#      return (InterReduce(G-redundant));
#    end GB;
#
#------------------------------------------------------------------------------
#

GB_iplex := proc (F,X,p)          # p = prime modulus, F already in Zp[x1..xn]
  local k,B,memberB,HT,LCMHT,HC,G,G1,i,j,h,spoly,found,hc,ht,indB,lcmij,
        nec_reds, unnec_reds, total_time;
   
   nec_reds:=0; unnec_reds:=0; total_time:= time();
   B:= table(); memberB:= table(symmetric); LCMHT:= table();
   userinfo(3,'GB',print(`F start = `, F));
   G := InterReduce_IL (F,X,p);          # reduce each element modulo the others
   userinfo(3,'GB',print(`F after initial InterReduce = `, G));
   k := nops(G);                         # k:= number of polynomials in G;
   HC:=NULL; HT:=NULL;
   for i to k do 
     HC:=HC,lcoeff(G[i],X,'ht');   HT:=HT,ht          # head coeff/term of G[i] 
   od;
   HC:=[HC]; HT:=[HT];
   
   # B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
   for j from 2 to k do
     for i to (j-1) do
       if Crit2(HT,i,j) then InsertPair_L (i,j, B,memberB, LCMHT,HT, X) fi 
     od;
   od;
   userinfo(6,'GB',print(`Initial pair set B = `, B));

   # while B <> {} do ... od;
   do
     indB:= map(op,[indices(B)]);                # indices: "lex.degrees" of Gi
     if indB = [] then break fi;                 # <=> while B <> {} do ... od;
     
     SelectPair_L(B,memberB,indB,'i','j');           # does also: B:=B-{[i,j]};
     lcmij:=LCMHT[i,j]; LCMHT[i,j]:= evaln(LCMHT[i,j]);

     if Crit1(HT,lcmij,i,j,memberB) then
       spoly := SPoly (G[i],HC[i],HT[i],G[j],HC[j],HT[j],lcmij,p);
       h := Reduce_IL (spoly,p, G, X, HT,HC);
       userinfo(5,'GB',print(`SPoly (`,i,j,`) = `, spoly));
       userinfo(3,'GB',print(`Reduce(SPoly (`,i,j,`), G) = `, h));
       if h <> 0 then
          
          # G:= G + {h}; k:= k+1;
          hc := lcoeff(h,X,'ht');
          HC := [ op(HC), hc ];  HT := [ op(HT), ht ];
          G  := [ op(G), h ];  k:= k+1;                   # in Zp[x1...xn]
          userinfo(4,'GB',print(`Basis F = `, G));
          
          # B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)}; 
          for i to (k-1) do
            if Crit2(HT,i,k) then InsertPair_L (i,k, B,memberB, LCMHT,HT, X) fi
          od;
          userinfo(6,'GB',print(`Pair set B = `, B));
         nec_reds := nec_reds + 1;
       else
         unnec_reds := unnec_reds + 1;
       fi;
     fi
   od;

   # redundant:= {h in G: R(h,G) # {h}};  G1:= G - redundant
   G1:=NULL;
   for i to k do  found := false;
     for j to k while (not found) do
       found := (i<>j) and (divide(HT[i],HT[j]));   # if HT(j) | HT(i)
       # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
     od;
     if (not found) then G1:= G1,G[i] fi;
   od;
   G1 := [G1];

   G:= InterReduce_IL (G1,X,p);
   G:= map(Primpart,G,X) mod p;
   total_time := time()-total_time;
   
   userinfo(3,'GB',print(`F before final InterReduce = `, G1));
   userinfo(3,'GB',print(`F after final InterReduce = `, G));
   userinfo(2,'GB',
     print(`Reductions :  necessary = `,nec_reds,` unnecessary = `,unnec_reds));
   userinfo(2,'GB',print(`Total time : `,total_time));
   
   RETURN (G);
end:


#===========================================================================
# Full Reduction of a polynomial p modulo a set of polynomials Q
# Definition: the reducer set R(p,Q) := {q in Q such that HT(q) | HT(p) }
# Lexicographic term ordering.
#
#    procedure Reduce(p,Q);                   # Q = {q1,q2,...,qn}
#      r:= p; s:= 0;
#      while r # 0 do
#        while R(r,Q) # {} do
#          q := SelectPoly(R(r,Q));           # select a reducer from Q
#          r := r - (M(r)/M(q)) * q;
#        endwhile;
#        s:= s + M(r); r:= r - M(r);
#      endwhile;
#      return (s);
#    end Reduce;
#
#---------------------------------------------------------------------------

ComputeReducers_IL := proc (r,Q,X,htr,HT) local i,n,quo,reds;     # r in Zp[X]
  # precondition: HT[i] = headterm(Q[i]), htr := HT(r)
  if (r=0) then RETURN ([]) fi;                           # important !
  n := nops(Q); reds:= NULL;                              # reducer set R(r,Q)
  for i to n do
    if (divide (htr, HT[i],'quo')) then                   # if HT(i) | HT(r)
      reds := reds, [i, quo] ;                            # quo = HT(r)/HT(i)
    fi;
    # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
  od;
  [reds];
end:

SelectPoly_IL := proc(reducers,quo)     # precondition: reducers <> {}
  quo:= op(1, reducers)[2];
  op(1, reducers)[1];                   # take the first one (return index to Q)
end:

Reduce_IL:= proc(poly,p,Q,X,HT,HC)                           # p = prime modulus
  local q,r,s,reds,quo,hcr,hcq,ht,htr,mr,HC1,HT1,i,k;
  # precondition: HT[i] = hterm(Q[i]),  HC[i] = hcoeff(Q[i])
  if (nargs = 4) then  
    HC1:=NULL; HT1:=NULL; k:=nops(Q);
    for i to k do HC1:=HC1,lcoeff(Q[i],X,'ht'); HT1:=HT1,ht od;
    HC1:=[HC1]; HT1:=[HT1];
  else
    HC1:= HC; HT1:= HT; 
  fi;
  r:=poly; s:=0; hcr:= lcoeff(r,X,'htr');     # invariant H: hcr=HC(r),htr=HT(r)
  while r <> 0 do  # H                     
    reds := ComputeReducers_IL (r,Q,X,htr,HT1);      # compute R(r,Q)
    while reds <> [] do  # H
      q:= SelectPoly_IL (reds,'quo'); hcq:= HC1[q];  # quo= HT(r)/HT(q), q=index
      r:= Expand(r - (hcr/hcq)*quo*Q[q]) mod p;      # reduce polynomial r mod p
      hcr := lcoeff(r,X,'htr');                      # establish H: HC(r),HT(r)
      reds:= ComputeReducers_IL (r,Q,X,htr,HT1);     # compute R(r,Q)
    od;
    if (r=0) then break fi;                          # IMPORTANT !!
    hcr:= lcoeff(r,X,'htr');  mr:= hcr*htr;          # M(r) = HC(r)*HT(r)
    s := s + mr;  r := r - mr;
    hcr:= lcoeff(r,X,'htr');                         # establish H: HC(r),HT(r)
  od;
  Primpart(s,X) mod p;
end:

#===========================================================================
# 
# InterReduce(F,X): reduce each polynomial F[i] modulo the other polynomials
#                   Ref: [1]: "Grobner Bases: An algorithmic method..."(Buchb85)
#                        [2]: Algorithm 10.3. in the Geddes textbook
#
#    procedure ReduceAll(F)          # remove any redundant elements
#      R:= F;  P:= {};
#      while R # {} do                     # P = {irreducible polynomials}
#        h:= an element of R;  R:= R-{h};  # R = {still reducible polynomials}
#        h:= Reduce (h,P);
#        if h # 0 then
#          P0 := {p in P: HT(h) | HT(p)};  # those which can be reduced by h
#          P := P - P0;                    # remove them from P = {irr. polys}
#          R := R + P0;                    # and add them to R = {red. polys}
#          P := P + {h};
#        fi;
#      end;
#      P;
#    end ReduceAll;
#  
#    procedure NewBasis (F)          # reduce each polynomial modulo the others
#      R := {};
#      for i from 1 to n do  f:= F[i];
#        h := Reduce (f, F - {f});         # reduce each F[i] modulo the others
#        if h <> 0 then R := R + {h} fi;
#      od;
#      R
#    end NewBasis;
#
#    procedure InterReduce (F)       # Construction of a reduced ideal basis
#      NewBasis (ReduceAll(F))
#    end InterReduce;
#
#---------------------------------------------------------------------------
#

ReduceAll_IL := proc(F,X,p)  local R,P,P0,h,i,HTh,HTp;    # p = prime modulus
  R:= F;  P:= [];
  while (R <> []) do
    h:= R[1]; R:= subsop(1=NULL,R);            # h:= an element of R; R:= R- {h}
    h:= Reduce_IL (h,p,P,X);                   # h:= Reduce (h,P) mod p;
    if (h <> 0) then
      lcoeff (h,X,'HTh');  P0:= NULL;
      for i to nops(P) do 
        lcoeff(P[i],X,'HTp');
        if divide(HTp,HTh) then P0 := P0,i fi;                # if HTh | HT(p1)
        # Divide(..) mod p not necessary because HT's in Zp[X]
      od;
      P0 := [P0];                             # P0 := {p in P: HT(h) | HT(p)};
      for i in P0 do R:=[op(R),P[i]] od;      # R := R + P0;
      for i in P0 do P:=subsop(i=NULL,P) od;  # P := P - P0;
      P := [op(P), h];                        # P := P + {h}
    fi;
  od;
  P;
end:

NewBasis_IL := proc(F,X,p) local R,i,h,n,HT,HC,ht;   # p = prime modulus
  n:= nops(F); HC:=NULL; HT:=NULL; R:=NULL;
  for i to n do HC:=HC,lcoeff(F[i],X,'ht');  HT:= HT,ht  od;   # hcoeff/hterm
  HC:=[HC]; HT:=[HT];
  for i to n do
    h:=Reduce_IL(F[i],p,subsop(i=NULL,F),X,subsop(i=NULL,HT),subsop(i=NULL,HC));
    if h <> 0 then R:= R,h fi;
  od;
  [R]
end:

InterReduce_IL := proc (F,X,p) local R;                 # p = prime modulus
  R:= ReduceAll_IL (F,X,p);
  NewBasis_IL (R,X,p);
end:

#==============================================================================
# TOTAL DEGREE TERM ORDERING OVER Zp[x1,...,xn] : itdeg (IT)
# -----------------------------------------------------------------------------
# Implementation of Buchberger's algorithm for computing Grobner bases (GB)
# over Zp[x1,...xn] using total degree term ordering. GB(F,X) computes the
# reduced, mimimal Grobner basis for a set of polynomials F over Zp[X].
# Author: A. Pirklbauer June 14, 1992
# The implemented algorithm is :
#
#    procedure GB (F);	  			    #  F = {f1,...fn}
#      G := InterReduce(Q); k:= length(G);
#      B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
#      while B # {} do
#	 [i,j] := SelectPair (B,G);  B:= B - {[i,j]};
#	 if Crit1 ([i,j],B,G) then
#	   h := Reduce (SPoly(Gi,Gj),G);
#          if h # 0 then
#            G:= G + {h}; k:= k+1;
#            B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)};
#          endif;
#        endif;
#      endwhile;
#      redundant:= {h in G: R(h,G) # {h}};
#      return (InterReduce(G-redundant));
#    end GB;
#
#---------------------------------------------------------------------------
#

GB_itdeg := proc (F,X,p)          # p = prime modulus, F already in Zp[x1..xn]
  local k,B,memberB,HT,LCMHT,HC,G,G1,i,j,h,spoly,found,hc,ht,indB,lcmij,
        nec_reds, unnec_reds, total_time;
   
   nec_reds:=0; unnec_reds:=0; total_time:= time();
   B:= table(); memberB:= table(symmetric); LCMHT:= table();
   userinfo(3,'GB',print(`F start = `, F));
   G := InterReduce_IT (F,X,p);          # reduce each element modulo the others
   userinfo(3,'GB',print(`F after initial InterReduce = `, G));
   k := nops(G);                         # k:= number of polynomials in G;
   HC:= [seq(HCoeff_IT(G[i],X),i=1..k)]; # head coefficients of G[i]
   HT:= [seq(HTerm_IT (G[i],X),i=1..k)]; # head terms of G[i]
   
   # B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
   for j from 2 to k do
     for i to (j-1) do
       if Crit2(HT,i,j) then InsertPair_T (i,j, B,memberB, LCMHT,HT, X) fi
     od;
   od;
   userinfo(6,'GB',print(`Initial pair set B = `, B));
   
   # while B <> {} do ... od;
   do
     indB:= map(op,[indices(B)]);                # indices: "tot.degrees" of Gi
     if indB = [] then break fi;                 # <=> while B <> {} do ... od;
     
     SelectPair_T(B,memberB,indB,'i','j');           # does also: B:=B-{[i,j]};
     lcmij:=LCMHT[i,j]; LCMHT[i,j]:=evaln(LCMHT[i,j]);

     if Crit1(HT,lcmij,i,j,memberB) then
       spoly:= SPoly(G[i],HC[i],HT[i],G[j],HC[j],HT[j],lcmij,p);
       h := Reduce_IT (spoly, p, G, X, HT,HC);
       userinfo(5,'GB',print(`SPoly (`,i,j,`) = `, spoly));
       userinfo(3,'GB',print(`Reduce(SPoly (`,i,j,`), G) = `, h));
       if h <> 0 then
          
          # G:= G + {h}; k:= k+1;
          hc := HCoeff_IT(h,X); ht:= HTerm_IT(h,X);       # total degree HC,HT
          HC := [ op(HC), hc ];  HT := [ op(HT), ht ];
          G  := [ op(G), h ];  k:= k+1;                   # in Zp[x1...xn]
          userinfo(4,'GB',print(`Basis F = `, G));
           
          # B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)}; 
          for i to (k-1) do
            if Crit2(HT,i,k) then InsertPair_T (i,k, B,memberB, LCMHT,HT, X) fi
          od;
          userinfo(6,'GB',print(`Pair set B = `, B));
         nec_reds := nec_reds + 1;
       else
         unnec_reds := unnec_reds + 1;
       fi;
     fi
   od;

   # redundant:= {h in G: R(h,G) # {h}};  G1:= G - redundant
   G1:=NULL;
   for i to k do  found := false;
     for j to k while (not found) do
       found := (i<>j) and (divide(HT[i],HT[j]));   # if HT(j) | HT(i)
       # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
     od;
     if (not found) then G1:= G1,G[i] fi;
   od;
   G1 := [G1];

   G:= InterReduce_IT (G1,X,p);
   G:= map(Primpart,G,X) mod p;
   total_time := time()-total_time;
   
   userinfo(3,'GB',print(`F before final InterReduce = `, G1));
   userinfo(3,'GB',print(`F after final InterReduce = `, G));
   userinfo(2,'GB',
     print(`Reductions :  necessary = `,nec_reds,` unnecessary = `,unnec_reds));
   userinfo(2,'GB',print(`Total time : `,total_time));
   

   RETURN (G);
end:


#===========================================================================
# Full Reduction of a polynomial p modulo a set of polynomials Q
# Definition: the reducer set R(p,Q) := {q in Q such that HT(q) | HT(p) }
# Total degree term ordering.
#
#    procedure Reduce(p,Q);                   # Q = {q1,q2,...,qn}
#      r:= p; s:= 0;
#      while r # 0 do
#        while R(r,Q) # {} do
#          q := SelectPoly(R(r,Q));           # select a reducer from Q
#          r := r - (M(r)/M(q)) * q;
#        endwhile;
#        s:= s + M(r); r:= r - M(r);
#      endwhile;
#      return (s);
#    end Reduce;
#
#------------------------------------------------------------------------------

ComputeReducers_IT := proc (r,Q,X,htr,HT) local i,n,quo,reds;      # r in Zp[X]
  # precondition: HT[i] = headterm(Q[i]), htr := HT(r)
  if (r=0) then RETURN ([]) fi;                           # important !
  n := nops(Q); reds:= NULL;                              # reducer set R(r,Q)
  for i to n do
    if (divide (htr, HT[i],'quo')) then                   # if HT(i) | HT(r)
      reds := reds, [i,quo];                              # quo = HT(r)/HT(i)
    fi;
    # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
  od;
  [reds];
end:

SelectPoly_IT := proc(reducers,quo)     # precondition: reducers <> {}
  quo:= op(1, reducers)[2];
  op(1, reducers)[1];                   # take the first one (return index to Q)
end:

Reduce_IT := proc (poly,p,Q,X, HT,HC)                # p = prime modulus
  local q,r,s,reds,quo,hcr,hcq,htr,hm,mr,i,k,HC1,HT1;
  # precondition: HT[i] = hterm(Q[i]),  HC[i] = hcoeff(Q[i])
  if (nargs = 4) then k:=nops(Q);
    HC1 := [seq(HCoeff_IT(Q[i],X),i=1..k)];          # head coefficients of Q[i]
    HT1 := [seq(HTerm_IT (Q[i],X),i=1..k)];          # head terms of Q[i]
  else
    HC1:= HC; HT1:= HT; 
  fi;
  r:=poly; s:=0; 
  hcr:=HCoeff_IT(r,X); htr:=HTerm_IT(r,X);    # invariant H: hcr=HC(r),htr=HT(r)
  while r <> 0 do   # H
    reds := ComputeReducers_IT (r,Q,X,htr,HT1);      # compute R(r,Q)
    while reds <> [] do   # H
      q:= SelectPoly_IT (reds,'quo'); hcq:= HC1[q];  # quo= HT(r)/HT(q), q=index
      r:= Expand(r - (hcr/hcq)*quo*Q[q]) mod p;      # reduce polynomial r mod p
      hcr := HCoeff_IT(r,X); htr:= HTerm_IT(r,X);    # establish H: HC(r),HT(r)
      reds:= ComputeReducers_IT (r,Q,X,htr,HT1);     # compute R(r,Q)
    od;
    if (r=0) then break fi;                          # IMPORTANT !!
    hm:= HMonomial_IT(r,X); mr:=hm[1]*hm[2];         # M(r) = HC(r)*HT(r)
    s := s + mr;  r := r - mr;
    hcr := HCoeff_IT(r,X); htr:= HTerm_IT(r,X);      # establish H: HC(r),HT(r)
  od;
  Primpart(s,X) mod p;
end:

#===========================================================================
# 
# InterReduce(F,X): reduce each polynomial F[i] modulo the other polynomials
#                   Ref: [1]: "Grobner Bases: An algorithmic method..."(Buchb85)
#                        [2]: Algorithm 10.3. in the Geddes textbook
#
#    procedure ReduceAll(F)          # remove any redundant elements
#      R:= F;  P:= {};
#      while R # {} do                     # P = {irreducible polynomials}
#        h:= an element of R;  R:= R-{h};  # R = {still reducible polynomials}
#        h:= Reduce (h,P);
#        if h # 0 then
#          P0 := {p in P: HT(h) | HT(p)};  # those which can be reduced by h
#          P := P - P0;                    # remove them from P = {irr. polys}
#          R := R + P0;                    # and add them to R = {red. polys}
#          P := P + {h};
#        fi;
#      end;
#      P;
#    end ReduceAll;
#  
#    procedure NewBasis (F)          # reduce each polynomial modulo the others
#      R := {};
#      for i from 1 to n do  f:= F[i];
#        h := Reduce (f, F - {f});         # reduce each F[i] modulo the others
#        if h <> 0 then R := R + {h} fi;
#      od;
#      R
#    end NewBasis;
#
#    procedure InterReduce (F)       # Construction of a reduced ideal basis
#      NewBasis (ReduceAll(F))
#    end InterReduce;
#
#---------------------------------------------------------------------------
#

ReduceAll_IT := proc(F,X,p)  local R,P,P0,h,i,HTh,HTp;    # p = prime modulus
  R:= F;  P:= [];
  while (R <> []) do
    h:= R[1]; R:= subsop(1=NULL,R);           # h:= an element of R; R:= R- {h}
    h:= Reduce_IT (h,p,P,X);                  # h:= Reduce (h,P) mod p;
    if (h <> 0) then
      HTh := HTerm_IT(h,X); P0:= NULL;
      for i to nops(P) do  
        HTp := HTerm_IT(P[i],X);
        if divide(HTp,HTh) then P0 := P0,i fi;                 # if HTh | HT(p1)
        # Divide(..) mod p not necessary because HT's in Zp[X]
      od;
      P0 := [P0];                             # P0 := {p in P: HT(h) | HT(p)};
      for i in P0 do R:=[op(R),P[i]] od;      # R := R + P0;
      for i in P0 do P:=subsop(i=NULL,P) od;  # P := P - P0;
      P := [op(P), h];                        # P := P + {h}
    fi;
  od;
  P;
end:

NewBasis_IT := proc(F,X,p) local R,i,h,n,HT,HC;         # p = prime modulus
  R:=NULL; n:= nops(F);
  HC:= [ seq(HCoeff_IT(F[i],X), i=1..n) ];
  HT:= [ seq(HTerm_IT (F[i],X), i=1..n) ];
  for i to n do
    h:=Reduce_IT(F[i],p,subsop(i=NULL,F),X,subsop(i=NULL,HT),subsop(i=NULL,HC));
    if h <> 0 then R:= R,h fi;
  od;
  [R]
end:

InterReduce_IT := proc (F,X,p) local R;                   # p = prime modulus
  R:= ReduceAll_IT(F,X,p);
  NewBasis_IT (R,X,p);  
end:


#===========================================================================
#  Auxiliary procedures
#===========================================================================


HMonomial_IT := proc(poly,X)    # total degree [hcoeff,hterm] of poly (in Zp[X])
  local n,s,t,i,d,Y,hc,ht,temp;
    option system,remember;                                   # remember table !
    s := expand(poly); n := nops(X); Y := ['X[n-i+1]'$i=1..n];
    t := 0 ; d := degree(s,{op(X)}) ;
    if type(s,`+`) then
      for i to nops(s) do
        temp := op(i,s);
        if degree(temp,{op(X)}) = d then t := t + temp fi
      od
    else  t := s
    fi;
    hc := tcoeff(t,Y,'ht');
    [hc,ht]
end:

HCoeff_IT := proc(poly,X)  op(1, HMonomial_IT(poly,X) )  end:     # total degree
HTerm_IT  := proc(poly,X)  op(2, HMonomial_IT(poly,X) )  end:     # total degree

#==============================================================================
# PURE LEXICOGRAPHIC TERM ORDERING OVER Zp(a,b,..)[x1,...,xn] : pplex (PL)
# -----------------------------------------------------------------------------
# Implementation of Buchberger's algorithm for computing Grobner bases (GB)
# over Zp(a,b,..)[X] using lexicographic term ordering. GB(F,X) computes the
# reduced, mimimal Grobner basis for a set of polynomials F over Zp(a,b,..)[X].
# Author : A. Pirklbauer June 14, 1992
# The implemented algorithm is :
#
#    procedure GB (F);	  			    #  F = {f1,...fn}
#      G := InterReduce(Q); k:= length(G);
#      B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
#      while B # {} do
#	 [i,j] := SelectPair (B,G);  B:= B - {[i,j]};
#	 if Crit1 ([i,j],B,G) then
#	   h := Reduce (SPoly(Gi,Gj),G);
#          if h # 0 then
#            G:= G + {h}; k:= k+1;
#            B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)};
#          endif;
#        endif;
#      endwhile;
#      redundant:= {h in G: R(h,G) # {h}};
#      return (InterReduce(G-redundant));
#    end GB;
#
#------------------------------------------------------------------------------
#
#  - Because the coefficient domains are rational functions (over Zp), i.e.
#    free parameters may be present, in [Czapor86] it is suggested that
#    polynomials are represented in "partially distributed form". That is,
#    each term over X appears only once, with a fully distributed coefficient.
#  - This is necessary, primarily because of space considerations [Czapor86],
#    so we do a separate implementation for pplex and ptdeg.
#  - A polynomial is represented by a sparse table whose indices are the terms
#    of the polynomials and whose entries are the corresponding coefficients.
#  - All operations use this polynomial representation.
#
#------------------------------------------------------------------------------

GB_pplex := proc (F,X,p)      # p = prime modulus, F already in Zp(a,b,..)[X]
  local k,B,memberB,HT,LCMHT,HC,HI,G,G1,i,j,h,h1,spoly,found,indB,lcmij,
        nec_reds, unnec_reds, total_time;

   nec_reds:=0; unnec_reds:=0; total_time:= time();
   B:= table(); memberB:= table(symmetric); LCMHT:= table();

   G := map(PolyToTab_PL,F,X);           # convert to table representation
   userinfo(3,'GB',print(`F start = `, map(TabToPoly_PL,G,X)));
   G := InterReduce_PL (G,X,p);          # reduce each element modulo the others
   userinfo(3,'GB',print(`F after initial InterReduce =`,map(TabToPoly_PL,G,X)));
   k := nops(G);                         # k:= number of polynomials in G;
   HI:= map(HMonomial_PL,G);                      # head terms = indices of G(i)
   HT:= [ seq(NumToTerm_PL(HI[i],X), i=1..k) ];   # head terms of polynomials 
   HC:= [ seq(G[i][HI[i]], i=1..k) ];             # head coeffs = table entries

   # B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
   for j from 2 to k do
     for i to (j-1) do
       if Crit2(HT,i,j) then InsertPair_L (i,j, B,memberB, LCMHT,HT, X) fi 
     od;
   od;
   userinfo(6,'GB',print(`Initial pair set B = `, B));
   
   # while B <> {} do ... od;
   do
     indB:= map(op,[indices(B)]);                # indices: "lex.degrees" of Gi
     if indB = [] then break fi;                 # <=> while B <> {} do ... od;
     
     SelectPair_L(B,memberB,indB,'i','j');           # does also: B:=B-{[i,j]};
     lcmij:=LCMHT[i,j]; LCMHT[i,j]:= evaln(LCMHT[i,j]);

     if Crit1(HT,lcmij,i,j,memberB) then 
       spoly := SPoly_PL (G[i],HC[i],HT[i], G[j],HC[j],HT[j], lcmij,X,p);
       h := Reduce_PL (spoly, p, G, X, HT,HC,HI);                   # mod p
       userinfo(5,'GB',print(`SPoly (`,i,j,`) = `, TabToPoly_PL(spoly,X)));
       userinfo(3,'GB',print(`Reduce(SPoly (`,i,j,`), G) = `, TabToPoly_PL(h,X)));
       
      if (indices(h) <> NULL) then
          
          # G:= G + {h}; k:= k+1;
          h1 := copy(h);                              # necessary (?)
          G  := [ op(G), op(h1) ];  k:= k+1;
          HI := [ op(HI), HMonomial_PL(h1) ];
          HT := [ op(HT), NumToTerm_PL(HI[k],X) ];
          HC := [ op(HC), h1[HI[k]] ];
          userinfo(4,'GB',print(`Basis F = `, map(TabToPoly_PL,G,X)));
          
          # B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)}; 
          for i to (k-1) do
            if Crit2(HT,i,k) then InsertPair_L (i,k, B,memberB, LCMHT,HT, X) fi
          od;
          userinfo(6,'GB',print(`Pair set B = `, B));
          nec_reds := nec_reds + 1;
        else
          unnec_reds := unnec_reds + 1;
        fi
     fi
   od;

   # redundant:= {h in G: R(h,G) # {h}};  G1:= G - redundant
   G1:=[];                                    # must be a list, seq did not work
   for i to k do  found := false;
     for j to k while (not found) do
       found := (i<>j) and (divide(HT[i],HT[j]));        # if HT(j) | HT(i)
       # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
     od;
     if (not found) then G1:= [op(G1),G[i]] fi;
   od;
   
   G:= InterReduce_PL (G1,X,p);    # mod p
   G:= map(TabToPoly_PL,G,X);      # convert back to polynomial representation
   G:= map(Primpart,G,X) mod p;
   total_time := time()-total_time;
   
   userinfo(3,'GB',print(`F before final InterReduce = `,map(TabToPoly_PL,G1,X)));
   userinfo(3,'GB',print(`F after final InterReduce = `, G));
   userinfo(2,'GB',
     print(`Reductions :  necessary = `,nec_reds,` unnecessary = `,unnec_reds));
   userinfo(2,'GB',print(`Total time : `,total_time));
  
   RETURN (G);
end:



#==============================================================================
# Full Reduction of a polynomial p modulo a set of polynomials Q
# Definition: the reducer set R(p,Q) := {q in Q such that HT(q) | HT(p) }
# Lexicographic term ordering.
# The algebraic operations are done in the table representation of polynomials.
#
#    procedure Reduce(p,Q);                   # Q = {q1,q2,...,qn}
#      r:= p; s:= 0;
#      while r # 0 do
#        while R(r,Q) # {} do
#          q := SelectPoly(R(r,Q));           # select a reducer from Q
#          r := r - (M(r)/M(q)) * q;
#        endwhile;
#        s:= s + M(r); r:= r - M(r);
#      endwhile;
#      return (s);
#    end Reduce;
#
#------------------------------------------------------------------------------

ComputeReducers_PL := proc (r,Q,X,HT) local i,n,htr,reds;
  # precondition: HT[i] = headterm(Q[i])
  if (indices(r) = NULL) then RETURN ([]) fi;      # important !
  n  := nops(Q);
  htr := NumToTerm_PL(HMonomial_PL(r),X);          # htr := HT(r)
  reds:= NULL;                                     # reducer set R(r,Q)
  for i to n do
    if (divide (htr, HT[i])) then        # if HT(i) | HT(r):
      reds:= reds,i ;                    # add Q[i] (the index) to reducers
    fi;
    # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
  od;
  [reds];
end:

SelectPoly_PL := proc(reducers)     # precondition: reducers <> {}
  op(1, reducers);                  # take the first one (return index to Q)
end:


Reduce_PL:= proc(poly,p,Q,X,HT,HC,HI)             # p = prime modulus
  local q,r,s,reds,hi,hiq,hcr,hcq,HI1,HC1,HT1,i,n,m1,m2,scale,d;
  # precondition: HT[i] = hterm(Q[i]),  HC[i] = hcoeff(Q[i])
  if (indices(poly)=NULL) then RETURN (op(poly)) fi;
  n:= nops(Q);
  if (nargs = 4) then
    HI1:= map(HMonomial_PL,Q);                     # head indices (table rep.)
    HT1:= [ seq(NumToTerm_PL(HI1[i],X), i=1..n) ]; # head terms of polynomials 
    HC1:= [ seq(Q[i][HI1[i]], i=1..n) ];           # head coeffs = table entries
  else
    HC1:= HC; HT1:= HT; HI1:= HI;
  fi;
  
  r:= copy(poly); s:=table('sparse');               # r:=poly; s:=0;  (as tables)
  while (indices(r) <> NULL) do 
    reds := ComputeReducers_PL (r,Q,X,HT1);       # compute R(r,Q)  (indices)
    scale:=1;                                     # rescale s (mult by m1 below)
    while reds <> [] do
      i := SelectPoly_PL (reds);  q:= Q[i];       # q = sel. polynomial (table)
      hi:= HMonomial_PL(r);  hcr:= r[hi];         # head index/coefficient of r
      hiq :=HI1[i];  hcq := HC1[i];               # head index/coefficient of q
      Gcd(hcq,hcr,'m1','m2') mod p;               # m1*hcq = m2*hcr =gcd (mod p)
      # TabMul/TabAddTo/TabCTMul are time critical (65% of time in inner loop)
      TabCMul(m1,r,p); scale:= (m1*scale) mod p;  # mod p
      d := TabCTMul_PL(-m2,hi-hiq,q,p);           # d:= m2*(HT(r)/HT(q)) (mod p)
      TabAddTo (r,d,1,p);                         # r:= m1*r - d*q  (mod p)
      reds := ComputeReducers_PL (r,Q,X,HT1);
    od;
    if (indices(r) = NULL) then break fi;         # IMPORTANT !!
    hi:= HMonomial_PL(r);  hcr:= r[hi];           # head index/coefficient of r
    TabCMul (scale, s, p);                        # rescale s (mod p)
    s[hi]:= Expand(hcr) mod p;                    # s:= s + M(r);
    r[hi]:= evaln(r[hi]);                         # r:= r - M(r);
  od;
  hi := HMonomial_PL(s); TabRemoveCont(s,hi,p);
  if sign(s[hi])=-1 then TabCMul(-1,s,p) fi;
  op(s);                                          # return primpart of s
end:

#===========================================================================
# 
# InterReduce(F,X): reduce each polynomial F[i] modulo the other polynomials
#                   Ref: [1]: "Grobner Bases: An algorithmic method..."(Buchb85)
#                        [2]: Algorithm 10.3. in the Geddes textbook
#
#    procedure ReduceAll(F)          # remove any redundant elements
#      R:= F;  P:= {};
#      while R # {} do                     # P = {irreducible polynomials}
#        h:= an element of R;  R:= R-{h};  # R = {still reducible polynomials}
#        h:= Reduce (h,P);
#        if h # 0 then
#          P0 := {p in P: HT(h) | HT(p)};  # those which can be reduced by h
#          P := P - P0;                    # remove them from P = {irr. polys}
#          R := R + P0;                    # and add them to R = {red. polys}
#          P := P + {h};
#        fi;
#      end;
#      P;
#    end ReduceAll;
#  
#    procedure NewBasis (F)          # reduce each polynomial modulo the others
#      R := {};
#      for i from 1 to n do  f:= F[i];
#        h := Reduce (f, F - {f});         # reduce each F[i] modulo the others
#        if h <> 0 then R := R + {h} fi;
#      od;
#      R
#    end NewBasis;
#
#    procedure InterReduce (F)       # Construction of a reduced ideal basis
#      NewBasis (ReduceAll(F))
#    end InterReduce;
#
#---------------------------------------------------------------------------
#

ReduceAll_PL := proc(F,X,p)  local R,P,P0,h,i,HTh,HTp;     # p = prime modulus
  R:= F;  P:= [];     # R:=copy(F);
  while (R <> []) do
    h:= R[1]; R:= subsop(1=NULL,R);           # h:= an element of R; R:= R- {h}
    h:= Reduce_PL (h,p,P,X);                  # h:= Reduce (h,P) mod p;
    if (indices(h) <> NULL) then              # h in table form => indices(h)
      HTh:= NumToTerm_PL(HMonomial_PL(h),X);  # HMonomial_PL is index to table
      P0:= NULL;
      for i to nops(P) do 
        HTp := NumToTerm_PL (HMonomial_PL(P[i]), X);
        if divide(HTp,HTh) then P0 := P0,i fi;         # if HTh | HT(p)
        # Divide(..) mod p not necessary because HT's in Zp[X]
      od;
      P0 := [P0];                             # P0 := [i: HT(h) | HT(P[i])];
      for i in P0 do R:=[op(R),P[i]] od;      # R := R + P0;
      for i in P0 do P:=subsop(i=NULL,P) od;  # P := P - P0;
      P := [op(P), op(h)];                    # P := P + {h}
    fi;
  od;
  P;
end:

NewBasis_PL := proc(F,X,p) local R,i,h,h1,n, HI,HT,HC;      # p = prime modulus
  n:= nops(F); R:=[];              # R must be list; a sequence didn't work (?)
  HI := map(HMonomial_PL,F);                      # head terms = indices of F(i)
  HT := [ seq(NumToTerm_PL(HI[i],X), i=1..n) ];   # head terms of polynomials 
  HC := [ seq(F[i][HI[i]], i=1..n) ];             # head coeffs = table entries
  for i to n do
    h:=Reduce_PL(F[i],p,subsop(i=NULL,F),X,subsop(i=NULL,HT),subsop(i=NULL,HC),subsop(i=NULL,HI));
    h1 := copy(h);                                # necessary !!
    if (indices(h1) <> NULL) then R:= [op(R),op(h1)]; fi;
   od;
  R
end:

InterReduce_PL := proc (F,X,p) local R;                # p = prime modulus
  R:=ReduceAll_PL (F,X,p);
  NewBasis_PL (R,X,p);
end:


#------------------------------------------------------------------------------
# Auxiliary procedures 
#------------------------------------------------------------------------------

HMonomial_PL := proc(q) local inds;            # q in table representation 
  inds := map(op,[indices(q)]) ;               # => get index (exponent vector)
  if inds = [] then 0 else max(op(inds)) fi    # of the plex headterm.
end:

SPoly_PL := proc(poly1,hc1,ht1, poly2,hc2,ht2, lcmij, X,p)  # lcmij = LCMHT[i,j]
  local u1,u2,cm1,cm2;
  Gcd(hc1,hc2,'cm2','cm1') mod p;              # mod p
  u1 := TermToNum_PL( lcmij/ht1 , X) ; 
  u2 := TermToNum_PL( lcmij/ht2 , X) ;
  TabSub(TabCTMul_PL(cm1,u1,poly1,p), TabCTMul_PL(cm2,u2,poly2,p), p);
  # (p1*u1*cm1 - p*u2*cm2) mod p
end:

#==============================================================================
# TOTAL DEGREE TERM ORDERING OVER Zp(a,b,..)[x1,...,xn] : ptdeg (PT)
# -----------------------------------------------------------------------------
# Implementation of Buchberger's algorithm for computing Grobner bases (GB)
# over Zp(a,b..)[X] using total degree term ordering. GB(F,X) computes the
# reduced, mimimal Grobner basis for a set of polynomials F over Zp(a,b..)[X]. 
# Author : A. Pirklbauer June 14, 1992
# The implemented algorithm is :
#
#    procedure GB (F);	  			    #  F = {f1,...fn}
#      G := InterReduce(Q); k:= length(G);
#      B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
#      while B # {} do
#	 [i,j] := SelectPair (B,G);  B:= B - {[i,j]};
#	 if Crit1 ([i,j],B,G) then
#	   h := Reduce (SPoly(Gi,Gj),G);
#          if h # 0 then
#            G:= G + {h}; k:= k+1;
#            B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)};
#          endif;
#        endif;
#      endwhile;
#      redundant:= {h in G: R(h,G) # {h}};
#      return (InterReduce(G-redundant));
#    end GB;
#
#------------------------------------------------------------------------------
#
#  - Because the coefficient domains are rational functions (over Zp), i.e.
#    free parameters may be present, in [Czapor86] it is suggested that
#    polynomials are represented in "partially distributed form". That is,
#    each term over X appears only once, with a fully distributed coefficient.
#  - This is necessary, primarily because of space considerations [Czapor86],
#    so we do a separate implementation for pplex and ptdeg.
#  - A polynomial is represented by a sparse table whose indices are the terms
#    of the polynomials and whose entries are the corresponding coefficients.
#  - All operations use this polynomial representation.
#
#------------------------------------------------------------------------------

GB_ptdeg := proc (F,X,p)    # p = prime modulus, F already in Zp(a,b,..)[X]
  local k,B,memberB,HI,HC,HT,LCMHT,G,G1,i,j,h,h1,spoly,found,indB,lcmij,
        nec_reds, unnec_reds, total_time;

   nec_reds:=0; unnec_reds:=0; total_time:= time();
   B:= table(); memberB:= table(symmetric); LCMHT:= table();

   G := map(PolyToTab_PT,F,X);           # convert to table representation
   userinfo(3,'GB',print(`F start = `, map(TabToPoly_PT,G,X)));
   G := InterReduce_PT (G,X,p);          # reduce each element modulo the others
   userinfo(3,'GB',print(`F after initial InterReduce =`,map(TabToPoly_PT,G,X)));
   k := nops(G);                         # k:= number of polynomials in G;
   HT:= map(HTerm_PT,G,X);               # head terms of polynomials 
   HC:= [ seq(G[i][HT[i]], i=1..k) ];    # head coeffs = table entries

   # B := {[i,j]: 1<=i<j<=k and Crit2(Gi,Gj)};
   for j from 2 to k do
     for i to (j-1) do
       if Crit2(HT,i,j) then InsertPair_T (i,j, B,memberB, LCMHT,HT, X) fi 
     od;
   od;
   userinfo(6,'GB',print(`Initial pair set B = `, B));
   
   # while B <> {} do ... od;
   do
     indB:= map(op,[indices(B)]);                # indices: "lex.degrees" of Gi
     if indB = [] then break fi;                 # <=> while B <> {} do ... od;
     
     SelectPair_T(B,memberB,indB,'i','j');           # does also: B:=B-{[i,j]};
     lcmij:=LCMHT[i,j]; LCMHT[i,j]:= evaln(LCMHT[i,j]);

     if Crit1(HT,lcmij,i,j,memberB) then 
       spoly := SPoly_PT (G[i],HC[i],HT[i], G[j],HC[j],HT[j], lcmij,p);
       h := Reduce_PT (spoly, p, G, X, HT,HC);                       # mod p
       userinfo(5,'GB',print(`SPoly (`,i,j,`) = `, TabToPoly_PT(spoly,X)));
       userinfo(3,'GB',print(`Reduce(SPoly (`,i,j,`), G) = `, TabToPoly_PT(h,X)));
       
       if (indices(h) <> NULL) then
          
          # G:= G + {h}; k:= k+1;
          h1 := copy(h);                              # necessary (?)
          G  := [ op(G), op(h1) ];  k:= k+1;
          HT := [ op(HT), HTerm_PT(h1,X) ];
          HC := [ op(HC), h1[HT[k]] ];
          userinfo(4,'GB',print(`Basis F = `, map(TabToPoly_PT,G,X)));
          
          # B:= B + {[i,k]: 1<=i<k and Crit2(Gi,Gk)}; 
          for i to (k-1) do
            if Crit2(HT,i,k) then InsertPair_T (i,k, B,memberB, LCMHT,HT, X) fi
          od;
          userinfo(6,'GB',print(`Pair set B = `, B));
         nec_reds := nec_reds + 1;
       else
         unnec_reds := unnec_reds + 1;
       fi
     fi
   od;

   # redundant:= {h in G: R(h,G) # {h}};  G1:= G - redundant
   G1:=[];                                    # must be a list, seq did not work
   for i to k do  found := false;
     for j to k while (not found) do
       found := (i<>j) and (divide(HT[i],HT[j]));   # if HT(j) | HT(i)
       # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
     od;
     if (not found) then G1:= [op(G1),G[i]] fi;
   od;

   G:= InterReduce_PT (G1,X,p);    # mod p
   G:= map(TabToPoly_PT,G,X);      # convert back to polynomial representation
   G:= map(Primpart,G,X) mod p;
   total_time := time()-total_time;
   
   userinfo(3,'GB',print(`F before final InterReduce = `,map(TabToPoly_PT,G1,X)));
   userinfo(3,'GB',print(`F after final InterReduce = `, G));
   userinfo(2,'GB',
     print(`Reductions :  necessary = `,nec_reds,` unnecessary = `,unnec_reds));
   userinfo(2,'GB',print(`Total time : `,total_time));
   
   RETURN (G);
end:



#===============================================================================
# Full Reduction of a polynomial p modulo a set of polynomials Q
# Definition: the reducer set R(p,Q) := {q in Q such that HT(q) | HT(p) }
# Total degree term ordering.
# The algebraic operations are done in the table representation of polynomials.
#
#    procedure Reduce(p,Q);                   # Q = {q1,q2,...,qn}
#      r:= p; s:= 0;
#      while r # 0 do
#        while R(r,Q) # {} do
#          q := SelectPoly(R(r,Q));           # select a reducer from Q
#          r := r - (M(r)/M(q)) * q;
#        endwhile;
#        s:= s + M(r); r:= r - M(r);
#      endwhile;
#      return (s);
#    end Reduce;
#
#---------------------------------------------------------------------------

ComputeReducers_PT := proc (r,Q,X,HT) local i,n,htr,quo,reds;
  # precondition: HT[i] = headterm(Q[i])
  if (indices(r) = NULL) then RETURN ([]) fi;      # important !
  n  := nops(Q);
  htr := HTerm_PT(r,X);                            # htr := HT(r)
  reds:= NULL;                                     # reducer set R(r,Q)
  for i to n do
    if (divide (htr, HT[i],'quo')) then     # if HT(i) | HT(r)
      reds:= reds, [i,quo] ;                # add Q[i] (the index) to reducers
    fi;
    # Divide(..) mod p not necessary because HT's already in Zp[x1...xn]
  od;
  [reds];
end:

SelectPoly_PT := proc(reducers,quo)     # precondition: reducers <> {}
  quo := op(1, reducers)[2];
  op(1, reducers)[1];                   # take the first one (return index to Q)
end:


Reduce_PT:= proc(poly,p,Q,X,HT,HC)                # p = prime modulus
  local q,r,s,reds,quo,ht,hcr,hcq,HC1,HT1,i,n,m1,m2,scale,d;
  # precondition: HT[i] = hterm(Q[i]),  HC[i] = hcoeff(Q[i])
  if (indices(poly)=NULL) then RETURN (op(poly)) fi;
  n:= nops(Q);
  if (nargs = 4) then
    HT1:= map(HTerm_PT,Q,X);                      # head terms of polynomials 
    HC1:= [ seq(Q[i][HT1[i]], i=1..n) ];          # head coeffs = table entries
  else
    HC1:= HC; HT1:= HT;
  fi;
  
  r:= copy(poly); s:=table('sparse');               # r:=poly; s:=0;  (as tables)
  while (indices(r) <> NULL) do 
    reds := ComputeReducers_PT (r,Q,X,HT1);       # compute R(r,Q)  (indices)
    scale:=1;                                     # rescale s (mult by m1 below)
    while reds <> [] do
      i := SelectPoly_PT (reds,'quo'); q:= Q[i];  # quo:= HT(r)/HT(q);  q = poly
      ht:=HTerm_PT(r,X); hcr:=r[ht]; hcq:=HC1[i]; # head index/coeff. of r/q
      Gcd(hcq,hcr,'m1','m2') mod p;               # m1*hcq = m2*hcr =gcd (mod p)
      # TabMul/TabAddTo/TabCTMul_PT are time critical(65% of time in inner loop)
      TabCMul(m1,r,p); scale:= (m1*scale) mod p;  # mod p
      d := TabCTMul_PT(-m2,quo,q,p);              # d:= m2*(HT(r)/HT(q)) (mod p)
      TabAddTo (r,d,1,p);                         # r:= m1*r - d*q (mod p)
      reds := ComputeReducers_PT (r,Q,X,HT1);
    od;
    if (indices(r) = NULL) then break fi;         # IMPORTANT !!
    ht:= HTerm_PT(r,X);  hcr:= r[ht];             # head index/coefficient of r
    TabCMul (scale, s, p);                        # rescale s (mod p)
    s[ht]:= Expand(hcr) mod p;                    # s:= s + M(r);
    r[ht]:= evaln(r[ht]);                         # r:= r - M(r);
  od;
  ht := HTerm_PT(s,X); TabRemoveCont(s,ht,p);
  if sign(s[ht])=-1 then TabCMul(-1,s,p) fi;
  op(s);                                          # return primpart of s
end:

#===========================================================================
# 
# InterReduce(F,X): reduce each polynomial F[i] modulo the other polynomials
#                   Ref: [1]: "Grobner Bases: An algorithmic method..."(Buchb85)
#                        [2]: Algorithm 10.3. in the Geddes textbook
#
#    procedure ReduceAll(F)          # remove any redundant elements
#      R:= F;  P:= {};
#      while R # {} do                     # P = {irreducible polynomials}
#        h:= an element of R;  R:= R-{h};  # R = {still reducible polynomials}
#        h:= Reduce (h,P);
#        if h # 0 then
#          P0 := {p in P: HT(h) | HT(p)};  # those which can be reduced by h
#          P := P - P0;                    # remove them from P = {irr. polys}
#          R := R + P0;                    # and add them to R = {red. polys}
#          P := P + {h};
#        fi;
#      end;
#      P;
#    end ReduceAll;
#  
#    procedure NewBasis (F)          # reduce each polynomial modulo the others
#      R := {};
#      for i from 1 to n do  f:= F[i];
#        h := Reduce (f, F - {f});         # reduce each F[i] modulo the others
#        if h <> 0 then R := R + {h} fi;
#      od;
#      R
#    end NewBasis;
#
#    procedure InterReduce (F)       # Construction of a reduced ideal basis
#      NewBasis (ReduceAll(F))
#    end InterReduce;
#
#---------------------------------------------------------------------------
#

ReduceAll_PT := proc(F,X,p)  local R,P,P0,h,i, HTh,HTp;    # p = prime modulus
  R:= F;  P:= [];     # R:=copy(F);
  while (R <> []) do
    h:= R[1]; R:= subsop(1=NULL,R);           # h:= an element of R; R:= R- {h}
    h:= Reduce_PT (h,p,P,X);                  # h:= Reduce (h,P) mod p;
    if (indices(h) <> NULL) then              # h in table form => indices(h)
      HTh:= HTerm_PT(h,X);                    # HTerm_PT is index to table
      P0:= NULL;
      for i to nops(P) do 
        HTp := HTerm_PT(P[i],X);
        if divide(HTp,HTh) then P0 := P0,i fi;                  # if HTh | HT(p)
        # Divide(..) mod p not necessary because HT's in Zp[X]
      od;
      P0 := [P0];                             # P0 := [i: HT(h) | HT(P[i])];
      for i in P0 do R:=[op(R),P[i]] od;      # R := R + P0;
      for i in P0 do P:=subsop(i=NULL,P) od;  # P := P - P0;
      P := [op(P), op(h)];                    # P := P + {h}
    fi;
  od;
  P;
end:

NewBasis_PT := proc(F,X,p) local R,i,h,h1,n,HT,HC;         # p = prime modulus
  n:= nops(F); R:=[];              # R must be list; a sequence didn't work (?)
  HT := map(HTerm_PT,F,X);                        # head terms of polynomials 
  HC := [ seq(F[i][HT[i]], i=1..n) ];             # head coeffs = table entries
  for i to n do
    h:=Reduce_PT(F[i],p,subsop(i=NULL,F),X,subsop(i=NULL,HT),subsop(i=NULL,HC));
    h1 := copy(h);                                # necessary !!
    if (indices(h1) <> NULL) then R:= [op(R),op(h1)]; fi;
  od;
  R
end:

InterReduce_PT := proc (F,X,p) local R;                # p = prime modulus
  R:=ReduceAll_PT (F,X,p);
  NewBasis_PT (R,X,p);
end:


#------------------------------------------------------------------------------
# Auxiliary procedures
#------------------------------------------------------------------------------

HTerm_PT := proc(q,X);                    # find tot.deg. headterm of q (table)
  THTerm_PT (map(op,{indices(q)}),X)
end:

# find the (total degree) headterm of a SET of terms
THTerm_PT := proc(s,X) local poly,t,i,d,n,Y,ht;   # taken from the Maple impl.
   poly := convert(s,`+`);
   n := nops(X); Y := ['X[n-i+1]'$i=1..n];
   t := 0 ; d := degree(poly) ;
   for i to nops(s) do
     op(i,s);
     if degree(") = d then t := t + " fi
   od;
   tcoeff(t,Y,'ht');
   ht
end:

SPoly_PT := proc(poly1,hc1,ht1, poly2,hc2,ht2, lcmij,p)  # lcmij = LCMHT[i,j]
  local u1,u2,cm1,cm2;
  Gcd(hc1,hc2,'cm2','cm1') mod p;            # mod p
  u1 := lcmij/ht1; 
  u2 := lcmij/ht2;
  TabSub(TabCTMul_PT(cm1,u1,poly1,p), TabCTMul_PT(cm2,u2,poly2,p), p)  
  # (p1*u1*cm1 - p*u2*cm2) mod p
end:

`help/text/GB` := TEXT(
`FUNCTION: GB - compute reduced, minimal Grobner basis over Zp`,
`      `,
`CALLING SEQUENCE:`,
`   GB(F,X) mod p`,
`   GB(F,X,termorder) mod p`,
`      `,
`PARAMETERS:`,
`   F         - set or list of polynomials`,
`   X         - list of indeterminates (not including parameters)`,
`   termorder - term ordering: ``plex`` (pure lexicographic is default) or `,
`               ``tdeg`` (total degree)`,
`   p         - a prime`,
`      `,
`SYNOPSIS:  `,
`- GB is an implementation of Buchberger's algorithm for computing Grobner bases`,
`  over Zp(a,b,...)[x1, ..., xn].`,
`   `,
`- GB(F,X,termorder) computes the reduced, minimal Grobner basis of the`,
`  polynomials F with respect to the indeterminates X and the given term order-`,
`  ing.   `,
`      `,
`- A list of indeterminates X:=[x_1,x_2 ,..., x_n] induces the ordering`,
`  x_1 > x_2 > ... > x_n .`,
`   `,
`- A trace of the computation steps can be obtained by assigning the variable`,
`  infolevel[GB] an apropriate value. Possible values are`,
`     1 => only the result (final Grobner basis) is printed (default)`,
`     2 => + statistics about reductions and time`,
`     3 => + each reduction step is printed`,
`     4 => + F after each reduction if new polynomials added`,
`     5 => + Now, also each S-Polynomial is printed`,
`     6 => + new pairs in B after each step (if added)`,
`      `,
`EXAMPLES:   `,
`> F := {7*x*y + y + 4*x, y + 2}:`,
`> GB(F,[x,y],plex) mod 5;`,
`                                      [1]`,
`   `,
`> GB(F,[x,y],plex) mod 7;`,
`                                 [y + 2, x + 3]`,
`   `,
`> F := [s^2/(2*s+1)*x^2*y-(s+1)*y, (3*s-1)/3*x*y^2-1/(s-1)*x]:`,
`> GB(F,[x,y],tdeg) mod 3;`,
`                             2  2        2         2`,
`                           [s  x  y + y s  + 2 y, y ]`,
`      `,
`REFERENCES: A. Pirklbauer, Groebner Basen ueber endlichen Koerpern`,
`   (Groebner Bases over finite fields), diploma thesis, ETH Zuerich,`,
`   1992.   `,
`   `,
`SEE ALSO:  Normalform, grobner, grobner[gbasis], infolevel`
):

`help/text/Normalform` := TEXT(
`FUNCTION: Normalform - reduced form of a polynomial over Zp modulo an ideal`,
`       `,
`CALLING SEQUENCE:`,
`   Normalform(poly, F, X) mod p`,
`   Normalform(poly, F, X, termorder) mod p`,
`   `,
`PARAMETERS:`,
`   F         - set or list of polynomials (normally, a Grobner basis)`,
`   X         - list of indeterminates (not including free parameters)`,
`   poly      - the polynomial to be reduced`,
`   termorder - term ordering: ``plex`` (pure lexicographic is default) or `,
`               ``tdeg`` (total degree)`,
`   p         - a prime`,
`   `,
`SYNOPSIS:   `,
`- The command Normalform(poly,F,X,termorder) computes the fully reduced form of`,
`  poly with respect to the ideal basis F, indeterminates X, and term ordering`,
`  termorder (either 'plex' for pure lexicographic ordering, or 'tdeg' for total`,
`  degree ordering).`,
`   `,
`- Usually, one first computes a Grobner basis for a set of polynomials (alge-`,
`  braic equations, or side relations) via GB, for use as the`,
`  reducing basis F.  Note: F must be a Grobner basis with respect to X, ter-`,
`  morder (and not with respect to some permutation of X, for example).`,
`   `,
`- The function Normalform yields a canonical form for polynomials modulo the ideal`,
`  generated by F if F is a Grobner basis.`,
`   `,
`EXAMPLES:   `,
`> F := [x^2 - 2*x*z + 5, x*y^2 + y*z^3, 3*y^2 - 8*z^3]:   X := [x,y,z]:`,
`> G := GB(F,X,tdeg) mod 5;`,
`               2           2      3     3      3     4      6   7    8`,
`        G := [x  + 3 x z, y  + 4 z , y z  + x z , y z  + 3 z , z  + z ]`,
`   `,
`> p := 4*y^4*x+4*z^2*y^4*x+2*y^5*x*z+3*x*z*y^3:`,
`> Normalform(p,G,X,tdeg) mod 5;`,
`                                       0`,
`   `,
`> q := 3*x^3*y*z^2 + 4*x*z^2 + y^3 + y*z:`,
`> Normalform(q,G,X,tdeg) mod 5;`,
`                           2        3            2  3`,
`                          z  x + 4 y  + 4 z y + z  y`,
`    `,
`> F := [s^2/(2*s+1)*x^2*y-(s+1)*y, (2*s-1)/2*x*y^2-1/(s-1)*x]:`,
`> G := GB(F,[x,y]) mod 3;`,
`          2  2        2         2  2    2  4    2  2    2         3  2      3`,
` G := [x y  s  + 2 x y  + 2 x, s  x  + y  s  + y  s  + y , 2 y + y  s  + 2 y ]`,
`   `,
`> p := F[1]*(Randpoly(3,x) mod 3) + F[2]*(Randpoly(2,y) mod 3):`,
`> Normalform(p, G, [x,y]) mod 3;`,
`                                       0`,
`   `,
`SEE ALSO: GB, grobner, grobner[normalf], infolevel`
):

#save `GB.m`;
#done
