passagemath-singular 10.6.31rc3__cp314-cp314-manylinux_2_27_x86_64.manylinux_2_28_x86_64.whl

sage_wheels/share/singular/LIB/zeroset.lib

@@ -0,0 +1,1478 @@
+////////////////////////////////////////////////////////////////////////////
+version="version zeroset.lib 4.3.2.3 Jun_2023 "; // $Id: f3f3a9c6b6c1586b5d0432bcfd680c79c45167a0 $
+category="Symbolic-numerical solving";
+info="
+LIBRARY:  zeroset.lib      Procedures for roots and factorization
+AUTHOR:   Thomas Bayer,    email: tbayer@mathematik.uni-kl.de,@*
+          http://wwwmayr.informatik.tu-muenchen.de/personen/bayert/@*
+          Current address: Hochschule Ravensburg-Weingarten
+
+OVERVIEW:
+ Algorithms for finding the zero-set of a zero-dim. ideal in Q(a)[x_1,..,x_n],
+ roots and factorization of univariate polynomials over Q(a)[t]
+ where a is an algebraic number. Written in the scope of the
+ diploma thesis (advisor: Prof. Gert-Martin Greuel) 'Computations of moduli
+ spaces of semiquasihomogeneous singularities and an implementation in Singular'.
+ This library is meant as a preliminary extension of the functionality
+ of Singular for univariate factorization of polynomials over simple algebraic
+ extensions in characteristic 0.
+
+NOTE:
+ Subprocedures with postfix 'Main' require that the ring contains a variable
+ 'a' and no parameters, and the ideal 'mpoly', where 'minpoly' from the
+ basering is stored.
+
+PROCEDURES:
+ Quotient(f, g)    quotient q  of f w.r.t. g (in f = q*g + remainder)
+ remainder(f,g)    remainder of the division of f by g
+ roots(f)    computes all roots of f in an extension field of Q
+ sqfrNorm(f)    norm of f (f must be squarefree)
+ zeroSet(I)    zero-set of the 0-dim. ideal I
+
+ egcdMain(f, g)    gcd over an algebraic extension field of Q
+ factorMain(f)    factorization of f over an algebraic extension field
+ invertNumberMain(c)  inverts an element of an algebraic extension field
+ quotientMain(f, g)  quotient of f w.r.t. g
+ remainderMain(f,g)  remainder of the division of f by g
+ rootsMain(f)    computes all roots of f, might extend the ground field
+ sqfrNormMain(f)  norm of f (f must be squarefree)
+ containedQ(data, f)  f in data ?
+ sameQ(a, b)    a == b (list a,b)
+";
+
+LIB "primitiv.lib";
+LIB "primdec.lib";
+
+// note : return a ring : ring need not be exported !!!
+
+// Arithmetic in Q(a)[x] without built-in procedures
+// assume basering = Q[x,a] and minpoly is represented by mpoly(a).
+// the algorithms are taken from "Polynomial Algorithms in Computer Algebra",
+// F. Winkler, Springer Verlag Wien, 1996.
+
+
+// To do :
+// squarefree factorization
+// multiplicities
+
+// Improvement :
+// a main problem is the growth of the coefficients. Try roots(x7 - 1)
+// return ideal mpoly !
+// mpoly is not monic, comes from primitive_extra
+
+// IMPLEMENTATION
+//
+// In procedures with name 'proc-name'Main a polynomial ring over a simple
+// extension field is represented as Q[x...,a] together with the ideal
+// 'mpoly' (attribute "isSB"). The arithmetic in the extension field is
+// implemented in the procedures in the procedures 'MultPolys' (multiplication)
+// and 'InvertNumber' (inversion). After addition and subtraction one should
+// apply 'SimplifyPoly' to the result to reduce the result w.r.t. 'mpoly'.
+// This is done by reducing each coefficient separately, which is more
+// efficient for polynomials with many terms.
+
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc roots(poly f)
+"USAGE:   roots(f); where f is a polynomial
+PURPOSE: compute all roots of f in a finite extension of QQ
+         without multiplicities.
+RETURN:  ring, a polynomial ring over an extension field of QQ,
+         containing a list 'theRoots' and polynomials 'newA' and 'f':
+  @format
+  - 'theRoots' is the list of roots of the polynomial f (no multiplicities)
+  - if the ground field is Q(a') and the extension field is Q(a), then
+    'newA' is the representation of a' in Q(a).
+    If the basering contains a parameter 'a' and the minpoly remains unchanged
+    then 'newA' = 'a'.
+    If the basering does not contain a parameter then 'newA' = 'a' (default).
+  - 'f' is the polynomial f in Q(a) (a' being substituted by 'newA')
+  @end format
+ASSUME:  ground field to be Q or a simple extension of Q given by a minpoly
+EXAMPLE: example roots; shows an example
+"
+{
+  ASSUME(0,char(basering)==0);
+  int dbPrt = printlevel-voice+3;
+
+  // create a new ring where par(1) is replaced by the variable
+  // with the same name or, if basering does not contain a parameter,
+  // with a new variable 'a'.
+
+  def ROB = basering;
+  def ROR = TransferRing(basering);
+  setring ROR;
+  export(ROR);
+
+  // get the polynomial f and find the roots
+
+  poly f = imap(ROB, f);
+  list result = rootsMain(f);  // find roots of f
+
+  // store the roots and the new representation of 'a' and transform
+  // the coefficients of f.
+
+  list theRoots = result[1];
+  poly newA = result[2];
+  map F = basering, maxideal(1);
+  F[nvars(basering)] = newA;
+  poly fn = SimplifyPoly(F(f));
+
+  // create a new ring with minploy = mpoly[1] (from ROR)
+
+  def RON = NewBaseRing();
+  setring(RON);
+  list theRoots = imap(ROR, theRoots);
+  poly newA = imap(ROR, newA);
+  poly f = imap(ROR, fn);
+  kill ROR;
+  export(theRoots);
+  export(newA);
+  export(f); dbprint(dbPrt,"
+// 'roots' created a new ring which contains the list 'theRoots' and
+// the polynomials 'f' and 'newA'
+// To access the roots, newA and the new representation of f, type
+   def R = roots(f); setring R; theRoots; newA; f;
+");
+  return(RON);
+}
+example
+{"EXAMPLE:";  echo = 2;
+  ring R = (0,a), x, lp;
+  minpoly = a2+1;
+  poly f = x3 - a;
+  def R1 = roots(f);
+  setring R1;
+  minpoly;
+  newA;
+  f;
+  theRoots;
+  map F;
+  F[1] = theRoots[1];
+  F(f);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc rootsMain(poly f)
+"USAGE:   rootsMain(f); where f is a polynomial in Q[a,x]
+PURPOSE: compute all roots of f in a finite extension of the QQ
+         without multiplicities.
+RETURN:  list, all entries are polynomials
+  @format
+  _[1] = roots of f, each entry is a polynomial
+  _[2] = 'newA' - if the ground field is Q(b) and the extension field
+         is Q(a), then 'newA' is the representation of b in Q(a)
+  _[3] = minpoly of the algebraic extension of the ground field
+  @end format
+ASSUME:  basering = Q[x,a] ideal mpoly must be defined, it might be 0!
+NOTE:    might change the ideal mpoly!!
+EXAMPLE: example rootsMain; shows an example
+"
+{
+  int i, linFactors, nlinFactors, dbPrt;
+  intvec wt = 1,0;    // deg(a) = 0
+  list factorList, nlFactors, nlMult, roots, result;
+  poly fa, lc;
+
+  dbPrt = printlevel-voice+3;
+
+  // factor f in Q(a)[t] to obtain the roots lying in Q(a)
+  // firstly, find roots of the linear factors,
+  // nonlinear factors are processed later
+
+  dbprint(dbPrt, "roots of " + string(f) +  ", minimal polynomial = " + string(mpoly[1]));
+  factorList = factorMain(f);          // Factorize f
+  dbprint(dbPrt, (" prime factors of f are : " + string(factorList[1])));
+
+  linFactors = 0;
+  nlinFactors = 0;
+  for(i = 2; i <= size(factorList[1]); i = i + 1) {  // find linear and nonlinear factors
+    fa = factorList[1][i];
+    if(deg(fa, wt) == 1) {
+      linFactors++;        // get the root from the linear factor
+      lc = LeadTerm(fa, 1)[3];
+      fa = MultPolys(invertNumberMain(lc), fa); // make factor monic
+      roots[linFactors] = var(1) - fa;  // fa is monic !!
+    }
+    else {            // ignore nonlinear factors
+      nlinFactors++;
+      nlFactors[nlinFactors] = factorList[1][i];
+      nlMult[nlinFactors] = factorList[2][i];
+    }
+  }
+  if(linFactors == size(factorList[1]) - 1) {    // all roots of f are contained in the ground field
+    result[1] = roots;
+    result[2] = var(2);
+    result[3] = mpoly[1];
+    return(result);
+  }
+
+  // process the nonlinear factors, i.e., extend the ground field
+  // where a nonlinear factor (irreducible) is a minimal polynomial
+  // compute the primitive element of this extension
+
+  ideal primElem, minPolys, Fid;
+  list partSol;
+  map F, Xchange;
+  poly f1, newA, mp, oldMinPoly;
+
+  Fid = mpoly;
+  F[1] = var(1);
+  Xchange[1] = var(2);      // the variables have to be exchanged
+  Xchange[2] = var(1);      // for the use of 'primitive'
+
+  if(nlinFactors == 1)             // one nl factor
+  {
+    // compute the roots of the nonlinear (irreducible, monic) factor f1 of f
+    // by extending the basefield by a' with minimal polynomial f1
+    // Then call roots(f1) to find the roots of f1 over the new base field
+
+    f1 = nlFactors[1];
+    if(mpoly[1] != 0)
+    {
+      mp = mpoly[1];
+      minPolys = Xchange(mp), Xchange(f1);
+      if (deg(jet(minPolys[2],0,intvec(1,0)))==0)
+      { primElem = primitive(minPolys); } // random coord. change
+      else
+      { primElem = primitive_extra(minPolys); } // no random coord. change
+      mpoly = std(primElem[1]);
+      F = basering, maxideal(1);
+      F[2] = primElem[2];      // transfer all to the new representation
+      newA = primElem[2];      // new representation of a
+      f1 = SimplifyPoly(F(f1));     //reduce(F(f1), mpoly);
+      if(size(roots) > 0) {roots = SimplifyData(F(roots));}
+    }
+    else {
+      mpoly = std(Xchange(f1));
+      newA = var(2);
+    }
+    result[3] = mpoly[1];
+    oldMinPoly = mpoly[1];
+    partSol = rootsMain(f1);    // find roots of f1 over extended field
+
+    if(oldMinPoly != partSol[3]) {    // minpoly has changed ?
+      // all previously computed roots must be transformed
+      // because the minpoly has changed
+      result[3] = partSol[3];    // new minpoly
+      F[2] = partSol[2];    // new representation of algebraic number
+      if(size(roots) > 0) {roots = SimplifyData(F(roots)); }
+      newA = SimplifyPoly(F(newA)); // F(newA);
+    }
+    roots = roots + partSol[1];  // add roots
+    result[2] = newA;
+    result[1] = roots;
+  }
+  else {  // more than one nonlinear (irreducible) factor (f_1,...,f_r)
+    // solve each of them by rootsMain(f_i), append their roots
+    // change the minpoly and transform all previously computed
+    // roots if necessary.
+    // Note that the for-loop is more or less book-keeping
+
+    newA = var(2);
+    result[2] = newA;
+    for(i = 1; i <= size(nlFactors); i = i + 1) {
+      oldMinPoly = mpoly[1];
+      partSol = rootsMain(nlFactors[i]);    // main work
+      nlFactors[i] = 0;        // delete factor
+      result[3] = partSol[3];        // store minpoly
+
+      // book-keeping starts here as in the case 1 nonlinear factor
+
+      if(oldMinPoly != partSol[3]) { // minpoly has changed
+        F = basering, maxideal(1);
+        F[2] = partSol[2];    // transfer all to the new representation
+        newA = SimplifyPoly(F(newA));    // F(newA); new representation of a
+        result[2] = newA;
+        if(i < size(nlFactors)) {
+          nlFactors = SimplifyData(F(nlFactors));
+        } // transform remaining factors
+        if(size(roots) > 0) {roots = SimplifyData(F(roots));}
+      }
+      roots = roots + partSol[1];    // transform roots
+      result[1] = roots;
+    }  // end more than one nl factor
+
+  }
+  return(result);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc zeroSet(ideal I, list #)
+"USAGE:   zeroSet(I [,opt] ); I=ideal, opt=integer
+PURPOSE: compute the zero-set of the zero-dim. ideal I, in a finite extension
+         of QQ.
+RETURN:  ring, a polynomial ring over an extension field of QQ,
+         containing a list 'theZeroset', a polynomial 'newA', and an
+         ideal 'id':
+  @format
+  - 'theZeroset' is the list of the zeros of the ideal I, each zero is an ideal.
+  - if the ground field is Q(b) and the extension field is Q(a), then
+    'newA' is the representation of b in Q(a).
+    If the basering contains a parameter 'a' and the minpoly remains unchanged
+    then 'newA' = 'a'.
+    If the basering does not contain a parameter then 'newA' = 'a' (default).
+  - 'id' is the ideal I in Q(a)[x_1,...] (a' substituted by 'newA')
+  @end format
+ASSUME:  dim(I) = 0, and ground field to be Q or a simple extension of Q given
+         by a minpoly.
+OPTIONS: opt = 0: no primary decomposition (default)
+         opt > 0: primary decomposition
+NOTE:    If I contains an algebraic number (parameter) then I must be
+         transformed w.r.t. 'newA' in the new ring.
+EXAMPLE: example zeroSet; shows an example
+"
+{
+  int primaryDecQ, dbPrt;
+  list rp;
+
+  dbPrt = printlevel-voice+2;
+
+  if(size(#) > 0) { primaryDecQ = #[1]; }
+  else { primaryDecQ = 0; }
+
+  // create a new ring 'ZSR' with one additional variable instead of the
+  // parameter
+  // if the basering does not contain a parameter then 'a' is used as the
+  // additional variable.
+
+  def RZSB = basering;
+  def ZSR = TransferRing(RZSB);
+  setring ZSR;
+
+  // get ideal I and find the zero-set
+
+  ideal id = std(imap(RZSB, I));
+//  print(dim(id));
+  if(dim(id) > 1) {       // new variable adjoined to ZSR
+    ERROR(" ideal not zerodimensional ");
+  }
+
+  list result = zeroSetMain(id, primaryDecQ);
+
+  // store the zero-set, minimal polynomial and the new representative of 'a'
+
+  list theZeroset = result[1];
+  poly newA = result[2];
+  poly minPoly = result[3][1];
+
+  // transform the generators of the ideal I w.r.t. the new representation
+  // of 'a'
+
+  map F = basering, maxideal(1);
+  F[nvars(basering)] = newA;
+  id = SimplifyData(F(id));
+
+  // create a new ring with minpoly = minPoly
+
+  def RZBN = NewBaseRing();
+  setring RZBN;
+
+  list theZeroset = imap(ZSR, theZeroset);
+  poly newA = imap(ZSR, newA);
+  ideal id = imap(ZSR, id);
+  kill ZSR;
+
+  export(id);
+  export(theZeroset);
+  export(newA);
+    dbprint(dbPrt,"
+// 'zeroSet' created a new ring which contains the list 'theZeroset', the ideal
+// 'id' and the polynomial 'newA'. 'id' is the ideal of the input transformed
+// w.r.t. 'newA'.
+// To access the zero-set, 'newA' and the new representation of the ideal, type
+   def R = zeroSet(I); setring R; theZeroset; newA; id;
+");
+  setring RZSB;
+  return(RZBN);
+}
+example
+{"EXAMPLE:";  echo = 2;
+  ring R = (0,a), (x,y,z), lp;
+  minpoly = a2 + 1;
+  ideal I = x2 - 1/2, a*z - 1, y - 2;
+  def T = zeroSet(I);
+  setring T;
+  minpoly;
+  newA;
+  id;
+  theZeroset;
+  map F1 = basering, theZeroset[1];
+  map F2 = basering, theZeroset[2];
+  F1(id);
+  F2(id);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc invertNumberMain(poly f)
+"USAGE:   invertNumberMain(f); where f is a polynomial in Q[a]
+PURPOSE: compute 1/f if f is a number in Q(a), i.e., f is represented by a
+         polynomial in Q[a].
+RETURN:  poly 1/f
+ASSUME:  basering = Q[x_1,...,x_n,a], ideal mpoly must be defined and != 0 !
+NOTE:    outdated, use / instead
+"
+{
+  if(diff(f, var(1)) != 0) { ERROR("number must not contain variable !");}
+
+  int n = nvars(basering);
+  def RINB = basering;
+  ring RINR = create_ring(0, string(var(n)), "dp");       // new ring = Q[a]
+
+  list gcdList;
+  poly f, g, inv;
+
+  f = imap(RINB, f);
+  g = imap(RINB, mpoly)[1];
+
+  if(diff(f, var(1)) != 0) { inv = extgcd(f, g)[2]; }  // f contains var(1)
+  else {  inv = 1/f;}          // f element in Q
+
+  setring(RINB);
+  return(imap(RINR, inv));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc MultPolys(poly f, poly g)
+"USAGE:   MultPolys(f, g); poly f,g in Q[a,x]
+PURPOSE: multiply the polynomials f and g and reduce them w.r.t. mpoly
+RETURN:  poly f*g
+ASSUME:  basering = Q[x,a], ideal mpoly must be defined, it might be 0 !
+"
+{
+  return(SimplifyPoly(f * g));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc LeadTerm(poly f, int i)
+"USAGE:   LeadTerm(f); poly f, int i
+PURPOSE: compute the leading coef and term of f w.r.t var(i), where the last
+         ring variable is treated as a parameter.
+RETURN:  list of polynomials
+         _[1] = leading term
+         _[2] = leading monomial
+         _[3] = leading coefficient
+ASSUME:  basering = Q[x_1,...,x_n,a]
+"
+{
+  list result;
+  matrix co = coef(f, var(i));
+  result[1] = co[1, 1]*co[2, 1];
+  result[2] = co[1, 1];
+  result[3] = co[2, 1];
+  return(result);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc Quotient(poly f, poly g)
+"USAGE:   Quotient(f, g); where f,g are polynomials
+PURPOSE: compute the quotient q and remainder r s.t. f = g*q + r, deg(r) < deg(g)
+RETURN:  list of polynomials
+  @format
+  _[1] = quotient  q
+  _[2] = remainder r
+  @end format
+ASSUME:  basering = Q[x] or Q(a)[x]
+NOTE: This procedure is outdated, and should no longer be used. Use div and mod
+instead.
+EXAMPLE: example Quotient; shows an example
+"
+{
+  def QUOB = basering;
+  def QUOR = TransferRing(basering);  // new ring with parameter 'a' replaced by a variable
+  setring QUOR;
+  export(QUOR);
+  poly f = imap(QUOB, f);
+  poly g = imap(QUOB, g);
+  list result = quotientMain(f, g);
+
+  setring(QUOB);
+  list result = imap(QUOR, result);
+  kill QUOR;
+  return(result);
+}
+example
+{"EXAMPLE:";  echo = 2;
+ ring R = (0,a), x, lp;
+ minpoly = a2+1;
+ poly f =  x4 - 2;
+ poly g = x - a;
+ list qr = Quotient(f, g);
+ qr;
+ qr[1]*g + qr[2] - f;
+}
+
+proc quotientMain(poly f, poly g)
+"USAGE:   quotientMain(f, g); where f,g are polynomials in Q(a)[x]
+PURPOSE: compute the quotient q and remainder r s.th. f = g*q + r, deg(r) < deg(g)
+RETURN:  list of polynomials
+  @format
+  _[1] = quotient  q
+  _[2] = remainder r
+  @end format
+ASSUME:  basering = Q[x,a] and ideal mpoly is defined (it might be 0),
+         this represents the ring Q(a)[x] together with its minimal polynomial.
+NOTE: outdated, use div/mod instead
+"
+{
+  if(g == 0) { ERROR("Division by zero !");}
+
+  def QMB = basering;
+  def QMR = NewBaseRing();
+  setring QMR;
+  poly f, g, h;
+  h = imap(QMB, f) / imap(QMB, g);
+  setring QMB;
+  return(list(imap(QMR, h), 0));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc remainder(poly f, poly g)
+"USAGE:   remainder(f, g); where f,g are polynomials
+PURPOSE: compute the remainder of the division of f by g, i.e. a polynomial r
+         s.t. f = g*q + r, deg(r) < deg(g).
+RETURN:  poly
+ASSUME:  basering = Q[x] or Q(a)[x]
+NOTE: outdated, use mod/reduce instead
+"
+{
+  def REMB = basering;
+  def REMR = TransferRing(basering);  // new ring with parameter 'a' replaced by a variable
+  setring(REMR);
+  export(REMR);
+  poly f = imap(REMB, f);
+  poly g = imap(REMB, g);
+  poly h = remainderMain(f, g);
+
+  setring(REMB);
+  poly r = imap(REMR, h);
+  kill REMR;
+  return(r);
+}
+example
+{"EXAMPLE:";  echo = 2;
+ ring R = (0,a), x, lp;
+ minpoly = a2+1;
+ poly f =  x4 - 1;
+ poly g = x3 - 1;
+ remainder(f, g);
+}
+
+proc remainderMain(poly f, poly g)
+"USAGE:   remainderMain(f, g); where f,g are polynomials in Q[a,x]
+PURPOSE: compute the remainder r s.t. f = g*q + r, deg(r) < deg(g)
+RETURN:  poly
+ASSUME:  basering = Q[x,a] and ideal mpoly is defined (it might be 0),
+         this represents the ring Q(a)[x] together with its minimal polynomial.
+NOTE: outdated, use mod/reduce instead
+"
+{
+  int dg;
+  intvec wt = 1,0;;
+  poly lc, g1, r;
+
+  if(deg(g, wt) == 0) { return(0); }
+
+  lc = LeadTerm(g, 1)[3];
+  g1 = MultPolys(invertNumberMain(lc), g);  // make g monic
+
+  return(SimplifyPoly(reduce(f, std(g1))));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc egcdMain(poly f, poly g)
+"USAGE:   egcdMain(f, g); where f,g are polynomials in Q[a,x]
+PURPOSE: compute the polynomial gcd of f and g over Q(a)[x]
+RETURN:  poly
+ASSUME:  basering = Q[x,a] and ideal mpoly is defined (it might be 0),
+         this represents the ring Q(a)[x] together with its minimal polynomial.
+NOTE: outdated, use gcd instead
+EXAMPLE: example EGCD; shows an example
+"
+{
+// might be extended to return s1, s2 s.t. f*s1 + g*s2 = gcd
+  int i = 1;
+  poly r1, r2, r;
+
+  r1 = f;
+  r2 = g;
+
+  while(r2 != 0) {
+    r  = remainderMain(r1, r2);
+    r1 = r2;
+    r2 = r;
+  }
+  return(r1);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc MEGCD(poly f, poly g, int varIndex)
+"USAGE:   MEGCD(f, g, i); poly f, g; int i
+PURPOSE: compute  the polynomial gcd of f and g in the i'th variable
+RETURN:  poly
+ASSUME:  f, g are polynomials in var(i), last variable is the algebraic number
+EXAMPLE: example MEGCD; shows an example
+"
+// might be extended to return s1, s2 s.t. f*s1 + g*s2 = gc
+// not used !
+{
+  string @str, @sf, @sg, @mp, @parName;
+
+  def @RGCDB = basering;
+
+  @sf = string(f);
+  @sg = string(g);
+  @mp = string(minpoly);
+
+  if(npars(basering) == 0) { @parName = "0";}
+  else { @parName = "(0, " + parstr(basering) + ")"; }
+  ring @RGCD = create_ring(@parName, string(var(varIndex)), "dp");
+  if(@mp != "0") { execute ("minpoly = " + @mp + ";"); }
+  execute("poly @f = " + @sf + ";");
+  execute("poly @g = " + @sg + ";");
+  export(@RGCD);
+  poly @h = gcd(@f, @g);
+  setring(@RGCDB);
+  poly h = imap(@RGCD, @h);
+  kill @RGCD;
+  return(h);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc sqfrNorm(poly f)
+"USAGE:   sqfrNorm(f); where f is a polynomial in Q(a)[x]
+PURPOSE: compute the norm of the squarefree polynomial f in Q(a)[x].
+RETURN:  list with 3 entries
+  @format
+  _[1] = squarefree norm of g (poly)
+  _[2] = g (= f(x - s*a)) (poly)
+  _[3] = s (int)
+  @end format
+ASSUME:  f must be squarefree, basering = Q(a)[x] and minpoly != 0.
+NOTE:    the norm is an element of Q[x]
+EXAMPLE: example sqfrNorm; shows an example
+"
+{
+  def SNB = basering;
+  def SNR = TransferRing(SNB);  // new ring with parameter 'a'
+                                // replaced by a variable
+  setring SNR;
+  poly f = imap(SNB, f);
+  list result = sqfrNormMain(f);  // squarefree norm of f
+
+  setring SNB;
+  list result = imap(SNR, result);
+  kill SNR;
+  return(result);
+}
+example
+{"EXAMPLE:";  echo = 2;
+   ring R = (0,a), x, lp;
+   minpoly = a2+1;
+  poly f =  x4 - 2*x + 1;
+  sqfrNorm(f);
+}
+
+proc sqfrNormMain(poly f)
+"USAGE:   sqfrNorm(f); where f is a polynomial in Q(a)[x]
+PURPOSE: compute the norm of the squarefree polynomial f in Q(a)[x].
+RETURN:  list with 3 entries
+  @format
+  _[1] = squarefree norm of g (poly)
+  _[2] = g (= f(x - s*a)) (poly)
+  _[3] = s (int)
+  @end format
+ASSUME:  f must be squarefree, basering = Q[x,a] and ideal mpoly is equal to
+         'minpoly', this represents the ring Q(a)[x] together with 'minpoly'.
+NOTE:   the norm is an element of Q[x]
+EXAMPLE: example SqfrNorm; shows an example
+"
+{
+  def SNRMB = basering;
+  int s = 0;
+  intvec wt = 1,0;
+  ideal mapId;
+  // list result;
+  poly g, N, N1, h;
+  string ringSTR;
+
+  mapId[1] = var(1) - var(2);    // linear transformation
+  mapId[2] = var(2);
+  map Fs = SNRMB, mapId;
+
+  N = resultant(f, mpoly[1], var(2));  // norm of f
+  N1 = diff(N, var(1));
+  g = f;
+
+  ring SNRM1 = create_ring(0, string(var(1)), "dp");     // univariate ring
+  poly N, N1, h;        // N, N1 do not contain 'a', use built-in gcd
+  h = gcd(imap(SNRMB, N), imap(SNRMB, N1));
+  setring(SNRMB);
+  h = imap(SNRM1, h);
+  while(deg(h, wt) != 0) {    // while norm is not squarefree
+    s = s + 1;
+    g = reduce(Fs(g), mpoly);
+    N = reduce(resultant(g, mpoly[1], var(2)), mpoly);  // norm of g
+    N1 = reduce(diff(N, var(1)), mpoly);
+    setring(SNRM1);
+    h = gcd(imap(SNRMB, N), imap(SNRMB, N1));
+    setring(SNRMB);
+    h = imap(SNRM1, h);
+  }
+  return(list(N, g, s));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc factorMain(poly f)
+"USAGE:   factorMain(f); where f is a polynomial
+PURPOSE: compute the factorization of the squarefree polynomial f over Q(a)[t],
+         minpoly  = p(a).
+RETURN:  list with 2 entries
+  @format
+  _[1] = factors, first is a constant
+  _[2] = multiplicities (not yet implemented)
+  @end format
+ASSUME:  basering = Q[x,a], representing Q(a)[x]. An ideal mpoly must
+         be defined, representing the minimal polynomial (it might be 0!).
+NOTE: outdated, use factorize instead
+EXAMPLE: example Factor; shows an example
+"
+{
+// extend this by a squarefree factorization !!
+// multiplicities are not valid !!
+  int i, s;
+  list normList, factorList, quo_rem;
+  poly f1, h, h1, H, g, leadCoef, invCoeff;
+  ideal fac1, fac2;
+  map F;
+
+  // if no minimal polynomial is defined then use 'factorize'
+  // FactorOverQ is wrapped around 'factorize'
+
+  if(mpoly[1] == 0) {
+    // print(" factorize : deg = " + string(deg(f, intvec(1,0))));
+    factorList = factorize(f); // FactorOverQ(f);
+    return(factorList);
+  }
+
+  // if mpoly != 0 and f does not contain the algebraic number, a root of
+  // f might be contained in Q(a). Hence one must not use 'factorize'.
+
+  fac1[1] = 1;
+  fac2[1] = 1;
+  normList = sqfrNormMain(f);
+  // print(" factorize : deg = " + string(deg(normList[1], intvec(1,0))));
+  factorList = factorize(normList[1]);     // factor squarefree norm of f over Q[x]
+  g = normList[2];
+  s = normList[3];
+  F[1] = var(1) + s*var(2);      // inverse transformation
+  F[2] = var(2);
+  fac1[1] = factorList[1][1];
+  fac2[1] = factorList[2][1];
+  for(i = 2; i <= size(factorList[1]); i = i + 1) {
+    H = factorList[1][i];
+    h = egcdMain(H, g);
+    quo_rem = quotientMain(g, h);
+    g = quo_rem[1];
+    fac1[i] = SimplifyPoly(F(h));
+    fac2[i] = 1;        // to be changed later
+  }
+  return(list(fac1, fac2));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc zeroSetMain(ideal I, int primDecQ)
+"USAGE:   zeroSetMain(ideal I, int opt); ideal I, int opt
+PURPOSE: compute the zero-set of the zero-dim. ideal I, in a simple extension
+         of the ground field.
+RETURN:  list
+         - 'f' is the polynomial f in  Q(a) (a' being substituted by newA)
+         _[1] = zero-set (list), is the list of the zero-set of the ideal I,
+                each entry is an ideal.
+         _[2] = 'newA';  if the ground field is Q(a') and the extension field
+                is Q(a), then 'newA' is the representation of a' in Q(a).
+                If the basering contains a parameter 'a' and the minpoly
+                remains unchanged then 'newA' = 'a'. If the basering does not
+                contain a parameter then 'newA' = 'a' (default).
+         _[3] = 'mpoly' (ideal), the minimal polynomial of the simple extension
+                of the ground field.
+ASSUME:  basering = K[x_1,x_2,...,x_n] where K = Q or a simple extension of Q
+         given by a minpoly; dim(I) = 0.
+NOTE:    opt = 0  no primary decomposition
+         opt > 0  use a primary decomposition
+EXAMPLE: example zeroSetMain; shows an example
+"
+{
+  // main work is done in zeroSetMainWork, here the zero-set of each ideal from the
+  // primary decomposition is computed by means of zeroSetMainWork, and then the
+  // minpoly and the parameter representing the algebraic extension are
+  // transformed according to 'newA', i.e., only bookkeeping is done.
+
+  def altring=basering;
+  int i, j, n, noMP, dbPrt;
+  intvec w;
+  list currentSol, result, idealList, primDecList, zeroSet;
+  ideal J;
+  map Fa;
+  poly newA, oldMinPoly;
+
+  dbPrt = printlevel-voice+2;
+  dbprint(dbPrt, "zeroSet of " + string(I) + ", minpoly = " + string(minpoly));
+
+  n = nvars(basering) - 1;
+  for(i = 1; i <= n; i++) { w[i] = 1;}
+  w[n + 1] = 0;
+
+  if(primDecQ == 0) { return(zeroSetMainWork(I, w, 0)); }
+
+  newA = var(n + 1);
+  if(mpoly[1] == 0) { noMP = 1;}
+  else {noMP = 0;}
+
+  primDecList = primdecGTZ(I);      // primary decomposition
+  dbprint(dbPrt, "primary decomposition consists of " + string(size(primDecList)) + " primary ideals ");
+  // idealList = PDSort(idealList);    // high degrees first
+
+  for(i = 1; i <= size(primDecList); i = i + 1) {
+    idealList[i] = primDecList[i][2];  // use prime component
+    dbprint(dbPrt, string(i) + "  " + string(idealList[i]));
+  }
+
+  // compute the zero-set of each primary ideal and join them.
+  // If necessary, change the ground field and transform the zero-set
+
+  dbprint(dbPrt, "
+find the zero-set of each primary ideal, form the union
+and keep track of the minimal polynomials ");
+
+  for(i = 1; i <= size(idealList); i = i + 1) {
+    J = idealList[i];
+    idealList[i] = 0;
+    oldMinPoly = mpoly[1];
+    dbprint(dbPrt, " ideal#" + string(i) + " of " + string(size(idealList)) + " = " + string(J));
+    currentSol = zeroSetMainWork(J, w, 0);
+
+    if(oldMinPoly != currentSol[3]) {   // change minpoly and transform solutions
+      dbprint(dbPrt, " change minpoly to " + string(currentSol[3][1]));
+      dbprint(dbPrt, " new representation of algebraic number = " + string(currentSol[2]));
+      if(!noMP) {      // transform the algebraic number a
+        Fa = basering, maxideal(1);
+        Fa[n + 1] = currentSol[2];
+        newA = SimplifyPoly(Fa(newA));  // new representation of a
+        if(size(zeroSet) > 0) {zeroSet = SimplifyZeroset(Fa(zeroSet)); }
+        if(i < size(idealList)) { idealList = SimplifyZeroset(Fa(idealList)); }
+      }
+      else { noMP = 0;}
+    }
+    zeroSet = zeroSet + currentSol[1];    // add new elements
+  }
+  return(list(zeroSet, newA, mpoly));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc zeroSetMainWork(ideal id, intvec wt, int sVars)
+"USAGE:   zeroSetMainWork(I, wt, sVars);
+PURPOSE: compute the zero-set of the zero-dim. ideal I, in a finite extension
+         of the ground field (without multiplicities).
+RETURN:  list, all entries are polynomials
+         _[1] = zeros, each entry is an ideal
+         _[2] = newA; if the ground field is Q(a') this is the rep. of a' w.r.t. a
+         _[3] = minpoly of the algebraic extension of the ground field (ideal)
+         _[4] = name of algebraic number (default = 'a')
+ASSUME:  basering = Q[x_1,x_2,...,x_n,a]
+         ideal mpoly must be defined, it might be 0!
+NOTE:    might change 'mpoly' !!
+EXAMPLE: example IdealSolve; shows an example
+"
+{
+  def altring=basering;
+  int i, j, k, nrSols, n, noMP;
+  ideal I, generators, gens, solid, partsolid;
+  list linSol, linearSolution, nLinSol, nonlinSolutions, partSol, sol, solutions, result;
+  list linIndex, nlinIndex, index;
+  map Fa, Fsubs;
+  poly oldMinPoly, newA;
+
+  if(mpoly[1] == 0) { noMP = 1;}
+  else { noMP = 0;}
+  n = nvars(basering) - 1;
+  newA = var(n + 1);
+
+  if(attrib(id,"isSB")) { I=id;} else { I = std(id);}
+
+  // find linear solutions of univariate generators
+
+  linSol = LinearZeroSetMain(I, wt);
+  generators = linSol[3];      // they are a standardbasis
+  linIndex = linSol[2];
+  linearSolution = linSol[1];
+  if(size(linIndex) + sVars == n) {    // all variables solved
+    solid = SubsMapIdeal(linearSolution, linIndex, 0);
+    result[1] = list(solid);
+    result[2] = var(n + 1);
+    result[3] = mpoly;
+    return(result);
+  }
+
+  // find roots of the nonlinear univariate polynomials of generators
+  // if necessary, transform linear solutions w.r.t. newA
+
+  oldMinPoly = mpoly[1];
+  nLinSol =  NonLinearZeroSetMain(generators, wt);    // find solutions of univariate generators
+  nonlinSolutions = nLinSol[1];    // store solutions
+  nlinIndex = nLinSol[4];     // and index of solved variables
+  generators = nLinSol[5];    // new generators
+
+  // change minpoly if necessary and transform the ideal and the partial solutions
+
+  if(oldMinPoly != nLinSol[3]) {
+    newA = nLinSol[2];
+    if(!noMP && size(linearSolution) > 0) {    // transform the algebraic number a
+      Fa = basering, maxideal(1);
+      Fa[n + 1] = newA;
+      linearSolution = SimplifyData(Fa(linearSolution));  // ...
+    }
+  }
+
+  // check if all variables are solved.
+
+  if(size(linIndex) + size(nlinIndex) == n - sVars) {
+    solutions = MergeSolutions(linearSolution, linIndex, nonlinSolutions, nlinIndex, list(), n);
+  }
+
+  else {
+
+  // some variables are not solved.
+  // substitute each partial solution in generators and find the
+  // zero set of the resulting ideal by recursive application
+  // of zeroSetMainWork !
+
+  index = linIndex + nlinIndex;
+  nrSols = 0;
+  for(i = 1; i <=  size(nonlinSolutions); i = i + 1) {
+    sol = linearSolution + nonlinSolutions[i];
+    solid = SubsMapIdeal(sol, index, 1);
+    Fsubs = basering, solid;
+    gens = std(SimplifyData(Fsubs(generators)));    // substitute partial solution
+    oldMinPoly = mpoly[1];
+    partSol = zeroSetMainWork(gens, wt, size(index) + sVars);
+
+    if(oldMinPoly != partSol[3]) {    // minpoly has changed
+      Fa = basering, maxideal(1);
+      Fa[n + 1] = partSol[2];    // a -> p(a), representation of a w.r.t. new minpoly
+      newA = reduce(Fa(newA), mpoly);
+      generators = std(SimplifyData(Fa(generators)));
+      if(size(linearSolution) > 0) { linearSolution = SimplifyData(Fa(linearSolution));}
+      if(size(nonlinSolutions) > 0) {
+        nonlinSolutions = SimplifyZeroset(Fa(nonlinSolutions));
+      }
+      sol = linearSolution + nonlinSolutions[i];
+    }
+
+    for(j = 1; j <= size(partSol[1]); j++) {   // for all partial solutions
+      partsolid = partSol[1][j];
+      for(k = 1; k <= size(index); k++) {
+        partsolid[index[k]] = sol[k];
+       }
+      nrSols++;
+      solutions[nrSols] = partsolid;
+    }
+  }
+
+  }  // end else
+  return(list(solutions, newA, mpoly));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc LinearZeroSetMain(ideal I, intvec wt)
+"USAGE:   LinearZeroSetMain(I, wt)
+PURPOSE: solve the univariate linear polys in I
+ASSUME:  basering = Q[x_1,...,x_n,a]
+RETURN:  list
+         _[1] = partial solution of I
+         _[2] = index of solved vars
+         _[3] = new generators (standardbasis)
+"
+{
+  def altring=basering;
+  int i, ok, n, found, nrSols;
+  ideal generators, newGens;
+  list result, index, totalIndex, vars, sol, temp;
+  map F;
+  poly f;
+
+  result[1] = index;      // sol[1] should be the empty list
+  n = nvars(basering) - 1;
+  generators = I;        // might be wrong, use index !
+  ok = 1;
+  nrSols = 0;
+  while(ok) {
+    found = 0;
+    for(i = 1; i <= size(generators); i = i + 1) {
+      f = generators[i];
+      vars = Variables(f, n);
+      if(size(vars) == 1 && deg(f, wt) == 1) {  // univariate,linear
+        nrSols++; found++;
+        index[nrSols] = vars[1];
+        sol[nrSols] = var(vars[1]) - MultPolys(invertNumberMain(LeadTerm(f, vars[1])[3]), f);
+      }
+    }
+    if(found > 0) {
+      F = basering, SubsMapIdeal(sol, index, 1);
+      newGens = std(SimplifyData(F(generators)));    // substitute, simplify alg. number
+      if(size(newGens) == 0) {ok = 0;}
+      generators = newGens;
+    }
+    else {
+      ok = 0;
+    }
+  }
+  if(nrSols > 0) { result[1] = sol;}
+  result[2] = index;
+  result[3] = generators;
+  return(result);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc NonLinearZeroSetMain(ideal I, intvec wt)
+"USAGE:   NonLinearZeroSetMain(I, wt);
+PURPOSE: solves the (nonlinear) univariate polynomials in I
+         of the ground field (without multiplicities).
+RETURN:  list, all entries are polynomials
+         _[1] = list of solutions
+         _[2] = newA
+         _[3] = minpoly
+         _[4] - index of solved variables
+         _[5] = new representation of I
+ASSUME:  basering = Q[x_1,x_2,...,x_n,a], ideal 'mpoly' must be defined,
+         it might be 0 !
+NOTE:    might change 'mpoly' !!
+"
+{
+  int i, nrSols, ok, n;
+  ideal generators;
+  list result, sols, index, vars, partSol;
+  map F;
+  poly f, newA;
+  string ringSTR;
+
+  def NLZR = basering;
+  export(NLZR);
+
+  n = nvars(basering) - 1;
+
+  generators = I;
+  newA = var(n + 1);
+  result[2] = newA;            // default
+  nrSols = 0;
+  ok = 1;
+  i = 1;
+  while(ok) {
+
+    // test if the i-th generator of I is univariate
+
+    f = generators[i];
+    vars = Variables(f, n);
+    if(size(vars) == 1) {
+      generators[i] = 0;
+      generators = simplify(generators, 2);    // remove 0
+      nrSols++;
+      index[nrSols] = vars[1];      // store index of solved variable
+
+      // create univariate ring
+
+      ring RIS1 = create_ring(0, "(" + string(var(vars[1])) + ", " + string(var(n+1)) + ")", "lp");
+      ideal mpoly = std(imap(NLZR, mpoly));
+      list roots;
+      poly f = imap(NLZR, f);
+      export(RIS1);
+      export(mpoly);
+      roots = rootsMain(f);
+
+      // get "old" basering with new minpoly
+
+      setring(NLZR);
+      partSol = imap(RIS1, roots);
+      kill RIS1;
+      if(mpoly[1] != partSol[3]) {      // change minpoly
+        mpoly = std(partSol[3]);
+        F = NLZR, maxideal(1);
+        F[n + 1] = partSol[2];
+        if(size(sols) > 0) {sols = SimplifyZeroset(F(sols)); }
+        newA = reduce(F(newA), mpoly);    // normal form
+        result[2] = newA;
+        generators = SimplifyData(F(generators));  // does not remove 0's
+      }
+      sols = ExtendSolutions(sols, partSol[1]);
+    } // end univariate
+    else {
+      i = i + 1;
+    }
+    if(i > size(generators)) { ok = 0;}
+  }
+  result[1] = sols;
+  result[3] = mpoly;
+  result[4] = index;
+  result[5] = std(generators);
+
+  kill NLZR;
+  return(result);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc ExtendSolutions(list solutions, list newSolutions)
+"USAGE:   ExtendSolutions(sols, newSols); list sols, newSols;
+PURPOSE: extend the entries of 'sols' by the entries of 'newSols',
+         each entry of 'newSols' is a number.
+RETURN:  list
+ASSUME:  basering = Q[x_1,...,x_n,a], ideal 'mpoly' must be defined,
+         it might be 0 !
+NOTE:    used by 'NonLinearZeroSetMain'
+"
+{
+  int i, j, k, n, nrSols;
+  list newSols, temp;
+
+  nrSols = size(solutions);
+  if(nrSols > 0) {n = size(solutions[1]);}
+  else {
+    n = 0;
+    nrSols = 1;
+  }
+  k = 0;
+  for(i = 1; i <= nrSols; i++) {
+    for(j = 1; j <= size(newSolutions); j++) {
+      k++;
+      if(n == 0) { temp[1] = newSolutions[j];}
+      else {
+        temp = solutions[i];
+        temp[n + 1] = newSolutions[j];
+      }
+      newSols[k] = temp;
+    }
+  }
+  return(newSols);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc MergeSolutions(list sol1, list index1, list sol2, list index2)
+"USAGE:   MergeSolutions(sol1, index1, sol2, index2); all parameters are lists
+RETURN:  list
+PURPOSE: create a list of solutions of size n, each entry of 'sol2' must
+         have size n. 'sol1' is one partial solution (from 'LinearZeroSetMain')
+         'sol2' is a list of partial solutions (from 'NonLinearZeroSetMain')
+ASSUME:  'sol2' is not empty
+NOTE:    used by 'zeroSetMainWork'
+{
+  int i, j, k, m;
+  ideal sol;
+  list newSols;
+
+  m = 0;
+  for(i = 1; i <= size(sol2); i++) {
+    m++;
+    newSols[m] = SubsMapIdeal(sol1 + sol2[i], index1 + index2, 0);
+  }
+  return(newSols);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc SubsMapIdeal(list sol, list index, int opt)
+"USAGE:   SubsMapIdeal(sol,index,opt); list sol, index; int opt;
+PURPOSE: built an ideal I as follows.
+         if i is contained in 'index' then set I[i] = sol[i]
+         if i is not contained in 'index' then
+         - opt = 0: set I[i] = 0
+         - opt = 1: set I[i] = var(i)
+         if opt = 1 and n = nvars(basering) then set I[n] = var(n).
+RETURN:  ideal
+ASSUME:  size(sol) = size(index) <= nvars(basering)
+"
+{
+  int k = 0;
+  ideal I;
+  for(int i = 1; i <= nvars(basering) - 1; i = i + 1) {    // built subs. map
+    if(containedQ(index, i)) {
+      k++;
+      I[index[k]] = sol[k];
+    }
+    else {
+      if(opt) { I[i] = var(i); }
+      else { I[i] = 0; }
+    }
+  }
+  if(opt) {I[nvars(basering)] = var(nvars(basering));}
+  return(I);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc SimplifyZeroset(def data)
+"USAGE:   SimplifyZeroset(data); list data
+PURPOSE: reduce the entries of the elements of 'data' w.r.t. the ideal 'mpoly'
+         'data' is a list of ideals/lists.
+RETURN:  list
+ASSUME:  basering = Q[x_1,...,x_n,a], order = lp
+         'data' is a list of ideals
+         ideal 'mpoly' must be defined, it might be 0 !
+"
+{
+  int i;
+  list result;
+
+  for(i = 1; i <= size(data); i++) {
+    result[i] = SimplifyData(data[i]);
+  }
+  return(result);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc Variables(poly f, int n)
+"USAGE:   Variables(f,n); poly f; int n;
+PURPOSE: list of variables among var(1),...,var(n) which occur in f.
+RETURN:  list
+ASSUME:  n <= nvars(basering)
+"
+{
+  int i, nrV;
+  list index;
+
+  nrV = 0;
+  for(i = 1; i <= n; i = i + 1) {
+    if(diff(f, var(i)) != 0) { nrV++; index[nrV] = i; }
+  }
+  return(index);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc containedQ(def data,def f, list #)
+"USAGE:    containedQ(data, f [, opt]); data=list; f=any type; opt=integer
+PURPOSE:  test if f is an element of data.
+RETURN:   int
+          0 if f not contained in data
+          1 if f contained in data
+OPTIONS:  opt = 0 : use '==' for comparing f with elements from data@*
+          opt = 1 : use @code{sameQ} for comparing f with elements from data
+"
+{
+  int opt, i, found;
+  if(size(#) > 0) { opt = #[1];}
+  else { opt = 0; }
+  i = 1;
+  found = 0;
+
+  while((!found) && (i <= size(data))) {
+    if(opt == 0) {
+      if(f == data[i]) { found = 1;}
+      else {i = i + 1;}
+    }
+    else {
+      if(sameQ(f, data[i])) { found = 1;}
+      else {i = i + 1;}
+    }
+  }
+  return(found);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+
+proc sameQ(def a,def b)
+"USAGE:    sameQ(a, b); a,b=list/intvec
+PURPOSE:  test a == b elementwise, i.e., a[i] = b[i].
+RETURN:   int
+          0 if a != b
+          1 if a == b
+"
+{
+  if(typeof(a) == typeof(b)) {
+    if(typeof(a) == "list" || typeof(a) == "intvec") {
+      if(size(a) == size(b)) {
+        int i = 1;
+        int ok = 1;
+        while(ok && (i <= size(a))) {
+          if(a[i] == b[i]) { i = i + 1;}
+          else {ok = 0;}
+        }
+        return(ok);
+      }
+      else { return(0); }
+    }
+    else { return(a == b);}
+  }
+  else { return(0);}
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc SimplifyPoly(poly f)
+"USAGE:   SimplifyPoly(f); poly f
+PURPOSE: reduces the coefficients of f w.r.t. the ideal 'moly' if they contain
+         the algebraic number 'a'.
+RETURN:  poly
+ASSUME:  basering = Q[x_1,...,x_n,a]
+         ideal mpoly must be defined, it might be 0 !
+NOTE: outdated, use reduce instead
+"
+{
+  matrix coMx;
+  poly f1, vp;
+
+  vp = 1;
+  for(int i = 1; i < nvars(basering); i++) { vp = vp * var(i);}
+
+  coMx = coef(f, vp);
+  f1 = 0;
+  for(i = 1; i <= ncols(coMx); i++) {
+    f1 = f1 + coMx[1, i] * reduce(coMx[2, i], mpoly);
+  }
+  return(f1);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc SimplifyData(def data)
+"USAGE:   SimplifyData(data); ideal/list data;
+PURPOSE: reduces the entries of 'data' w.r.t. the ideal 'mpoly' if they contain
+         the algebraic number 'a'
+RETURN:  ideal/list
+ASSUME:  basering = Q[x_1,...,x_n,a]
+         ideal 'mpoly' must be defined, it might be 0 !
+"
+{
+  def altring=basering;
+  int n;
+  poly f;
+
+  if(typeof(data) == "ideal") { n = ncols(data); }
+  else { n = size(data);}
+
+  for(int i = 1; i <= n; i++) {
+    f = data[i];
+    data[i] = SimplifyPoly(f);
+  }
+  return(data);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc TransferRing(def R)
+"USAGE:   TransferRing(R);
+PURPOSE: creates a new ring containing the same variables as R, but without
+         parameters. If R contains a parameter then this parameter is added
+         as the last variable and 'minpoly' is represented by the ideal 'mpoly'
+         If the basering does not contain a parameter then 'a' is added and
+         'mpoly' = 0.
+RETURN:  ring
+ASSUME:  R = K[x_1,...,x_n] where K = Q or K = Q(a).
+NOTE:    Creates the ring needed for all procedures with name 'proc-name'Main
+"
+{
+  def altring=basering;
+  string ringSTR, parName, minPoly;
+
+  setring(R);
+
+  if(npars(basering) == 0) {
+    parName = "a";
+    minPoly = "0";
+  }
+  else {
+    parName = parstr(basering);
+    minPoly = string(minpoly);
+  }
+  ring TR = create_ring(0, "(" + varstr(basering) + "," + parName + ")", "lp");
+  execute("ideal mpoly = std(" + minPoly + ");");
+  export(mpoly);
+  setring altring;
+  return(TR);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc NewBaseRing()
+"USAGE:   NewBaseRing();
+PURPOSE: creates a new ring, the last variable is added as a parameter.
+         minpoly is set to mpoly[1].
+RETURN:  ring
+ASSUME:  basering = Q[x_1,...,x_n, a], 'mpoly' must be defined
+"
+{
+  int n = nvars(basering);
+  int MP;
+  string ringSTR, parName, varString;
+
+  def BR = basering;
+  if(mpoly[1] != 0) {
+    parName = "(0, " + string(var(n)) + ")";
+    MP = 1;
+  }
+  else {
+    parName = "0";
+    MP = 0;
+  }
+
+
+  for(int i = 1; i < n - 1; i++) {
+    varString = varString + string(var(i)) + ",";
+  }
+  varString = varString + string(var(n-1));
+
+  ring TR = create_ring(parName, "(" + varString + ")", "lp");
+  if(MP) { minpoly = number(imap(BR, mpoly)[1]); }
+  setring BR;
+  return(TR);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+/*
+                           Examples:
+
+
+// order = 20;
+ring S1 = 0, (s(1..3)), lp;
+ideal I = s(2)*s(3), s(1)^2*s(2)+s(1)^2*s(3)-1, s(1)^2*s(3)^2-s(3), s(2)^4-s(3)^4+s(1)^2, s(1)^4+s(2)^3-s(3)^3, s(3)^5-s(1)^2*s(3);
+ideal mpoly = std(0);
+
+// order = 10
+ring S2 = 0, (s(1..5)), lp;
+ideal I = s(2)+s(3)-s(5), s(4)^2-s(5), s(1)*s(5)+s(3)*s(4)-s(4)*s(5), s(1)*s(4)+s(3)-s(5), s(3)^2-2*s(3)*s(5), s(1)*s(3)-s(1)*s(5)+s(4)*s(5), s(1)^2+s(4)^2-2*s(5), -s(1)+s(5)^3, s(3)*s(5)^2+s(4)-s(5)^3, s(1)*s(5)^2-1;
+ideal mpoly = std(0);
+
+//order = 126
+ring S3 =  0, (s(1..5)), lp;
+ideal I = s(3)*s(4), s(2)*s(4), s(1)*s(3), s(1)*s(2), s(3)^3+s(4)^3-1, s(2)^3+s(4)^3-1, s(1)^3-s(4)^3, s(4)^4-s(4), s(1)*s(4)^3-s(1), s(5)^7-1;
+ideal mpoly = std(0);
+
+// order = 192
+ring S4 = 0, (s(1..4)), lp;
+ideal I = s(2)*s(3)^2*s(4)+s(1)*s(3)*s(4)^2, s(2)^2*s(3)*s(4)+s(1)*s(2)*s(4)^2, s(1)*s(3)^3+s(2)*s(4)^3, s(1)*s(2)*s(3)^2+s(1)^2*s(3)*s(4), s(1)^2*s(3)^2-s(2)^2*s(4)^2, s(1)*s(2)^2*s(3)+s(1)^2*s(2)*s(4), s(1)^3*s(3)+s(2)^3*s(4), s(2)^4-s(3)^4, s(1)*s(2)^3+s(3)*s(4)^3, s(1)^2*s(2)^2-s(3)^2*s(4)^2, s(1)^3*s(2)+s(3)^3*s(4), s(1)^4-s(4)^4, s(3)^5*s(4)-s(3)*s(4)^5, s(3)^8+14*s(3)^4*s(4)^4+s(4)^8-1, 15*s(2)*s(3)*s(4)^7-s(1)*s(4)^8+s(1), 15*s(3)^4*s(4)^5+s(4)^9-s(4), 16*s(3)*s(4)^9-s(3)*s(4), 16*s(2)*s(4)^9-s(2)*s(4), 16*s(1)*s(3)*s(4)^8-s(1)*s(3), 16*s(1)*s(2)*s(4)^8-s(1)*s(2), 16*s(1)*s(4)^10-15*s(2)*s(3)*s(4)-16*s(1)*s(4)^2, 16*s(1)^2*s(4)^9-15*s(1)*s(2)*s(3)-16*s(1)^2*s(4), 16*s(4)^13+15*s(3)^4*s(4)-16*s(4)^5;
+ideal mpoly = std(0);
+
+ring R = (0,a), (x,y,z), lp;
+minpoly = a2 + 1;
+ideal I1 = x2 - 1/2, a*z - 1, y - 2;
+ideal I2 = x3 - 1/2, a*z2 - 3, y - 2*a;
+
+*/