Changeset 1e745b in git for Singular/LIB/sing.lib

Timestamp:

May 1, 1997, 7:49:56 PM (27 years ago)

Author:

Hans Schönemann <hannes@…>

Branches:

(u'spielwiese', 'ec94ef7a30b928574c0c3daf41f6804dff5f6b69')

Children:

4b35a9008ee2cec61ef2193763b534f1c072bf19

Parents:

22d79069af63dd10b93e136d82bb339faa6c28d9

Message:

* hannes: added codim


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

File:

• Singular/LIB/sing.lib (modified) (3 diffs)

Singular/LIB/sing.lib

@@ -1 @@
-// $Id: sing.lib,v 1.2 1997-04-28 19:27:25 obachman Exp $
+// $Id: sing.lib,v 1.3 1997-05-01 17:49:56 Singular Exp $
 //system("random",787422842);
 //(GMG/BM, last modified 26.06.96)
@@ -21 +21 @@
  T2((i);                T2-module of ideal i
  T12(i);                T1- and T2-module of ideal i
+ codim (id1, id2);      codimension of of id2 in id1
 
 LIB "inout.lib";
@@ -654 +655 @@
 }
 ///////////////////////////////////////////////////////////////////////////////
+proc codim (id1, id2)
+USAGE:  codim(id1,id2); id1,id2 ideal or module, both result of std
+RETURN:  result is the number of elements in id1 but not in id2 if finite,
+         conditions:
+         1.  id2 is contained in id1, if not return -2
+         2.  finiteness
+             consider the two hilberseries iv1(t) and iv2(t)
+             q(t)=(iv2(t)-iv1(t))/(1-t)^n must be rational, if not return -1
+             (n dimension of basering)
+         then the result is the sum of the coeff. of q(t)
+{
+   intvec iv1, iv2, iv;
+   int i, d1, d2, dd, i1, i2, ia, ie;
+  //--------------------------- check id2 < id1 ------------------------------
+   i = size(NF(lead(id2),lead(id1)));
+   if ( i > 0 )
+   {
+     return(-2);
+   }
+  //--------------------------- 1. check finiteness ---------------------------
+   i1 = dim(id1);
+   i2 = dim(id2);
+   if (i1 < 0)
+   {
+     if (i2 == 0)
+     {
+       return vdim(id2);
+     }
+     else
+     {
+       return(-1);
+     }
+   }
+   if (i2 != i1)
+   {
+     return(-1);
+   }
+   if (i2 <= 0)
+   {
+     return(vdim(id2)-vdim(id1));
+   }
+   if (mult(id2) != mult(id1))
+   {
+     return(-1);
+   }
+  //--------------------------- module ---------------------------------------
+   d1 = nrows(id1);
+   d2 = nrows(id2);
+   dd = 0;
+   if (d1 > d2)
+   {
+     id2=id2,maxideal(1)*gen(d1);
+     dd = -1;
+   }
+   if (d2 > d1)
+   {
+     id1=id1,maxideal(1)*gen(d2);
+     dd = 1;
+   }
+  //--------------------------- compute first hilbertseries ------------------
+   iv1 = hilb(id1,1);
+   i1 = size(iv1);
+   iv2 = hilb(id2,1);
+   i2 = size(iv2);
+  //--------------------------- difference of hilbertseries ------------------
+   if (i2 > i1)
+   {
+     for ( i=1; i<=i1; i=i+1)
+     {
+       iv2[i] = iv2[i]-iv1[i];
+     }
+     ie = i2;
+     iv = iv2;
+   }
+   else
+   {
+     for ( i=1; i<=i2; i=i+1)
+     {
+       iv1[i] = iv2[i]-iv1[i];
+     }
+     iv = iv1;
+     for (ie=i1;ie>=0;ie=ie-1)
+     {
+       if (ie == 0)
+       {
+         return(0);
+       }
+       if (iv[ie] != 0)
+       {
+         break;
+       }
+     }
+   }
+   ia = 1;
+   while (iv[ia] == 0) { ia=ia+1; }
+  //--------------------------- ia <= nonzeros <= ie -------------------------
+   iv1 = iv[ia];
+   for(i=ia+1;i<=ie;i=i+1)
+   {
+     iv1=iv1,iv[i];
+   }
+  //--------------------------- compute second hilbertseries -----------------
+   iv2 = hilb(iv1);
+  //--------------------------- check finitenes ------------------------------
+   i2 = size(iv2);
+   i1 = ie - ia + 1 - i2;
+   if (i1 != nvars(basering))
+   {
+     return(-1);
+   }
+  //--------------------------- compute result -------------------------------
+   i1 = 0;
+   for ( i=1; i<=i2; i=i+1)
+   {
+     i1 = i1 + iv2[i];
+   }
+   return(i1+dd);
+}
+