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

sage_wheels/share/singular/LIB/polylib.lib

@@ -0,0 +1,1174 @@
+////////////////////////////////////////////////////////////////////////////
+version="version polylib.lib 4.4.0.0 Nov_2023 "; // $Id: 35d3c5db47d8165ccd2b86ecf2f2d960e1e7bca4 $
+category="General purpose";
+info="
+LIBRARY:  polylib.lib      Procedures for Manipulating Polys, Ideals, Modules
+AUTHORS:  O. Bachmann, G.-M. Greuel, A. Fruehbis
+
+PROCEDURES:
+ cyclic(int);           ideal of cyclic n-roots
+ elemSymmId(int);       ideal of elementary symmetric polynomials
+ katsura([i]);          katsura [i] ideal
+ freerank(poly/...)     rank of coker(input) if coker is free else -1
+ is_zero(poly/...);     int, =1 resp. =0 if coker(input) is 0 resp. not
+ lcm(ideal);            lcm of given generators of ideal
+ maxcoef(poly/...);     maximal length of coefficient occurring in poly/...
+ maxdeg(poly/...);      int/intmat = degree/s of terms of maximal order
+ maxdeg1(poly/...);     int = [weighted] maximal degree of input
+ mindeg(poly/...);      int/intmat = degree/s of terms of minimal order
+ mindeg1(poly/...);     int = [weighted] minimal degree of input
+ normalize(poly/...);   normalize poly/... such that leading coefficient is 1
+ rad_con(p,I);          check radical containment of polynomial p in ideal I
+ content(f);            content of polynomial/vector f
+ mod2id(M,iv);          conversion of a module M to an ideal
+ id2mod(i,iv);          conversion inverse to mod2id
+ substitute(I,...)      substitute in I variables by polynomials
+ subrInterred(i1,i2,iv);interred w.r.t. a subset of variables
+ newtonDiag(f);         Newton diagram of a polynomial
+ hilbPoly(I);           Hilbert polynomial of basering/I
+          (parameters in square brackets [] are optional)
+
+";
+
+LIB "general.lib";
+LIB "ring.lib";
+///////////////////////////////////////////////////////////////////////////////
+static proc bino(int a, int b)
+{
+//computes binomial var(1)+a over b
+   int i;
+   if(b==0){return(1);}
+   poly p=(var(1)+a)/b;
+   for(i=1;i<=b-1;i++)
+   {
+      p=p*(var(1)+a-i)/i;
+   }
+   return(p);
+}
+
+proc hilbPoly(ideal I)
+"USAGE: hilbPoly(I); I a homogeneous ideal
+RETURN: the Hilbert polynomial of basering/I as an intvec v=v_0,...,v_r
+        such that the Hilbert polynomial is (v_0+v_1*t+...v_r*t^r)/r!
+EXAMPLE: example hilbPoly; shows an example
+"
+{
+   def R=basering;
+   if(!attrib(I,"isSB")){I=std(I);}
+   bigintvec v=hilb(I,2);
+   int s=dim(I);
+   intvec hp;
+   if(s<=0){return(hp);}
+   int d=size(v)-2;
+   ring S=0,t,dp;
+   poly p=v[1+d]*bino(s-1-d,s-1);
+   int i;
+   for(i=1;i<=d;i++)
+   {
+      p=p+v[d-i+1]*bino(s-1-d+i,s-1);
+   }
+   int n=1;
+   for(i=2;i<=s-1;i++){n=n*i;}
+   p=n*p;
+   hp[s]=int(leadcoef(p));
+   for(i=2;i<=size(p);i++)
+   {
+      hp[leadexp(p[i])+1]=int(leadcoef(p[i]));
+   }
+   setring R;
+   return(hp);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(b,c,t,h),dp;
+   ideal I=
+   bct-t2h+2th2+h3,
+   bt3-ct3-t4+b2th+c2th-2bt2h+2ct2h+2t3h-bch2-2bth2+2cth2+2th3,
+   b2c2+bt2h-ct2h-t3h+b2h2+2bch2+c2h2-2bth2+2cth2+t2h2-2bh3+2ch3+2th3+3h4,
+   c2t3+ct4-c3th-2c2t2h-2ct3h-t4h+bc2h2-2c2th2-bt2h2+4t3h2+2bth3-2cth3-t2h3
+   +bh4-6th4-2h5;
+   hilbPoly(I);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc substitute (def I,list #)
+"USAGE:  - case 1: typeof(#[1])==poly:
+           substitute (I,v,f[,v1,f1,v2,f2,...]); I object of basering which
+           can be mapped, v,v1,v2,.. ring variables, f,f1,f2,... poly
+@*       - case 2: typeof(#[1])==ideal:
+           substitute (I,v,f); I object of basering which can be mapped,
+           v ideal of ring variables, f ideal
+RETURN:  object of same type as I,
+@*       - case 1: ring variable v,v1,v2,... substituted by polynomials
+           f,f1,f2,..., in this order
+@*       - case 2: ring variables in v substituted by polynomials in f:
+           v[i] is substituted by f[i], i=1,...,i=min(size(v),ncols(f))
+NOTE:    this procedure extends the built-in command subst via maps
+EXAMPLE: example substitute; shows an example
+"
+{
+  def bas = basering;
+  ideal m = maxideal(1);
+  int i,ii;
+  if(typeof(#[1])=="poly")
+  {
+    poly v = #[1];
+    poly f = #[2];
+    map phi = bas,m;
+    def J = I;
+    for (ii=1; ii<=size(#) - 1; ii=ii+2)
+    {
+      m = maxideal(1);
+      i=rvar(#[ii]);
+      m[i] = #[ii+1];
+      phi = bas,m;
+      J = phi(J);
+    }
+    return(J);
+  }
+  if(typeof(#[1])=="ideal")
+  {
+    ideal v = #[1];
+    ideal f = #[2];
+    int mi = ncols(v);
+    if(ncols(f)<mi)
+    {
+      mi = ncols(f);
+    }
+    def J = I;
+    for (ii=1; ii<=mi; ii++)
+    {
+      m[rvar(v[ii])]=f[ii];
+    }
+    map phi = bas,m;
+    J = phi(I);
+    return(J);
+  }
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(b,c,t),dp;
+   ideal I = -bc+4b2c2t,bc2t-5b2c;
+   substitute(I,c,b+c,t,0,b,b-1);
+   ideal v = c,t,b;
+   ideal f = b+c,0,b-1;
+   substitute(I,v,f);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc cyclic (int n)
+"USAGE:   cyclic(n);  n integer
+RETURN:  ideal of cyclic n-roots from 1-st n variables of basering
+EXAMPLE: example cyclic; shows examples
+"
+{
+//----------------------------- procedure body --------------------------------
+   ideal m = maxideal(1);
+   m = m[1..n],m[1..n];
+   int i,j;
+   ideal s; poly t;
+   for ( j=0; j<=n-2; j++ )
+   {
+      t=0;
+      for( i=1;i<=n;i++ ) { t=t+product(m,i..i+j); }
+      s=s+t;
+   }
+   s=s,product(m,1..n)-1;
+   return (s);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r=0,(u,v,w,x,y,z),lp;
+   cyclic(nvars(basering));
+   homog(cyclic(5),z);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc elemSymmPoly(int d, int lindex, int hindex)
+"USAGE:  elemSymmPoly(d,lindex,hindex); d,lindex,hindex integers
+RETURN:  elementary symmetric polynomial of degree d for variables
+@*       var(lindex),...,var(hindex) of basering
+EXAMPLE: example elemSymmPoly; shows an example
+"
+{
+ if(hindex - lindex + 1 < d)
+ {
+   int i = hindex - lindex + 1;
+   "========================================================";
+   "There is no elementary symmetric polynomial of degree "+string(d);
+   "for just "+string(i)+" variables.";
+   "========================================================";
+   return(poly(0));
+ }
+ if(d == 0)
+ {
+   return(poly(1));
+ }
+ else
+ {
+   int i;
+   poly p;
+   for (i = lindex; i <=  hindex - d + 1; i++)
+   {
+     p = p + var(i) * elemSymmPoly(d - 1, i + 1, hindex);
+   }
+   return(p);
+ }
+}
+example
+{ "EXAMPLE:"; echo = 2;
+  ring R = 0, (u,v,w,x,y,z), lp;
+  elemSymmPoly(3,2,5);
+  elemSymmPoly(6,1,6);
+}
+
+//////////////////////////////////////////////////////////////////////////
+proc elemSymmId(int n)
+"USAGE:  elemSymmId(n); n integer
+RETURN:  ideal of elementary symmetric polynomials for 1-st n
+@*       variables of basering
+EXAMPLE: example elemSymmId; shows an example
+{
+ int i;
+ ideal symm;
+ for(i = 1; i <= n; i++)
+ {
+   symm = symm + elemSymmPoly(i, 1, n);
+ }
+ return(symm);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+  ring R = 0, (v,w,x,y,z), lp;
+  elemSymmId(3);
+  elemSymmId(nvars(basering));
+}
+
+//////////////////////////////////////////////////////////////////////////
+proc katsura
+"USAGE: katsura([n]); n integer
+RETURN: katsura(n) : n-th katsura ideal of
+         (1) newly created and set ring (32003, x(0..n), dp), if
+             nvars(basering) < n
+         (2) basering, if nvars(basering) >= n
+        katsura()  : katsura ideal of basering
+EXAMPLE: example katsura; shows examples
+"
+{
+  int n;
+  if ( size(#) == 1 && typeof(#[1]) == "int")
+  {
+    n = #[1] - 1;
+    while (1)
+    {
+      if (defined(basering))
+      {
+        if (nvars(basering) >= #[1]) {break;}
+      }
+      ring katsura_ring = 32003, x(0..#[1]), dp;
+      keepring katsura_ring;
+      break;
+    }
+  }
+  else
+  {
+    n = nvars(basering) -1;
+  }
+
+  ideal s;
+  int i, j;
+  poly p;
+
+  p = -1;
+  for (i = -n; i <= n; i++)
+  {
+    p = p + kat_var(i, n);
+  }
+  s[1] = p;
+
+  for (i = 0; i < n; i++)
+  {
+    p = -1 * kat_var(i,n);
+    for (j = -n; j <= n; j++)
+    {
+      p = p + kat_var(j,n) * kat_var(i-j, n);
+    }
+    s = s,p;
+  }
+  return (s);
+}
+//-------------------------------- examples -----------------------------------
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r; basering;
+  katsura();
+  katsura(4); basering;
+}
+
+proc kat_var(int i, int n)
+{
+  poly p;
+  if (i < 0)  { i = -i;}
+  if (i <= n) { p = var(i+1); }
+  return (p);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc freerank
+"USAGE:   freerank(M[,any]);  M=poly/ideal/vector/module/matrix
+COMPUTE: rank of module presented by M in case it is free.
+         By definition this is vdim(coker(M)/m*coker(M)) if coker(M)
+         is free, where m is the maximal ideal of the variables of the
+         basering and M is considered to be a matrix.
+         (the 0-module is free of rank 0)
+RETURN:  rank of coker(M) if coker(M) is free and -1 else;
+         in case of a second argument return a list:
+                L[1] = rank of coker(M) or -1
+                L[2] = minbase(M)
+NOTE:    freerank(syz(M)); computes the rank of M if M is free (and -1 else)
+EXAMPLE: example freerank; shows examples
+"
+{
+  int rk;
+  def M = simplify(#[1],10);
+  resolution mre = res(M,2);
+  intmat B = betti(mre);
+  if ( ncols(B)>1 ) { rk = -1; }
+  else { rk = sum(B[1..nrows(B),1]); }
+  if (size(#) == 2) { list L=rk,mre[1]; return(L);}
+  return(rk);
+}
+example
+{"EXAMPLE";   echo=2;
+  ring r;
+  ideal i=x;
+  module M=[x,0,1],[-x,0,-1];
+  freerank(M);          // should be 2, coker(M) is not free
+  freerank(syz (M),"");
+  // [1] should be 1, coker(syz(M))=M is free of rank 1
+  // [2] should be gen(2)+gen(1) (minimal relation of M)
+  freerank(i);
+  freerank(syz(i));     // should be 1, coker(syz(i))=i is free of rank 1
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc is_zero
+"USAGE:   is_zero(M[,any]); M=poly/ideal/vector/module/matrix
+RETURN:  integer, 1 if coker(M)=0 resp. 0 if coker(M)!=0, where M is
+         considered as matrix.
+         If a second argument is given, return a list:
+                L[1] = 1 if coker(M)=0 resp. 0 if coker(M)!=0
+                L[2] = dim(M)
+EXAMPLE: example is_zero; shows examples
+"
+{
+  int d=dim(std(#[1]));
+  int a = ( d==-1 );
+  if( size(#) >1 ) { return(list(a,d)); }
+  return(a);
+}
+example
+{ "EXAMPLE:";   echo=2;
+  ring r;
+  module m = [x],[y],[1,z];
+  is_zero(m,1);
+  qring q = std(ideal(x2+y3+z2));
+  ideal j = x2+y3+z2-37;
+  is_zero(j);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc maxcoef (def f)
+"USAGE:   maxcoef(f);  f  poly/ideal/vector/module/matrix
+RETURN:  maximal length of coefficient of f of type int (by measuring the
+         length of the string of each coefficient)
+EXAMPLE: example maxcoef; shows examples
+"
+{
+//----------------------------- procedure body --------------------------------
+   int max,s,ii,jj; string t;
+   ideal i = ideal(matrix(f));
+   i = simplify(i,6);            // delete 0's and keep first of equal elements
+   poly m = var(1); matrix C;
+   for (ii=2;ii<=nvars(basering);ii++) { m = m*var(ii); }
+   for (ii=1; ii<=size(i); ii++)
+   {
+      C = coef(i[ii],m);
+      for (jj=1; jj<=ncols(C); jj++)
+      {
+         t = string(C[2,jj]);  s = size(t);
+         if ( t[1] == "-" ) { s = s - 1; }
+         if ( s > max ) { max = s; }
+      }
+   }
+   return(max);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r= 0,(x,y,z),ds;
+   poly g = 345x2-1234567890y+7/4z;
+   maxcoef(g);
+   ideal i = g,10/1234567890;
+   maxcoef(i);
+   // since i[2]=1/123456789
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc maxdeg (def id)
+"USAGE:   maxdeg(id);  id  poly/ideal/vector/module/matrix
+RETURN:  int/intmat, each component equals maximal degree of monomials in the
+         corresponding component of id, independent of ring ordering
+         (maxdeg of each var is 1).
+         Of type int, if id is of type poly; of type intmat otherwise
+SEE ALSO: maxdeg1
+EXAMPLE: example maxdeg; shows examples
+"
+{
+   //-------- subprocedure to find maximal degree of given component ----------
+   proc findmaxdeg
+   {
+      poly c = #[1];
+      if (c==0) { return(-1); }
+   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
+      int d = (deg(c)>=0)*deg(c)-(deg(c)<0)*deg(c);
+      int i = d;
+      while ( c-jet(c,i) != 0 ) { i = 2*(i+1); }
+      int o = i-1;
+      int u = (d != i)*((i div  2)-1);
+   //----------------------- "quick search" for maxdeg ------------------------
+      while ( (c-jet(c,i)==0)*(c-jet(c,i-1)!=0) == 0)
+      {
+         i = (o+1+u) div  2;
+         if (c-jet(c,i)!=0) { u = i+1; }
+         else { o = i-1; }
+      }
+      return(i);
+   }
+//------------------------------ main program ---------------------------------
+   matrix M = matrix(id);
+   int r,c = nrows(M), ncols(M); int i,j;
+   intmat m[r][c];
+   for (i=r; i>0; i--)
+   {
+      for (j=c; j>0; j--) { m[i,j] = findmaxdeg(M[i,j]); }
+   }
+   if (typeof(id)=="poly") { return(m[1,1]); }
+   return(m);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y,z),wp(1,2,3);
+   poly f = x+y2+z3;
+   deg(f);             //deg; returns weighted degree (in case of 1 block)!
+   maxdeg(f);
+   matrix m[2][2]=f+x10,1,0,f^2;
+   maxdeg(m);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc maxdeg1 (def id,list #)
+"USAGE:   maxdeg1(id[,v]);  id=poly/ideal/vector/module/matrix, v=intvec
+RETURN:  integer, maximal [weighted] degree of monomials of id independent of
+         ring ordering, maxdeg1 of i-th variable is v[i] (default: v=1..1).
+NOTE:    This proc returns one integer while maxdeg returns, in general,
+         a matrix of integers. For one polynomial and if no intvec v is given
+         maxdeg is faster
+EXAMPLE: example maxdeg1; shows examples
+"
+{
+   //-------- subprocedure to find maximal degree of given component ----------
+   proc findmaxdeg
+   {
+      poly c = #[1];
+      if (c==0) { return(-1); }
+      intvec v = #[2];
+   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
+      int d = (deg(c)>=0)*deg(c)-(deg(c)<0)*deg(c);
+      int i = d;
+      if ( c == jet(c,-1,v))      //case: maxdeg is negative
+      {
+         i = -d;
+         while ( c == jet(c,i,v) ) { i = 2*(i-1); }
+         int o = (d != -i)*((i div  2)+2) - 1;
+         int u = i+1;
+         int e = -1;
+      }
+      else                        //case: maxdeg is nonnegative
+      {
+         while ( c != jet(c,i,v) ) { i = 2*(i+1); }
+         int o = i-1;
+         int u = (d != i)*((i div  2)-1);
+         int e = 1;
+      }
+   //----------------------- "quick search" for maxdeg ------------------------
+      while ( ( c==jet(c,i,v) )*( c!=jet(c,i-1,v) ) == 0 )
+      {
+         i = (o+e+u) div  2;
+         if ( c!=jet(c,i,v) ) { u = i+1; }
+         else { o = i-1; }
+      }
+      return(i);
+   }
+//------------------------------ main program ---------------------------------
+   ideal M = simplify(ideal(matrix(id)),8);   //delete scalar multiples from id
+   int c = ncols(M);
+   int i,n;
+   if( size(#)==0 )
+   {
+      int m = maxdeg(M[c]);
+      for (i=c-1; i>0; i--)
+      {
+          n = maxdeg(M[i]);
+          m = (m>=n)*m + (m<n)*n;             //let m be the maximum of m and n
+      }
+   }
+   else
+   {
+      intvec v=#[1];                          //weight vector for the variables
+      int m = findmaxdeg(M[c],v);
+      for (i=c-1; i>0; i--)
+      {
+         n = findmaxdeg(M[i],v);
+         if( n>m ) { m=n; }
+      }
+   }
+   return(m);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y,z),wp(1,2,3);
+   poly f = x+y2+z3;
+   deg(f);            //deg returns weighted degree (in case of 1 block)!
+   maxdeg1(f);
+   intvec v = ringweights(r);
+   maxdeg1(f,v);                        //weighted maximal degree
+   matrix m[2][2]=f+x10,1,0,f^2;
+   maxdeg1(m,v);                        //absolute weighted maximal degree
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc mindeg (def id)
+"USAGE:   mindeg(id);  id  poly/ideal/vector/module/matrix
+RETURN:  minimal degree/s of monomials of id, independent of ring ordering
+         (mindeg of each variable is 1) of type int if id of type poly, else
+         of type intmat.
+SEE ALSO: mindeg1
+EXAMPLE: example mindeg; shows examples
+"
+{
+   //--------- subprocedure to find minimal degree of given component ---------
+   proc findmindeg
+   {
+      poly c = #[1];
+      if (c==0) { return(-1); }
+   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
+      int d = (ord(c)>=0)*ord(c)-(ord(c)<0)*ord(c);
+      int i = d;
+      while ( jet(c,i) == 0 ) { i = 2*(i+1); }
+      int o = i-1;
+      int u = (d != i)*((i div  2)-1);
+   //----------------------- "quick search" for mindeg ------------------------
+      while ( (jet(c,u)==0)*(jet(c,o)!=0) )
+      {
+         i = (o+u) div 2;
+         if (jet(c,i)==0) { u = i+1; }
+         else { o = i-1; }
+      }
+      if (jet(c,u)!=0) { return(u); }
+      else { return(o+1); }
+   }
+//------------------------------ main program ---------------------------------
+   matrix M = matrix(id);
+   int r,c = nrows(M), ncols(M); int i,j;
+   intmat m[r][c];
+   for (i=r; i>0; i--)
+   {
+      for (j=c; j>0; j--) { m[i,j] = findmindeg(M[i,j]); }
+   }
+   if (typeof(id)=="poly") { return(m[1,1]); }
+   return(m);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y,z),ls;
+   poly f = x5+y2+z3;
+   ord(f);                  // ord returns weighted order of leading term!
+   mindeg(f);               // computes minimal degree
+   matrix m[2][2]=x10,1,0,f^2;
+   mindeg(m);               // computes matrix of minimum degrees
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc mindeg1 (def id, list #)
+"USAGE:   mindeg1(id[,v]);  id=poly/ideal/vector/module/matrix, v=intvec
+RETURN:  integer, minimal [weighted] degree of monomials of id independent of
+         ring ordering, mindeg1 of i-th variable is v[i] (default v=1..1).
+NOTE:    This proc returns one integer while mindeg returns, in general,
+         a matrix of integers. For one polynomial and if no intvec v is given
+         mindeg is faster.
+EXAMPLE: example mindeg1; shows examples
+"
+{
+   //--------- subprocedure to find minimal degree of given component ---------
+   proc findmindeg
+   {
+      poly c = #[1];
+      intvec v = #[2];
+      if (c==0) { return(-1); }
+   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
+      int d = (ord(c)>=0)*ord(c)-(ord(c)<0)*ord(c);
+      int i = d;
+      if ( jet(c,-1,v) !=0 )      //case: mindeg is negative
+      {
+         i = -d;
+         while ( jet(c,i,v) != 0 ) { i = 2*(i-1); }
+         int o = (d != -i)*((i div  2)+2) - 1;
+         int u = i+1;
+         int e = -1; i=u;
+      }
+      else                        //case: mindeg is nonnegative
+      {
+         while ( jet(c,i,v) == 0 ) { i = 2*(i+1); }
+         int o = i-1;
+         int u = (d != i)*((i div  2)-1);
+         int e = 1; i=u;
+      }
+   //----------------------- "quick search" for mindeg ------------------------
+      while ( (jet(c,i-1,v)==0)*(jet(c,i,v)!=0) == 0 )
+      {
+         i = (o+e+u) div  2;
+         if (jet(c,i,v)==0) { u = i+1; }
+         else { o = i-1; }
+      }
+      return(i);
+   }
+//------------------------------ main program ---------------------------------
+   ideal M = simplify(ideal(matrix(id)),8);   //delete scalar multiples from id
+   int c = ncols(M);
+   int i,n;
+   if( size(#)==0 )
+   {
+      int m = mindeg(M[c]);
+      for (i=c-1; i>0; i--)
+      {
+          n = mindeg(M[i]);
+          m = (m<=n)*m + (m>n)*n;             //let m be the maximum of m and n
+      }
+   }
+   else
+   {
+      intvec v=#[1];                          //weight vector for the variables
+      int m = findmindeg(M[c],v);
+      for (i=c-1; i>0; i--)
+      {
+         n = findmindeg(M[i],v);
+         m = (m<=n)*m + (m>n)*n;              //let m be the maximum of m and n
+      }
+   }
+   return(m);
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y,z),ls;
+   poly f = x5+y2+z3;
+   ord(f);                  // ord returns weighted order of leading term!
+   intvec v = 1,-3,2;
+   mindeg1(f,v);            // computes minimal weighted degree
+   matrix m[2][2]=x10,1,0,f^2;
+   mindeg1(m,1..3);         // computes absolute minimum of weighted degrees
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc normalize (def id)
+"USAGE:   normalize(id);  id=poly/vector/ideal/module
+RETURN:  object of same type
+         each element is normalized with leading coefficient equal to 1
+EXAMPLE: example normalize; shows an example
+"
+{
+   return(simplify(id,1));
+}
+//-------------------------------- examples -----------------------------------
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y,z),ls;
+   poly f = 2x5+3y2+4z3;
+   normalize(f);
+   module m=[9xy,0,3z3],[4z,6y,2x];
+   normalize(m);
+   ring s = 0,(x,y,z),(c,ls);
+   module m=[9xy,0,3z3],[4z,6y,2x];
+   normalize(m);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+///////////////////////////////////////////////////////////////////////////////
+// Input: <ideal>=<f1,f2,...,fm> and <polynomial> g
+// Question: Does g lie in the radical of <ideal>?
+// Solution: Compute a standard basis G for <f1,f2,...,fm,gz-1> where z is a
+//           new variable. Then g is contained in the radical of <ideal> <=>
+//           1 is generator in G.
+///////////////////////////////////////////////////////////////////////////////
+proc rad_con (poly g,ideal I)
+"USAGE:   rad_con(g,I); g polynomial, I ideal
+RETURN:  1 (TRUE) (type int) if g is contained in the radical of I
+@*       0 (FALSE) (type int) otherwise
+EXAMPLE: example rad_con; shows an example
+"
+{ def br=basering;
+  int n=nvars(br);
+  int dB=degBound;
+  degBound=0;
+  string mp=string(minpoly);
+  if (attrib(br,"global")==1)
+  {
+    list l2;
+    for (int ii = 1; ii <= n; ii++)
+    {
+      l2[ii] = "@x("+string(ii)+")";
+    }
+    l2[n+1] = "@z";
+    ring R = create_ring(ring_list(br)[1], l2, "dp", "no_minpoly");
+  }
+  else
+  {
+    list l2 = "@z";
+    for (int ii = 1; ii <= n; ii++)
+    {
+     l2[ii+1] = "@x("+string(ii)+")";
+    }
+    ring R = create_ring(ring_list(br)[1], l2, "(dp(1),"+ordstr(br)+")", "no_minpoly");
+  }
+  if (mp!="0")
+  {
+    execute("minpoly=number("+mp+");");
+  }
+  ideal irrel=@x(1..n);
+  map f=br,irrel;
+  poly p=f(g);
+  ideal J=f(I),ideal(p*@z-1);
+  J=std(J);
+  degBound=dB;
+  if (J[1]==1)
+  {
+     setring br;
+     return(1);
+  }
+  else
+  {
+     setring br;
+     return(0);
+  }
+}
+example
+{ "EXAMPLE:"; echo=2;
+   ring R=0,(x,y,z),dp;
+   ideal I=x2+y2,z2;
+   poly f=x4+y4;
+   rad_con(f,I);
+   ideal J=x2+y2,z2,x4+y4;
+   poly g=z;
+   rad_con(g,I);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc lcm (def id, list #)
+"USAGE:   lcm(p[,q]); p int/intvec q a list of integers or
+          p poly/ideal q a list of polynomials
+RETURN:  the least common multiple of p and q:
+@*         - of type int if p is an int/intvec
+@*         - of type poly if p is a poly/ideal
+EXAMPLE: example lcm; shows an example
+"
+{
+  int k,j;
+//------------------------------ integer case --------------------------------
+  if( typeof(id) == "int" or typeof(id) == "intvec" )
+  {
+     intvec i = id;
+     if (size(#)!=0)
+     {
+        for (j = 1; j<=size(#); j++)
+        {
+           if (typeof(#[j]) !="int" and typeof(#[j]) !="intvec")
+           { ERROR("// ** list element must be an integer");}
+           else
+           { i = i,#[j]; }
+        }
+     }
+     int p,q;
+     if( i == 0 )
+     {
+        return(0);
+     }
+     for(j=1;j<=size(i);j++)
+     {
+       if( i[j] != 0 )
+       {
+         p=i[j];
+         break;
+       }
+     }
+     for (k=j+1;k<=size(i);k++)
+     {
+        if( i[k] !=0)
+        {
+           q=gcd(p,i[k]);
+           p=p div q;
+           p=p*i[k];
+        }
+     }
+     if(p <0 )
+     {return(-p);}
+     return(p);
+   }
+
+//----------------------------- polynomial case ------------------------------
+  if( typeof(id) == "poly" or typeof(id) == "ideal" )
+  {
+     ideal i = id;
+     if (size(#)!=0)
+     {
+        for (j = 1; j<=size(#); j++)
+        {
+           if (typeof(#[j]) !="poly" and typeof(#[j]) !="ideal"
+              and typeof(#[j]) !="int" and typeof(#[j]) !="intvec")
+           { ERROR("// ** list element must be a polynomial");}
+           else
+           { i = i,#[j]; }
+        }
+     }
+     poly p,q;
+     i=simplify(i,10);
+     if(size(i) == 0)
+     {
+        return(0);
+     }
+     for(j=1;j<=size(i);j++)
+     {
+       if(maxdeg(i[j])!= 0)
+       {
+         p=i[j];
+         break;
+       }
+     }
+     if(p==0)
+     {
+       return(1);
+     }
+     for (k=j+1;k<=size(i);k++)
+     {
+        if(maxdeg(i[k])!=0)
+        {
+           q=gcd(p,i[k]);
+           if(maxdeg(q)==0)
+           {
+             p=p*i[k];
+           }
+           else
+           {
+             p=p/q;
+             p=p*i[k];
+           }
+        }
+     }
+     return(p);
+   }
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   poly  p = (x+y)*(y+z);
+   poly  q = (z4+2)*(y+z);
+   lcm(p,q);
+   ideal i=p,q,y+z;
+   lcm(i,p);
+   lcm(2,3,6);
+   lcm(2..6);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc content(def f)
+"USAGE:   content(f); f polynomial/vector
+RETURN:  number, the content (greatest common factor of coefficients)
+         of the polynomial/vector f
+SEE ALSO: cleardenom
+EXAMPLE: example content; shows an example
+"
+{
+  if (f==0) { return(number(1)); }
+  return(leadcoef(f)/leadcoef(system("content",f)));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring r=0,(x,y,z),(c,lp);
+   content(3x2+18xy-27xyz);
+   vector v=[3x2+18xy-27xyz,15x2+12y4,3];
+   content(v);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+////////////////////////////////////////////////////////////////////////
+// The idea of the procedures mod2id, id2mod and subrInterred is, to
+// perform standard basis computation or interreduction of a submodule
+// of a free module with generators gen(1),...,gen(n) over a ring R
+// in a ring R[t1,...,tn]/<ti*tj> with gen(i) mapped to ti
+////////////////////////////////////////////////////////////////////////
+
+proc mod2id(matrix M,intvec vpos)
+"USAGE:   mod2id(M,vpos); M matrix, vpos intvec
+ASSUME:  vpos is an integer vector such that gen(i) corresponds
+         to var(vpos[i]).
+         The basering contains variables var(vpos[i]) which do not occur
+         in M.
+RETURN:  ideal I in which each gen(i) from the module is replaced by
+         var(vpos[i]) and all monomials var(vpos[i])*var(vpos[j]) have
+         been added to the generating set of I.
+NOTE:    This procedure should be used in the following situation:
+         one wants to pass to a ring with new variables, say e(1),..,e(s),
+         which correspond to the components gen(1),..,gen(s) of the
+         module M such that e(i)*e(j)=0 for all i,j.
+         The new ring should already exist and be the current ring
+EXAMPLE: example mod2id; shows an example"
+{
+  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
+//----------------------------------------------------------------------
+// define the ideal generated by the var(vpos[i]) and set up the matrix
+// for the multiplication
+//----------------------------------------------------------------------
+  ideal vars=var(vpos[1]);
+  for(int i=2;i<=size(vpos);i++)
+  {
+    vars=vars,var(vpos[i]);
+  }
+  matrix varm[1][size(vpos)]=vars;
+  if (size(vpos) > nrows(M))
+  {
+    matrix Mt[size(vpos)][ncols(M)];
+    Mt[1..nrows(M),1..ncols(M)]=M;
+    kill M;
+    matrix M=Mt;
+  }
+//----------------------------------------------------------------------
+// define the desired ideal
+//----------------------------------------------------------------------
+  ideal ret=vars^2,varm*M;
+  return(ret);
+}
+example
+{ "EXAMPLE:"; echo=2;
+  ring r=0,(e(1),e(2),x,y,z),(dp(2),ds(3));
+  module mo=x*gen(1)+y*gen(2);
+  intvec iv=2,1;
+  mod2id(mo,iv);
+}
+////////////////////////////////////////////////////////////////////////
+
+proc id2mod(ideal i,intvec vpos)
+"USAGE:   id2mod(I,vpos); I ideal, vpos intvec
+RETURN:  module corresponding to the ideal by replacing var(vpos[i]) by
+         gen(i) and omitting all generators var(vpos[i])*var(vpos[j])
+NOTE:    * This procedure only makes sense if the ideal contains
+           all var(vpos[i])*var(vpos[j]) as monomial generators and
+           all other generators of I are linear combinations of the
+           var(vpos[i]) over the ring in the other variables.
+         * This is the inverse procedure to mod2id and should be applied
+           only to ideals created by mod2id using the same intvec vpos
+           (possibly after a standard basis computation)
+EXAMPLE: example id2mod; shows an example"
+{
+  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
+//---------------------------------------------------------------------
+// Initialization
+//---------------------------------------------------------------------
+  int n=size(i);
+  int v=size(vpos);
+  matrix tempmat;
+  matrix mm[v][n];
+//---------------------------------------------------------------------
+// Conversion
+//---------------------------------------------------------------------
+  for(int j=1;j<=v;j++)
+  {
+    tempmat=coeffs(i,var(vpos[j]));
+    mm[j,1..n]=tempmat[2,1..n];
+  }
+  for(j=1;j<=v;j++)
+  {
+    mm=subst(mm,var(vpos[j]),0);
+  }
+  module ret=simplify(mm,10);
+  return(ret);
+}
+example
+{ "EXAMPLE:"; echo=2;
+  ring r=0,(e(1),e(2),x,y,z),(dp(2),ds(3));
+  ideal i=e(2)^2,e(1)*e(2),e(1)^2,e(1)*y+e(2)*x;
+  intvec iv=2,1;
+  id2mod(i,iv);
+}
+///////////////////////////////////////////////////////////////////////
+
+proc subrInterred(ideal mon, ideal sm, intvec iv)
+"USAGE:   subrInterred(mon,sm,iv);
+         sm:   ideal in a ring r with n + s variables,
+               e.g. x_1,..,x_n and t_1,..,t_s
+         mon:  ideal with monomial generators (not divisible by
+               any of the t_i) such that sm is contained in the module
+               k[t_1,..,t_s]*mon[1]+..+k[t_1,..,t_s]*mon[size(mon)]
+         iv:   intvec listing the variables which are supposed to be used
+               as x_i
+RETURN:  list l:
+          l[1]=the monomials from mon in the order used
+          l[2]=their coefficients after interreduction
+          l[3]=l[1]*l[2]
+PURPOSE:  Do interred only w.r.t. a subset of variables.
+         The procedure returns an interreduced system of generators of
+         sm considered as a k[t_1,..,t_s]-submodule of the free module
+         k[t_1,..,t_s]*mon[1]+..+k[t_1,..,t_s]*mon[size(mon)]).
+EXAMPLE: example subrInterred; shows an example
+"
+{
+  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
+//-----------------------------------------------------------------------
+// check that mon is really generated by monomials
+// and sort its generators with respect to the monomial ordering
+//-----------------------------------------------------------------------
+  int err;
+  for(int i=1;i<=ncols(mon);i++)
+  {
+    if ( size(mon[i]) > 1 )
+    {
+      err=1;
+    }
+  }
+  if (err==1)
+  {
+    ERROR("mon has to be generated by monomials");
+  }
+  intvec sv=sortvec(mon);
+  ideal mons;
+  for(i=1;i<=size(sv);i++)
+  {
+    mons[i]=mon[sv[i]];
+  }
+  ideal itemp=maxideal(1);
+  for(i=1;i<=size(iv);i++)
+  {
+    itemp=subst(itemp,var(iv[i]),0);
+  }
+  itemp=simplify(itemp,10);
+  def r=basering;
+//-----------------------------------------------------------------------
+// express m in terms of the generators of mon and check whether m
+// can be considered as a submodule of k[t_1,..,t_n]*mon
+//-----------------------------------------------------------------------
+  module motemp;
+  motemp[ncols(sm)]=0;
+  poly ptemp;
+  int j;
+  for(i=1;i<=ncols(mons);i++)
+  {
+    for(j=1;j<=ncols(sm);j++)
+    {
+      ptemp=sm[j]/mons[i];
+      motemp[j]=motemp[j]+ptemp*gen(i);
+    }
+  }
+  for(i=1;i<=size(iv);i++)
+  {
+    motemp=subst(motemp,var(iv[i]),0);
+  }
+  matrix monmat[1][ncols(mons)]=mons;
+  ideal dummy=monmat*motemp;
+  for(i=1;i<=size(sm);i++)
+  {
+    if(sm[i]-dummy[i]!=0)
+    {
+      ERROR("the second argument is not a submodule of the assumed structure");
+    }
+  }
+//----------------------------------------------------------------------
+// do the interreduction and convert back
+//----------------------------------------------------------------------
+  ring rtemp = create_ring(ring_list(basering)[1], "(" + string(itemp)+ ")", "(C,dp)", "no_minpoly");
+  def motemp=imap(r,motemp);
+  intvec save=option(get);
+  option(redSB);
+  motemp=interred(motemp);
+  option(set,save);
+  setring r;
+  kill motemp;
+  def motemp=imap(rtemp,motemp);
+  //list ret=monmat,motemp,monmat*motemp;
+  module motemp2=motemp;
+  for(i=1;i<=ncols(motemp2);i++)
+  {
+    motemp2[i]=cleardenom(motemp2[i]);
+  }
+  module motemp3=monmat*motemp;
+  for(i=1;i<=ncols(motemp3);i++)
+  {
+    motemp3[i]=cleardenom(motemp3[i]);
+  }
+  list ret=monmat,motemp2,matrix(motemp3);
+  return(ret);
+}
+example
+{ "EXAMPLE:"; echo=2;
+  ring r=0,(x,y,z),dp;
+  ideal i=x^2+x*y^2,x*y+x^2*y,z;
+  ideal j=x^2+x*y^2,x*y,z;
+  ideal mon=x^2,z,x*y;
+  intvec iv=1,3;
+  subrInterred(mon,i,iv);
+  subrInterred(mon,j,iv);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// moved here from nctools.lib
+// This procedure calculates the Newton diagram of the polynomial f
+// The output is a intmat M, each row of M is the exp of a monomial in f
+////////////////////////////////////////////////////////////////////////
+proc newtonDiag(poly f)
+"USAGE:  newtonDiag(f); f a poly
+RETURN:  intmat
+PURPOSE: compute the Newton diagram of f
+NOTE:    each row is the exponent of a monomial of f
+EXAMPLE: example newtonDiag; shows examples
+"{
+  int n = nvars(basering);
+  intvec N=0;
+  if ( f != 0 )
+  {
+    while ( f != 0 )
+    {
+      N = N, leadexp(f);
+      f = f-lead(f);
+    }
+  }
+  else
+  {
+    N=N, leadexp(f);
+  }
+  N = N[2..size(N)]; // Deletes the zero added in the definition of T
+  intmat M=intmat(N,(size(N) div n),n); // Conversion from vector to matrix
+  return (M);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  ring r = 0,(x,y,z),lp;
+  poly f = x2y+3xz-5y+3;
+  newtonDiag(f);
+}
+
+////////////////////////////////////////////////////////////////////////