Changeset 11dddeb in git for Singular/LIB/poly.lib

Timestamp:

Feb 23, 2004, 11:19:13 AM (20 years ago)

Author:

Hans Schönemann <hannes@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

dd8844f86c84ceb5f72e448153ac7a2d0daf5a00

Parents:

c229324983bbffba788eee2e34c2f5428261bb0f

Message:

*hannes: from V2-0


git-svn-id: file:///usr/local/Singular/svn/trunk@7052 2c84dea3-7e68-4137-9b89-c4e89433aadc

File:

• Singular/LIB/poly.lib (modified) (12 diffs)

Singular/LIB/poly.lib

@@ -1 +1 @@
 ///////////////////////////////////////////////////////////////////////////////
-version="$Id: poly.lib,v 1.33 2001-01-16 13:48:36 Singular Exp $";
+version="$Id: poly.lib,v 1.34 2004-02-23 10:19:13 Singular Exp $";
 category="General purpose";
 info="
@@ -13 +13 @@
  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 occuring in poly/...
+ 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
@@ -25 +25 @@
  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
+ hilbPoly( I)           Hilbert polynomial of basering/I
           (parameters in square brackets [] are optional)
 ";
@@ -32 +34 @@
 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);}
+   intvec 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;
+   for(i=1;i<=s;i++)
+   {
+      hp[i]=int(leadcoef(p[s-i+1]));
+   }
+   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 (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:
+           substitute1 (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 which substitutes
+         ring variables only by monomials
+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 = size(v); 
+     if(ncols(f)<mi)
+     {
+        mi = ncols(f);
+     }
+     m[rvar(v[1])]=f[1];
+     map phi = bas,m;
+     def J = phi(I);
+     for (ii=2; ii<=mi; ii++)
+     {
+        m = maxideal(1);
+        m[rvar(v[ii])]=f[ii];
+        phi = bas,m;
+        J = phi(J);
+     }
+     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
@@ -278 +405 @@
          (maxdeg of each var is 1).
          Of type int if id is of type poly, of type intmat else
-NOTE:    proc maxdeg1 returns 1 integer, the absolut maximum; moreover, it has
+NOTE:    proc maxdeg1 returns 1 integer, the absolute maximum; moreover, it has
          an option for computing weighted degrees
 EXAMPLE: example maxdeg; shows examples
@@ -317 +444 @@
 example
 { "EXAMPLE:"; echo = 2;
-   ring r = 0,(x,y,z),wp(-1,-2,-3);
+   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)!
@@ -397 +524 @@
 example
 { "EXAMPLE:"; echo = 2;
-   ring r = 0,(x,y,z),wp(-1,-2,-3);
+   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)!
@@ -404 +531 @@
    maxdeg1(f,v);                        //weighted maximal degree
    matrix m[2][2]=f+x10,1,0,f^2;
-   maxdeg1(m,v);                        //absolut weighted maximal degree
+   maxdeg1(m,v);                        //absolute weighted maximal degree
 }
 ///////////////////////////////////////////////////////////////////////////////
@@ -413 +540 @@
          (mindeg of each variable is 1) of type int if id of type poly, else
          of type intmat.
-NOTE:    proc mindeg1 returns one integer, the absolut minimum; moreover it
+NOTE:    proc mindeg1 returns one integer, the absolute minimum; moreover it
          has an option for computing weighted degrees.
 EXAMPLE: example mindeg; shows examples
@@ -539 +666 @@
    mindeg1(f,v);            // computes minimal weighted degree
    matrix m[2][2]=x10,1,0,f^2;
-   mindeg1(m,1..3);         // computes absolut minimum of weighted degrees
+   mindeg1(m,1..3);         // computes absolute minimum of weighted degrees
 }
 ///////////////////////////////////////////////////////////////////////////////
@@ -611 +738 @@
 
 proc lcm (id, list #)
-"USAGE:   lcm(p[,q]); p int/intve q a list of integers or
+"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 the common entries of p and q:
@@ -897 +1024 @@
           l[2]=their coefficients after interreduction
           l[3]=l[1]*l[2]
-PUPOSE:  Do interred only w.r.t. a subset of variables.
+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