Changeset 28500c in git for Singular/LIB/normal.lib

Timestamp:

Jul 27, 1998, 11:13:02 AM (26 years ago)

Author:

Olaf Bachmann <obachman@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

d8cc2a7cea0a2cbf24ab556a355de8a20e298df6

Parents:

ae35b679235b164e70dad2c057963595f25bdd23

Message:

* incoporated Gerhard's bug fixes


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

File:

• Singular/LIB/normal.lib (modified) (16 diffs)

Singular/LIB/normal.lib

@@ -6 +6 @@
 ///////////////////////////////////////////////////////////////////////////////
 
-version="$Id: normal.lib,v 1.7 1998-06-17 09:23:17 pfister Exp $";
+version="$Id: normal.lib,v 1.8 1998-07-27 09:13:02 obachman Exp $";
 info="
 LIBRARY: normal.lib: PROCEDURE FOR NORMALIZATION (I)
@@ -254 +254 @@
       ideal endphi = maxideal(1);
       ideal endid = fetch(P,id);
+      L=substpart(endid,endphi,homo,rw);
+      def lastRing=L[1];
+      setring lastRing;
+
       attrib(endid,"isCohenMacaulay",isCo);
       attrib(endid,"isPrim",isPr);
@@ -261 +265 @@
       attrib(endid,"isCompleteIntersection",0);
       attrib(endid,"isRad",0);
-      export endid;
-      export endphi;
-      L = newR1;
+//      export endid;
+//      export endphi;
+//      L = newR1;
+      L=lastRing;
       L = insert(L,1,1);
       dbprint(printlevel-voice+3,"// case R = Hom(J,J)");
@@ -270 +275 @@
          "R=Hom(rad(J),rad(J))";
          "   ";
-         newR1;
+         lastRing;
          "   ";
          "the new ideal";
@@ -284 +289 @@
          id;
          "   ";
-         setring newR1;
+         setring lastRing;
          "the map";
          "   ";
@@ -385 +390 @@
    ideal endphi = ideal(X(1..nvars(R)));
 
-   map phi = basering,maxideal(1);
-   list Le = elimpart(endid);
-           //this proc and the next loop try to
-   q = size(Le[2]);                 //substitute as many variables as possible
-   rw1 = 0;
-   rw1[nvars(basering)] = 0;
-   rw1 = rw1+1;
-
-   while( size(Le[2]) != 0 )
-   {
-      endid = Le[1];
-      map ps = newRing,Le[5];
-      phi = phi(ps);
-      kill ps;
-
-      for( ii=1; ii<=size(rw1); ii++ )
-      {
-         if( Le[4][ii]==0 )
-         {
-            rw1[ii]=0;                             //look for substituted vars
-         }
-      }
-      Le=elimpart(endid);
-      q = q + size(Le[2]);
-   }
-   endphi = phi(endphi);
-
-//---------- return -----------------------------------------------------------
-// in the homogeneous case put weights for the remaining vars correctly, i.e.
-// delete from rw those weights for which the corresponding entry of rw1 is 0
-
-   if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 )
-   {
-      jj=1;
-      for( ii=2; ii<size(rw1); ii++)
-      {
-         jj++;
-         if( rw1[ii]==0 )
-         {
-            rw=rw[1..jj-1],rw[jj+1..size(rw)];
-            jj=jj-1;
-         }
-      }
-      if( rw1[1]==0 ) { rw=rw[2..size(rw)]; }
-      if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; }
-
-      ring lastRing = char(R),(T(1..nvars(newRing)-q)),(a(rw),dp);
-   }
-   else
-   {
-      ring lastRing = char(R),(T(1..nvars(newRing)-q)),dp;
-   }
-
-   ideal lastmap;
-   q = 1;
-   for(ii=1; ii<=size(rw1); ii++ )
-   {
-      if ( rw1[ii]==1 ) { lastmap[ii] = T(q); q=q+1; }
-      if ( rw1[ii]==0 ) { lastmap[ii] = 0; }
-   }
-   map phi = newRing,lastmap;
-   ideal endid  = phi(endid);
-   ideal endphi = phi(endphi);
+   L=substpart(endid,endphi,homo,rw);
+   def lastRing=L[1];
+   setring lastRing;
    attrib(endid,"isCohenMacaulay",isCo);
    attrib(endid,"isPrim",isPr);
@@ -455 +400 @@
    attrib(endid,"isCompleteIntersection",0);
    attrib(endid,"isRad",0);
-   export(endid);
-   export(endphi);
-   if(y==1)
+  // export(endid);
+  // export(endphi);
+           if(y==1)
    {
       "the new ring after reduction of the number of variables";
@@ -652 +597 @@
 example
 { "EXAMPLE:"; echo = 2;
- //Theo1
- ring r=32003,(x,y,z),wp(2,3,6);
- ideal i=zy2-zx3-x6;
-
- list pr=normal(i);
- def r1=pr[1];
- setring r1;
- KK;
- setring r;
+   ring  r = 0,(x,y,z),dp;
+
 }
 
@@ -690 +628 @@
    int depth,lauf,prdim;
    int ti=timer;
-
+   
    if(size(i)==0)
    {
@@ -794 +732 @@
          }
          MB=SM[2];
-         execute "ring newR6="+charstr(basering)+",("+varstr(basering)+"),("
-                      +ordstr(basering)+");";
-         ideal KK=fetch(BAS,MB);
-         ideal PP=fetch(BAS,ihp);
+         intvec rw;
+         list LL=substpart(MB,ihp,0,rw);
+         def newR6=LL[1];
+         setring newR6;
+         ideal KK=endid;
+         ideal PP=endphi;
+//        execute "ring newR6="+charstr(basering)+",("+varstr(basering)+"),("
+//                      +ordstr(basering)+");";
+//         ideal KK=fetch(BAS,MB);
+//         ideal PP=fetch(BAS,ihp);
          export PP;
          export KK;
@@ -814 +758 @@
       }
       MB=maxideal(1);
-      execute "ring newR5="+charstr(basering)+",("+varstr(basering)+"),("
-                      +ordstr(basering)+");";
-      ideal KK=fetch(BAS,MB);
-      ideal PP=fetch(BAS,ihp);
+      intvec rw;
+      list LL=substpart(MB,ihp,0,rw);
+      def newR5=LL[1];
+      setring newR5;
+      ideal KK=endid;
+      ideal PP=endphi;
+//      execute "ring newR5="+charstr(basering)+",("+varstr(basering)+"),("
+//                      +ordstr(basering)+");";
+//      ideal KK=fetch(BAS,MB);
+//      ideal PP=fetch(BAS,ihp);
       export PP;
       export KK;
@@ -836 +786 @@
       }
       MB=SM[2];
-      execute "ring newR4="+charstr(basering)+",("+varstr(basering)+"),("
-                      +ordstr(basering)+");";
-      ideal KK=fetch(BAS,MB);
-      ideal PP=fetch(BAS,ihp);
+      intvec rw;
+      list LL=substpart(MB,ihp,0,rw);
+      def newR4=LL[1];
+      setring newR4;
+      ideal KK=endid;
+      ideal PP=endphi;
+//      execute "ring newR4="+charstr(basering)+",("+varstr(basering)+"),("
+//                      +ordstr(basering)+");";
+//      ideal KK=fetch(BAS,MB);
+//      ideal PP=fetch(BAS,ihp);
       export PP;
       export KK;
@@ -916 +872 @@
          }
          MB=SM[2];
-         execute "ring newR3="+charstr(basering)+",("+varstr(basering)+"),("
-                      +ordstr(basering)+");";
-         ideal KK=fetch(BAS,MB);
-         ideal PP=fetch(BAS,ihp);
+         intvec rw;
+         list LL=substpart(MB,ihp,0,rw);
+//         execute "ring newR3="+charstr(basering)+",("+varstr(basering)+"),("
+//                      +ordstr(basering)+");";
+         def newR3=LL[1];
+         setring newR3;
+//         ideal KK=fetch(BAS,MB);
+//         ideal PP=fetch(BAS,ihp);
+         ideal KK=endid;
+         ideal PP=endphi;
          export PP;
          export KK;
@@ -1150 +1112 @@
          setring lastR;
          ideal KK=endid;
-         ideal PP=fetch(BAS,ihp);
+         ideal PP=endphi;
          export PP;
          export KK;
@@ -1232 +1194 @@
 example
 { "EXAMPLE:";echo = 2;
-//Theo1
-ring r=32003,(x,y,z),wp(2,3,6);
-ideal i=zy2-zx3-x6;
+   LIB"normal.lib";
+   //Huneke
+ring qr=31991,(a,b,c,d,e),dp;
+ideal i=
+5abcde-a5-b5-c5-d5-e5,
+ab3c+bc3d+a3be+cd3e+ade3,
+a2bc2+b2cd2+a2d2e+ab2e2+c2de2,
+abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5,
+ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5,
+a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6,
+a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4,
+b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5;
 
 list pr=normal(i);
@@ -1240 +1211 @@
 setring r1;
 KK;
-setring r;
 }
 
+proc substpart(ideal endid,ideal endphi, int homo, intvec rw) 
+{
+   def newRing=basering;
+   int ii,jj;
+   map phi = basering,maxideal(1);
+   list Le = elimpart(endid);
+           //this proc and the next loop try to
+   int q = size(Le[2]);              //substitute as many variables as possible
+   intvec rw1 = 0;                   //indices of substituted variables
+   rw1[nvars(basering)] = 0;
+   rw1 = rw1+1;
+
+   while( size(Le[2]) != 0 )
+   {
+      endid = Le[1];
+      map ps = newRing,Le[5];
+      phi = ps(phi);
+      kill ps;
+
+      for( ii=1; ii<=size(rw1); ii++ )
+      {
+         if( Le[4][ii]==0 )
+         {
+            rw1[ii]=0;                             //look for substituted vars
+         }
+      }
+      Le=elimpart(endid);
+      q = q + size(Le[2]);
+   }
+   endphi = phi(endphi);
+
+//---------- return -----------------------------------------------------------
+// in the homogeneous case put weights for the remaining vars correctly, i.e.
+// delete from rw those weights for which the corresponding entry of rw1 is 0
+
+   if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 )
+   {
+      jj=1;
+      for( ii=2; ii<size(rw1); ii++)
+      {
+         jj++;
+         if( rw1[ii]==0 )
+         {
+            rw=rw[1..jj-1],rw[jj+1..size(rw)];
+            jj=jj-1;
+         }
+      }
+      if( rw1[1]==0 ) { rw=rw[2..size(rw)]; }
+      if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; }
+
+      ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp);
+   }
+   else
+   {
+      ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp;
+   }
+
+   ideal lastmap;
+   q = 1;
+   for(ii=1; ii<=size(rw1); ii++ )
+   {
+      if ( rw1[ii]==1 ) { lastmap[ii] = T(q); q=q+1; }
+      if ( rw1[ii]==0 ) { lastmap[ii] = 0; }
+   }
+   map phi = newRing,lastmap;
+   ideal endid  = phi(endid);
+   ideal endphi = phi(endphi);
+   export(endid);
+   export(endphi);
+   list L = lastRing;
+   setring newRing;
+   return(L);
+}