passagemath-singular 10.6.30__cp310-cp310-macosx_13_0_arm64.whl

sage_wheels/share/singular/LIB/homolog.lib

@@ -0,0 +1,1927 @@
+//////////////////////////////////////////////////////////////////////////////
+version="version homolog.lib 4.3.1.3 Feb_2023 "; // $Id: 3755d88b9200ca6640a2db98b0067769fed4ec9a $
+category="Commutative Algebra";
+info="
+LIBRARY:  homolog.lib   Procedures for Homological Algebra
+AUTHORS:  Gert-Martin Greuel, greuel@mathematik.uni-kl.de,
+@*        Bernd Martin,  martin@math.tu-cottbus.de
+@*        Christoph Lossen,  lossen@mathematik.uni-kl.de
+
+PROCEDURES:
+ canonMap(id);          the kernel and the cokernel of the canonical map
+ cup(M);                cup: Ext^1(M',M') x Ext^1() --> Ext^2()
+ cupproduct(M,N,P,p,q); cup: Ext^p(M',N') x Ext^q(N',P') --> Ext^p+q(M',P')
+ depth(I,M);            depth(I,M'),    I ideal, M module, M'=coker(M)
+ Ext_R(k,M);            Ext^k(M',R),    M module, R basering, M'=coker(M)
+ Ext(k,M,N);            Ext^k(M',N'),   M,N modules, M'=coker(M), N'=coker(N)
+ fitting(M,n);          n-th Fitting ideal of M'=coker(M), M module, n int
+ flatteningStrat(M);    Flattening stratification of M'=coker(M), M module
+ Hom(M,N);              Hom(M',N'),     M,N modules, M'=coker(M), N'=coker(N)
+ homology(A,B,M,N);     ker(B)/im(A),   homology of complex R^k--A->M'--B->N'
+ isCM(M);               test if coker(M) is Cohen-Macaulay, M module
+ isFlat(M);             test if coker(M) is flat, M module
+ isLocallyFree(M,r);    test if coker(M) is locally free of constant rank r
+ isReg(I,M);            test if I is coker(M)-sequence, I ideal, M module
+ hom_kernel(A,M,N);     ker(M'--A->N')  M,N modules, A matrix
+ kohom(A,k);            Hom(R^k,A),     A matrix over basering R
+ kontrahom(A,k);        Hom(A,R^k),     A matrix over basering R
+ KoszulHomology(I,M,n); n-th Koszul homology H_n(I,coker(M)), I=ideal
+ tensorMod(M,N);        Tensor product of modules M'=coker(M), N'=coker(N)
+ Tor(k,M,N);            Tor_k(M',N'),   M,N modules, M'=coker(M), N'=coker(N)
+";
+
+LIB "general.lib";
+LIB "deform.lib";
+LIB "matrix.lib";
+LIB "polylib.lib";
+LIB "primdec.lib";
+///////////////////////////////////////////////////////////////////////////////
+
+proc cup (module M,list #)
+"USAGE:   cup(M,[,any,any]);  M=module
+COMPUTE: cup-product Ext^1(M',M') x Ext^1(M',M') ---> Ext^2(M',M'), where
+         M':=R^m/M, if M in R^m, R basering (i.e. M':=coker(matrix(M))).
+@*       If called with >= 2 arguments: compute symmetrized cup-product
+ASSUME:  all Ext's  are finite dimensional
+RETURN:  - if called with 1 argument: matrix, the columns of the output present
+         the coordinates of b_i&b_j with respect to a kbase of Ext^2, where
+         b_1,b_2,... is a kbase of Ext^1 and & denotes cup product;@*
+         - if called with 2 arguments: matrix, the columns of the output
+         present the coordinates of (1/2)(b_i&b_j + b_j&b_i) with respect to
+         a kbase of Ext^2;
+         - if called with 3 arguments: list,
+@format
+      L[1] = matrix see above (symmetric case, for >=2 arguments)
+      L[2] = matrix of kbase of Ext^1
+      L[3] = matrix of kbase of Ext^2
+@end format
+NOTE:    printlevel >=1;  shows what is going on.
+         printlevel >=2;  shows result in another representation.
+@*       For computing cupproduct of M itself, apply proc to syz(M)!
+EXAMPLE: example cup; shows examples
+"
+{
+//---------- initialization ---------------------------------------------------
+   int    i,j,k,f0,f1,f2,f3,e1,e2;
+   module M1,M2,A,B,C,ker,ima,ext1,ext2,ext10,ext20;
+   matrix cup[1][0];
+   matrix kb1,lift1,kb2,mA,mB,mC;
+   ideal  tes1,tes2,null;
+   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
+//-----------------------------------------------------------------------------
+//take a resolution of M<--F(0)<--- ...  <---F(3)
+//apply Hom(-,M) and compute the Ext's
+//-----------------------------------------------------------------------------
+   list resM = nres(M,3);
+   M1 = resM[2];
+   M2 = resM[3];
+   f0 = nrows(M);
+   f1 = ncols(M);
+   f2 = ncols(M1);
+   f3 = ncols(M2);
+   tes1 = simplify(ideal(M),10);
+   tes2=simplify(ideal(M1),10);
+   if ((tes1[1]*tes2[1]==0) or (tes1[1]==1) or (tes2[1]==1))
+   {
+      dbprint(p,"// Ext == 0 , hence 'cup' is the zero-map");
+      return(@cup);
+   }
+//------ compute Ext^1 --------------------------------------------------------
+   B     = kohom(M,f2);
+   A     = kontrahom(M1,f0);
+   C     = intersect(A,B);
+   C     = reduce(C,std(null));C = simplify(C,10);
+   ker   = lift(A,C)+syz(A);
+   ima   = kohom(M,f1);
+   ima   = ima + kontrahom(M,f0);
+   ext1  = modulo(ker,ima);
+   ext10 = std(ext1);
+   e1    = vdim(ext10);
+   dbprint(p-1,"// vdim (Ext^1) = "+string(e1));
+   if (e1 < 0)
+   {
+     "// Ext^1 not of finite dimension";
+     return(cup);
+   }
+   kb1 = kbase(ext10);
+   kb1 = matrix(ker)*kb1;
+   dbprint(p-1,"// kbase of Ext^1(M,M)",
+              "//  - the columns present the kbase elements in Hom(F(1),F(0))",
+              "//  - F(*) a free resolution of M",kb1);
+
+//------ compute the liftings of Ext^1 ----------------------------------------
+   mC = matrix(A)*kb1;
+   lift1 =lift(B,mC);
+   dbprint(p-1,"// lift kbase of Ext^1:",
+    "//  - the columns present liftings of kbase elements into Hom(F(2),F(1))",
+    "//  - F(*) a free resolution of M ",lift1);
+
+//------ compute Ext^2  -------------------------------------------------------
+   B    = kohom(M,f3);
+   A    = kontrahom(M2,f0);
+   C    = intersect(A,B);
+   C    = reduce(C,std(null));C = simplify(C,10);
+   ker  = lift(A,C)+syz(A);
+   ima  = kohom(M,f2);
+   ima  = ima + kontrahom(M1,f0);
+   ext2 = modulo(ker,ima);
+   ext20= std(ext2);
+   e2   = vdim(ext20);
+   if (e2<0)
+   {
+     "// Ext^2 not of finite dimension";
+     return(cup);
+   }
+   dbprint(p-1,"// vdim (Ext^2) = "+string(e2));
+   kb2 = kbase(ext20);
+   kb2 = matrix(ker)*kb2;
+   dbprint(p-1,"// kbase of Ext^2(M,M)",
+             "//  - the columns present the kbase elements in Hom(F(2),F(0))",
+             "//  - F(*) is a free resolution of M ",kb2);
+//-------  compute: cup-products of base-elements -----------------------------
+   for (i=1;i<=e1;i=i+1)
+   {
+     for (j=1;j<=e1;j=j+1)
+     {
+       mA = matrix(ideal(lift1[j]),f1,f2);
+       mB = matrix(ideal(kb1[i]),f0,f1);
+       mC = mB*mA;
+       if (size(#)==0)
+       {                                          //non symmestric
+         mC = matrix(ideal(mC),f0*f2,1);
+         cup= concat(cup,mC);
+       }
+       else                                       //symmetric version
+       {
+         if (j>=i)
+         {
+           if (j>i)
+           {
+             mA = matrix(ideal(lift1[i]),f1,f2);
+             mB = matrix(ideal(kb1[j]),f0,f1);
+             mC = mC+mB*mA;mC=(1/2)*mC;
+           }
+           mC = matrix(ideal(mC),f0*f2,1);
+           cup= concat(cup,mC);
+         }
+       }
+     }
+   }
+   dbprint(p-1,"// matrix of cup-products (in Ext^2)",cup,
+               "////// end level 2 //////");
+//------- compute: presentation of base-elements -----------------------------
+   cup = lift(ker,cup);
+   cup = lift_kbase(cup,ext20);
+   if( p>2 )
+   {
+     "// the associated matrices of the bilinear mapping 'cup' ";
+     "// corresponding to the kbase elements of Ext^2(M,M) are shown,";
+     "//  i.e. the rows of the final matrix are written as matrix of";
+     "//  a bilinear form on Ext^1 x Ext^1";
+     matrix BL[e1][e1];
+     for (k=1;k<=e2;k=k+1)
+     {
+       "//-----component "+string(k)+":";
+       for (i=1;i<=e1;i=i+1)
+       {
+         for (j=1;j<=e1;j=j+1)
+         {
+           if (size(#)==0) { BL[i,j]=cup[k,j+e1*(i-1)]; }
+           else
+           {
+             if (i<=j)
+             {
+               BL[i,j]=cup[k,j+e1*(i-1)-binomial(i,2)];
+               BL[j,i]=BL[i,j];
+             }
+           }
+         }
+       }
+       print(BL);
+     }
+     "////// end level 3 //////";
+   }
+   if (size(#)>2) { return(cup,kb1,kb2);}
+   else {return(cup);}
+}
+example
+{"EXAMPLE";  echo=2;
+  int p      = printlevel;
+  ring  rr   = 32003,(x,y,z),(dp,C);
+  ideal  I   = x4+y3+z2;
+  qring  o   = std(I);
+  module M   = [x,y,0,z],[y2,-x3,z,0],[z,0,-y,-x3],[0,z,x,-y2];
+  print(cup(M));
+  print(cup(M,1));
+  // 2nd EXAMPLE  (shows what is going on)
+  printlevel = 3;
+  ring   r   = 0,(x,y),(dp,C);
+  ideal  i   = x2-y3;
+  qring  q   = std(i);
+  module M   = [-x,y],[-y2,x];
+  print(cup(M));
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc cupproduct (module M,module N,module P,int p,int q,list #)
+"USAGE:   cupproduct(M,N,P,p,q[,any]);  M,N,P modules, p,q integers
+COMPUTE: cup-product Ext^p(M',N') x Ext^q(N',P') ---> Ext^(p+q)(M',P'),
+         where M':=R^m/M, if M in R^m, R basering (i.e. M':=coker(matrix(M)))
+ASSUME:  all Ext's  are of finite dimension
+RETURN:  - if called with 5 arguments: matrix of the associated linear map
+         Ext^p (tensor) Ext^q --> Ext^(p+q),  i.e. the columns of <matrix>
+         present the coordinates of the cup products (b_i & c_j) with respect
+         to a kbase of Ext^p+q  (b_i resp. c_j are the chosen bases of Ext^p,
+         resp. Ext^q).@*
+         - if called with 6 arguments: list L,
+@format
+      L[1] = matrix (see above)
+      L[2] = matrix of kbase of Ext^p(M',N')
+      L[3] = matrix of kbase of Ext^q(N',P')
+      L[4] = matrix of kbase of Ext^p+q(N',P')
+@end format
+NOTE:    printlevel >=1;  shows what is going on.
+         printlevel >=2;  shows the result in another representation.@*
+         For computing the cupproduct of M,N itself, apply proc to syz(M),
+         syz(N)!
+EXAMPLE: example cupproduct; shows examples
+"
+{
+//---------- initialization ---------------------------------------------------
+   int    e1,e2,e3,i,j,k,f0,f1,f2;
+   module M1,M2,N1,N2,P1,P2,A,B,C,ker,ima,extMN,extMN0,extMP,
+          extMP0,extNP,extNP0;
+   matrix cup[1][0];
+   matrix kbMN,kbMP,kbNP,lift1,mA,mB,mC;
+   ideal  test1,test2,null;
+   int pp = printlevel-voice+3;  // pp=printlevel+1 (default: p=1)
+//-----------------------------------------------------------------------------
+//compute resolutions of M and N
+//                     M<--F(0)<--- ...  <---F(p+q+1)
+//                     N<--G(0)<--- ...  <---G(q+1)
+//-----------------------------------------------------------------------------
+   list resM = nres(M,p+q+1);
+   M1 = resM[p];
+   M2 = resM[p+1];
+   list resN = nres(N,q+1);
+   N1 = resN[q];
+   N2 = resN[q+1];
+   P1 = resM[p+q];
+   P2 = resM[p+q+1];
+//-------test: Ext==0?---------------------------------------------------------
+   test1 = simplify(ideal(M1),10);
+   test2 = simplify(ideal(N),10);
+   if (test1[1]==0) { dbprint(pp,"//Ext(M,N)=0");return(cup); }
+   test1 = simplify(ideal(N1),10);
+   test2 = simplify(ideal(P),10);
+   if (test1[1]==0) { dbprint(pp,"//Ext(N,P)=0");return(cup); }
+   test1 = simplify(ideal(P1),10);
+   if (test1[1]==0) { dbprint(pp,"//Ext(M,P)=0");return(cup); }
+ //------ compute kbases of Ext's ---------------------------------------------
+ //------ Ext(M,N)
+   test1 = simplify(ideal(M2),10);
+   if (test1[1]==0) { ker = freemodule(ncols(M1)*nrows(N));}
+   else
+   {
+     A   = kontrahom(M2,nrows(N));
+     B   = kohom(N,ncols(M2));
+     C   = intersect(A,B);
+     C   = reduce(C,std(ideal(0)));C=simplify(C,10);
+     ker = lift(A,C)+syz(A);
+   }
+   ima   = kohom(N,ncols(M1));
+   A     = kontrahom(M1,nrows(N));
+   ima   = ima+A;
+   extMN = modulo(ker,ima);
+   extMN0= std(extMN);
+   e1    = vdim(extMN0);
+   dbprint(pp-1,"// vdim Ext(M,N) = "+string(e1));
+   if (e1 < 0)
+   {
+     "// Ext(M,N) not of finite dimension";
+     return(cup);
+   }
+   kbMN  = kbase(extMN0);
+   kbMN = matrix(ker)*kbMN;
+   dbprint(pp-1,"// kbase of Ext^p(M,N)",
+          "//  - the columns present the kbase elements in Hom(F(p),G(0))",
+          "//  - F(*),G(*) are free resolutions of M and N",kbMN);
+//------- Ext(N,P)
+   test1 = simplify(ideal(N2),10);
+   if (test1[1]==0) {  ker = freemodule(ncols(N1)*nrows(P)); }
+   else
+   {
+     A = kontrahom(N2,nrows(P));
+     B = kohom(P,ncols(N2));
+     C = intersect(A,B);
+     C = reduce(C,std(ideal(0)));C=simplify(C,10);
+     ker = lift(A,C)+syz(A);
+   }
+   ima   = kohom(P,ncols(N1));
+   A     = kontrahom(N1,nrows(P));
+   ima   = ima+A;
+   extNP = modulo(ker,ima);
+   extNP0= std(extNP);
+   e2    = vdim(extNP0);
+   dbprint(pp-1,"// vdim Ext(N,P) = "+string(e2));
+   if (e2 < 0)
+   {
+     "// Ext(N,P) not of finite dimension";
+     return(cup);
+   }
+   kbNP  = kbase(extNP0);
+   kbNP  = matrix(ker)*kbNP;
+   dbprint(pp-1,"// kbase of Ext(N,P):",kbNP,
+          "// kbase of Ext^q(N,P)",
+          "//  - the columns present the kbase elements in Hom(G(q),H(0))",
+          "//  - G(*),H(*) are free resolutions of N and P",kbNP);
+
+//------ Ext(M,P)
+   test1 = simplify(ideal(P2),10);
+   if (test1[1]==0) { ker = freemodule(ncols(P1)*nrows(P)); }
+   else
+   {
+     A = kontrahom(P2,nrows(P));
+     B = kohom(P,ncols(P2));
+     C = intersect(A,B);
+     C = reduce(C,std(ideal(0)));C=simplify(C,10);
+     ker = lift(A,C)+syz(A);
+   }
+   ima   = kohom(P,ncols(P1));
+   A     = kontrahom(P1,nrows(P));
+   ima   = ima+A;
+   extMP = modulo(ker,ima);
+   extMP0= std(extMP);
+   e3    = vdim(extMP0);
+   dbprint(pp-1,"// vdim Ext(M,P) = "+string(e3));
+   if (e3 < 0)
+   {
+     "// Ext(M,P) not of finite dimension";
+     return(cup);
+   }
+   kbMP  = kbase(extMP0);
+   kbMP  = matrix(ker)*kbMP;
+   dbprint(pp-1,"// kbase of Ext^p+q(M,P)",
+          "//  - the columns present the kbase elements in Hom(F(p+q),H(0))",
+          "//  - F(*),H(*) are free resolutions of M and P",kbMP);
+//----- lift kbase of Ext(M,N) ------------------------------------------------
+   lift1 = kbMN;
+   for (i=1;i<=q;i=i+1)
+   {
+     mA = kontrahom(resM[p+i],nrows(resN[i]));
+     mB = kohom(resN[i],ncols(resM[p+i]));
+     lift1 = lift(mB,mA*lift1);
+   }
+   dbprint(pp-1,"// lifting of kbase of Ext^p(M,N)",
+   "//  - the columns present liftings of kbase elements"+
+   " in Hom(F(p+q),G(q))",lift1);
+//-------  compute: cup-products of base-elements -----------------------------
+   f0 = nrows(P);
+   f1 = ncols(N1);
+   f2 = ncols(resM[p+q]);
+   for (i=1;i<=e1;i=i+1)
+   {
+     for (j=1;j<=e2;j=j+1)
+     {
+       mA = matrix(ideal(lift1[j]),f1,f2);
+       mB = matrix(ideal(kbMP[i]),f0,f1);
+       mC = mB*mA;
+       mC = matrix(ideal(mC),f0*f2,1);
+       cup= concat(cup,mC);
+     }
+   }
+   dbprint(pp-1,"// matrix of cup-products (in Ext^p+q)",cup,
+                "////// end level 2 //////");
+//------- compute: presentation of base-elements -----------------------------
+   cup = lift(ker,cup);
+   cup = lift_kbase(cup,extMP0);
+//------- special output ------------------------------------------------------
+   if (pp>2)
+   {
+     "// the associated matrices of the bilinear mapping 'cup' ";
+     "// corresponding to the kbase elements of Ext^p+q(M,P) are shown,";
+     "//  i.e. the rows of the final matrix are written as matrix of";
+     "//  a bilinear form on Ext^p x Ext^q";
+     matrix BL[e1][e2];
+     for (k=1;k<=e3;k=k+1)
+     {
+       "//----component "+string(k)+":";
+       for (i=1;i<=e1;i=i+1)
+       {
+         for (j=1;j<=e2;j=j+1)
+         {
+           BL[i,j]=cup[k,j+e1*(i-1)];
+         }
+        }
+        print(BL);
+      }
+     "////// end level 3 //////";
+   }
+   if (size(#)) { return(cup,kbMN,kbNP,kbMP);}
+   else         { return(cup); }
+}
+example
+{"EXAMPLE";  echo=2;
+  int p      = printlevel;
+  ring  rr   = 32003,(x,y,z),(dp,C);
+  ideal  I   = x4+y3+z2;
+  qring  o   = std(I);
+  module M   = [x,y,0,z],[y2,-x3,z,0],[z,0,-y,-x3],[0,z,x,-y2];
+  print(cupproduct(M,M,M,1,3));
+  printlevel = 3;
+  list l     = (cupproduct(M,M,M,1,3,"any"));
+  show(l[1]);show(l[2]);
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc Ext_R (intvec v, module M, list #)
+"USAGE:   Ext_R(v,M[,p]);  v int resp. intvec , M module, p int
+COMPUTE: A presentation of Ext^k(M',R); for k=v[1],v[2],..., M'=coker(M).
+         Let
+@example
+  0 <-- M' <-- F0 <-M-- F1 <-- F2 <-- ...
+@end example
+         be a free resolution of M'. If
+@example
+        0 --> F0* -A1-> F1* -A2-> F2* -A3-> ...
+@end example
+         is the dual sequence, Fi*=Hom(Fi,R), then Ext^k = ker(Ak+1)/im(Ak)
+         is presented as in the following exact sequences:
+@example
+    R^p --syz(Ak+1)-> Fk* ---Ak+1---->  Fk+1* ,
+    R^q ----Ext^k---> R^p --syz(Ak+1)-> Fk*/im(Ak).
+@end example
+         Hence, Ext^k=modulo(syz(Ak+1),Ak) presents Ext^k(M',R).
+RETURN:  - module Ext, a presentation of Ext^k(M',R) if v is of type int@*
+         - a list of Ext^k (k=v[1],v[2],...) if v is of type intvec.@*
+         - In case of a third argument of type int return a list l:
+@format
+     l[1] = module Ext^k resp. list of Ext^k
+     l[2] = SB of Ext^k resp. list of SB of Ext^k
+     l[3] = matrix resp. list of matrices, each representing a kbase of Ext^k
+              (if finite dimensional)
+@end format
+DISPLAY: printlevel >=0: (affine) dimension of Ext^k for each k  (default)
+         printlevel >=1: Ak, Ak+1 and kbase of Ext^k in Fk*
+NOTE:    In order to compute Ext^k(M,R) use the command Ext_R(k,syz(M));@*
+         By default, the procedure uses the @code{mres} command. If called
+         with the additional parameter @code{\"sres\"}, the @code{sres} command
+         is used instead.@*
+         If the attribute @code{\"isHomog\"} has been set for the input module, it
+         is also set for the returned module (accordingly).
+EXAMPLE: example Ext_R; shows an example
+"
+{
+  // In case M is known to be a SB, set attrib(M,"isSB",1); in order to
+  // avoid  unnecessary SB computations
+
+  //------------ check for weight vector (graded case) -----------------------
+  int withWeight;
+  intvec weightM,weightR,ww;
+  if ( typeof(attrib(M,"isHomog"))!="string" )
+  {
+    weightM=attrib(M,"isHomog");
+    withWeight=1;
+  }
+
+  //------------ initialisation ----------------------------------------------
+  module m1t,m1,m2,m2t,ret,ret0,ker;
+  vector leadCol;
+  matrix kb;
+  module G;
+  list L1,L2,L3,L,K;
+  resolution resm2;
+  int j,k,max,ii,t1,t2,di,leadComp,shift;
+  intvec A1,A2,A3;
+  int s = size(v);
+  max = Max(v);                // the maximum integer occurring in intvec v
+  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
+  // --------------- Variante mit sres
+  for( ii=1; ii<=size(#); ii++ )
+  {
+    if (typeof(#[ii])=="int") { // return a list if t2=1
+      t2=1;
+    }
+    else {
+      if (typeof(#[ii])=="string") {
+        // NOTE: at this writing, sres does not return weights
+        if ( #[ii]=="sres" ) { t1=1; } // use sres instead of mres if t1=1
+      }
+    }
+  }
+
+//----------------- compute resolution of coker(M) ----------------------------
+  if( max<0 )
+  {
+    dbprint(p,"// Ext^i=0 for i<0!");
+    module Result=[1];
+    if (withWeight==1) { attrib(Result,"isHomog",intvec(0)); }
+    if (s==1) {
+      if (t2==0) { return(Result); }
+      else       { return( list(Result,Result,matrix(0)) ); }
+    }
+    list Out, KBOut;
+    for (j=1;j<=s;j++) {
+      Out[j] = Result;
+      KBOut[j] = matrix(0);
+    }
+    if (t2==0) { return(Out); }
+    else       { return( list(Out,Out,KBOut) ); }
+  }
+  if( t1==1 )
+  { // compute resolution via sres command
+    if( attrib(M,"isSB")==0 ) {
+      M=std(M);
+    }
+    list resl = sres(M,max+1);
+    if (withWeight) {
+      // ****
+      // **** at this writing, sres does not return weights, we have to
+      // **** go through the resolution to compute them
+      // ****
+      attrib(resl,"isHomog",weightM);  // weightM = weights of M
+      G=resl[1];
+      attrib(G,"isHomog",weightM);
+      resl[1]=G;
+      weightR=weightM;
+
+      for (j=2; j<=size(resl); j++) {
+        if (size(G)!=0) {
+          ww=0;
+          for (k=1; k<=ncols(G); k++) {
+            if (size(G[k])==0) { ww[k]=0; }
+            else {
+              leadCol = leadmonom(G[k]);
+              leadComp = nrows(leadCol);
+              ww[k] = deg(leadCol)+weightR[leadComp];
+            }
+          }
+          G=resl[j];
+          attrib(G,"isHomog",ww);
+          resl[j]=G;
+          weightR=ww;
+        }
+      }
+    }
+  }
+  else { list resl = mres(M,max+1);
+    if ((withWeight) and (size(M)==0)) {
+      // ***** At this writing: special treatment for zero module needed
+      G=resl[1];
+      attrib(G,"isHomog",weightM);
+      resl[1]=G;
+    }
+  }
+  for( ii=1; ii<=s; ii++ )
+  {
+//-----------------  apply Hom(_,R) at k-th place -----------------------------
+    k=v[ii];
+    dbprint(p-1,"// Computing Ext^"+string(k)+":");
+    if( k<0 )                   // Ext^k=0 for negative k
+    {
+      dbprint(p-1,"// Ext^i=0 for i<0!");
+      ret    = gen(1);
+      ret0   = std(ret);
+      if (withWeight==1) {
+        attrib(ret,"isHomog",intvec(0));
+        attrib(ret0,"isHomog",intvec(0));
+      }
+      L1[ii] = ret;
+      L2[ii] = ret0;
+      L3[ii] = matrix(kbase(ret0));
+      di=dim(ret0);
+      dbprint(p,"// dimension of Ext^"+string(k)+":  "+string(di));
+      if (di==0)
+      {
+        dbprint(p,"// vdim of Ext^"+string(k)+":       "+string(vdim(ret0)));
+      }
+      dbprint(p,"");
+    }
+    else
+    {
+      m2t = resl[k+1];
+      m2 = transpose(m2t);
+      if ((typeof(attrib(m2t,"isHomog"))!="string" ) && (withWeight))
+      {
+        // ------------- compute weights for dual -----------------------------
+        weightR=attrib(m2t,"isHomog");
+        // --------------------------------------------------------------------
+        // *** set correct weights (at this writing, shift in resolution
+        // *** is not considered when defining the weights for the
+        // *** modules in the resolution):
+        A1=attrib(M,"isHomog");
+        A2=attrib(resl[1],"isHomog");
+        shift=A1[1]-A2[1];
+        for (j=1; j<=size(weightR); j++) { weightR[j]=weightR[j]+shift; }
+        attrib(m2t,"isHomog",weightR);
+        // --------------------------------------------------------------------
+        ww=0;
+        for (j=1; j<=nrows(m2); j++) {
+          if (size(m2t[j])==0) { ww[j]=0; }
+          else {
+            leadCol = leadmonom(m2t[j]);
+            leadComp = nrows(leadCol);
+            ww[j] = deg(leadCol)+weightR[leadComp];
+          }
+        }
+        attrib(m2,"isHomog",-ww);  // dualize --> negative weights
+        // --------------------------------------------------------------------
+        // *** the following should be replaced by the syz command,
+        // *** but syz forgets weights.....
+        resm2 = nres(m2,2);
+        ker = resm2[2];
+        if ((size(ker)>0) and (size(m2)>0)) {
+          // ------------------------------------------------------------------
+          // *** set correct weights (at this writing, shift in resolution
+          // *** is not considered when defining the weights for the
+          // *** modules in the resolution):
+          A1=attrib(resm2,"isHomog");
+          A2=attrib(resm2[1],"isHomog");
+          A3=attrib(ker,"isHomog");
+          shift=A1[1]-A2[1];
+          for (j=1; j<=size(A3); j++) { A3[j]=A3[j]+shift; }
+          // *** set correct weights where weights are undetermined due to
+          // *** zero columns in m2  (read weights from m2t)
+          for (j=1; j<=ncols(m2); j++) {
+            if (size(m2[j])==0) { A3[j]=-weightR[j]; }
+          }
+          attrib(ker,"isHomog",A3);
+          // ------------------------------------------------------------------
+        }
+      }
+      else {
+        ker = syz(m2);
+      }
+
+      if( k==0 ) { matrix MMM1[ncols(m2)][1];
+        m1=MMM1;
+      }
+      else { // k>0
+        m1t = resl[k];
+        m1 = transpose(resl[k]);
+        if ((typeof(attrib(m1t,"isHomog"))!="string" ) && (withWeight)) {
+        // ------------- compute weights for dual -----------------------------
+          weightR=attrib(resl[k],"isHomog");
+          // ------------------------------------------------------------------
+          // *** set correct weights (at this writing, shift in resolution
+          // *** is not considered when defining the weights for the
+          // *** modules in the resolution):
+          A1=attrib(M,"isHomog");
+          A2=attrib(resl[1],"isHomog");
+          shift=A1[1]-A2[1];
+          for (j=1; j<=size(weightR); j++) { weightR[j]=weightR[j]+shift; }
+          attrib(m1t,"isHomog",weightR);
+          // ------------------------------------------------------------------
+          ww=0;
+          for (j=1; j<=nrows(m1); j++) {
+            if (size(m1t[j])==0) { ww[j]=0; }
+            else {
+              leadCol = leadmonom(m1t[j]);
+              leadComp = nrows(leadCol);
+              ww[j] = deg(leadCol)+weightR[leadComp];
+            }
+          }
+          attrib(m1,"isHomog",-ww);  // dualize --> negative weights
+        }
+      }
+      //----------------- presentation of ker(m2)/im(m1) ---------------------
+      if ((k==0) and (size(M)==0)) {
+        ret = M;
+        if (withWeight) { attrib(ret,"isHomog",-weightM); }
+      }
+      else {
+        ret = modulo(ker,m1);
+      }
+      dbprint(p-1,
+         "// Let 0<--coker(M)<--F0<--F1<--F2<--... be a resolution of M,",
+         "// then F"+string(k)+"*-->F"+string(k+1)+"* is given by:",m2,
+         "// and F"+string(k-1)+"*-->F"+string(k)+"* is given by:",m1,"");
+      ret0 = std(ret);
+
+      di=dim(ret0);
+      dbprint(p,"// dimension of Ext^"+string(k)+":  "+string(di));
+      if (di==0)
+      {
+        dbprint(p,"// vdim of Ext^"+string(k)+":       "+string(vdim(ret0)));
+      }
+      dbprint(p,"");
+      if( t2 )
+      {
+         if( vdim(ret0)>=0 )
+         {
+            kb = kbase(ret0);
+            if ( size(ker)!=0 ) { kb = matrix(ker)*kb; }
+            dbprint(p-1,
+              "// columns of matrix are kbase of Ext^"+string(k)+" in F"
+              +string(k)+"*:",kb,"");
+            L3[ii] = kb;
+         }
+         L2[ii] = ret0;
+      }
+      L1[ii] = ret;
+    }
+  }
+  if( t2 )
+  {
+     if( s>1 ) { L = L1,L2,L3; return(L); }
+     else { L = ret,ret0,kb; return(L); }
+  }
+  else
+  {
+     if( s>1 ) { return(L1); }
+     else { return(ret); }
+  }
+}
+example
+{"EXAMPLE:";     echo=2;
+  int p      = printlevel;
+  printlevel = 1;
+  ring r     = 0,(x,y,z),dp;
+  ideal i    = x2y,y2z,z3x;
+  module E   = Ext_R(1,i);    //computes Ext^1(r/i,r)
+  is_zero(E);
+
+  qring R    = std(x2+yz);
+  intvec v   = 0,2;
+  printlevel = 2;             //shows what is going on
+  ideal i    = x,y,z;         //computes Ext^i(r/(x,y,z),r/(x2+yz)), i=0,2
+  list L     = Ext_R(v,i,1);  //over the qring R=r/(x2+yz), std and kbase
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc Ext (intvec v, module M, module N, list #)
+"USAGE:   Ext(v,M,N[,any]);  v int resp. intvec, M,N modules
+COMPUTE: A presentation of Ext^k(M',N'); for k=v[1],v[2],... where
+         M'=coker(M) and N'=coker(N). Let
+@example
+       0 <-- M' <-- F0 <-M-- F1 <-- F2 <--... ,
+       0 <-- N' <-- G0 <--N- G1
+@end example
+         be a free resolution of M', resp. a presentation of N'. Consider
+         the commutative diagram
+@example
+           0                  0                  0
+           |^                 |^                 |^
+   --> Hom(Fk-1,N') -Ak-> Hom(Fk,N') -Ak+1-> Hom(Fk+1,N')
+           |^                 |^                 |^
+   --> Hom(Fk-1,G0) -Ak-> Hom(Fk,G0) -Ak+1-> Hom(Fk+1,G0)
+                              |^                 |^
+                              |C                 |B
+                          Hom(Fk,G1) ------> Hom(Fk+1,G1)
+
+      (Ak,Ak+1 induced by M and B,C induced by N).
+@end example
+         Let K=modulo(Ak+1,B), J=module(Ak)+module(C) and Ext=modulo(K,J),
+         then we have exact sequences
+@example
+    R^p --K-> Hom(Fk,G0) --Ak+1-> Hom(Fk+1,G0)/im(B),
+
+    R^q -Ext-> R^p --K-> Hom(Fk,G0)/(im(Ak)+im(C)).
+@end example
+         Hence, Ext presents Ext^k(M',N').
+RETURN:  - module Ext, a presentation of Ext^k(M',N') if v is of type int@*
+         - a list of Ext^k (k=v[1],v[2],...) if v is of type intvec.@*
+         - In case of a third argument of any type return a list l:
+@format
+             l[1] = module Ext/list of Ext^k
+             l[2] = SB of Ext/list of SB of Ext^k
+             l[3] = matrix/list of matrices, each representing a kbase of Ext^k
+                       (if finite dimensional)
+@end format
+DISPLAY: printlevel >=0: dimension, vdim of Ext^k for each k  (default).
+@*       printlevel >=1: matrices Ak, Ak+1 and kbase of Ext^k in Hom(Fk,G0)
+         (if finite dimensional)
+NOTE:    In order to compute Ext^k(M,N) use the command Ext(k,syz(M),syz(N));
+         or: list P=mres(M,2); list Q=mres(N,2); Ext(k,P[2],Q[2]);
+EXAMPLE: example Ext; shows an example
+"
+{
+//---------- initialisation ---------------------------------------------------
+  int k,max,ii,l,row,col,di;
+  module A,B,C,D,M1,M2,N1,ker,imag,extMN,extMN0;
+  matrix kb;
+  list L1,L2,L3,L,resM,K;
+  ideal  test1;
+  intmat Be;
+  int s = size(v);
+  max = Max(v);                   // the maximum integer occurring in intvec v
+  int p = printlevel-voice+3;     // p=printlevel+1 (default: p=1)
+//---------- test: coker(N)=basering, coker(N)=0 ? ----------------------------
+  if( max<0 ) { dbprint(p,"// Ext^i=0 for i<0!"); return([1]); }
+  N1 = std(N);
+  if( size(N1)==0 )      //coker(N)=basering, in this case proc Ext_R is faster
+  { printlevel=printlevel+1;
+    if( size(#)==0 )
+    { def E = Ext_R(v,M);
+      printlevel=printlevel-1;
+      return(E);
+    }
+    else
+    { def E = Ext_R(v,M,#[1]);
+       printlevel=printlevel-1;
+       return(E);
+     }
+  }
+  if( dim(N1)==-1 )                          //coker(N)=0, all Ext-groups are 0
+  { dbprint(p-1,"2nd module presents 0, hence Ext^k=0, for all k");
+    for( ii=1; ii<=s; ii++ )
+    { k=v[ii];
+      extMN    = gen(1);
+      extMN0   = std(extMN);
+      L1[ii] = extMN;
+      L2[ii] = extMN0;
+      L3[ii] = matrix(kbase(extMN0));
+      di=dim(extMN0);
+      dbprint(p,"// dimension of Ext^"+string(k)+":  "+string(di));
+      if (di==0)
+      {
+        dbprint(p,"// vdim of Ext^"+string(k)+":       "+string(vdim(extMN0)));
+      }
+      dbprint(p,"");
+    }
+  }
+  else
+  {
+    if( size(N1) < size(N) ) { N=N1;}
+    row = nrows(N);
+//---------- resolution of M -------------------------------------------------
+    resM = mres(M,max+1);
+    for( ii=1; ii<=s; ii++ )
+    { k=v[ii];
+      if( k<0  )                                   // Ext^k is 0 for negative k
+      { dbprint(p-1,"// Ext^k=0 for k<0!");
+        extMN    = gen(1);
+        extMN0   = std(extMN);
+        L1[ii] = extMN;
+        L2[ii] = extMN0;
+        L3[ii] = matrix(kbase(extMN0));
+        di=dim(extMN0);
+        dbprint(p,"// dimension of Ext^"+string(k)+":  "+string(di));
+        if (di==0)
+        {
+          dbprint(p,"// vdim of Ext^"+string(k)+":       "
+                  +string(vdim(extMN0)));
+        }
+        dbprint(p,"");
+      }
+      else
+      { M2 = resM[k+1];
+        if( k==0 ) { M1=0; }
+        else { M1 = resM[k]; }
+        col = nrows(M2);
+        D = kohom(N,col);
+//---------- computing homology ----------------------------------------------
+        imag  = kontrahom(M1,row);
+        A     = kontrahom(M2,row);
+        B     = kohom(N,ncols(M2));
+        ker   = modulo(A,B);
+        imag  = imag,D;
+        extMN = modulo(ker,imag);
+        dbprint(p-1,"// Computing Ext^"+string(k)+
+         " (help Ext; gives an explanation):",
+      "// Let 0<--coker(M)<--F0<--F1<--F2<--... be a resolution of coker(M),",
+      "// and 0<--coker(N)<--G0<--G1 a presentation of coker(N),",
+      "// then Hom(F"+string(k)+",G0)-->Hom(F"+string(k+1)+
+      ",G0) is given by:",A,
+      "// and Hom(F"+string(k-1)+",G0) + Hom(F"+string(k)+",G1)-->Hom(F"
+                                      +string(k)+",G0) is given by:",imag,"");
+        extMN0 = std(extMN);
+        di=dim(extMN0);
+        dbprint(p,"// dimension of Ext^"+string(k)+":  "+string(di));
+        if (di==0)
+        {
+          dbprint(p,"// vdim of Ext^"+string(k)+":       "
+                  +string(vdim(extMN0)));
+        }
+        dbprint(p,"");
+
+//---------- more information -------------------------------------------------
+        if( size(#)>0 )
+        { if( vdim(extMN0) >= 0 )
+          { kb = kbase(extMN0);
+            if ( size(ker)!=0) { kb = matrix(ker)*kb; }
+            dbprint(p-1,"// columns of matrix are kbase of Ext^"+
+                     string(k)+" in Hom(F"+string(k)+",G0)",kb,"");
+            if( p>0 )
+            { for (l=1;l<=ncols(kb);l=l+1)
+              {
+                "// element",l,"of kbase of Ext^"+string(k)+" in Hom(F"+string(k)+",G0)";
+                "// as matrix: F"+string(k)+"-->G0";
+                print(matrix(ideal(kb[l]),row,col));
+              }
+              "";
+            }
+            L3[ii] = matrix(kb);
+          }
+          L2[ii] = extMN0;
+        }
+        L1[ii] = extMN;
+      }
+    }
+  }
+  if( size(#) )
+  {  if( s>1 ) { L = L1,L2,L3; return(L); }
+     else { L = extMN,extMN0,matrix(kb); return(L); }
+  }
+  else
+  {  if( s>1 ) { return(L1); }
+     else { return(extMN); }
+  }
+}
+example
+{"EXAMPLE:";   echo=2;
+  int p      = printlevel;
+  printlevel = 1;
+  ring r     = 0,(x,y),dp;
+  ideal i    = x2-y3;
+  ideal j    = x2-y5;
+  list E     = Ext(0..2,i,j);    // Ext^k(r/i,r/j) for k=0,1,2 over r
+  qring R    = std(i);
+  ideal j    = fetch(r,j);
+  module M   = [-x,y],[-y2,x];
+  printlevel = 2;
+  module E1  = Ext(1,M,j);       // Ext^1(R^2/M,R/j) over R=r/i
+  list l     = Ext(4,M,M,1);     // Ext^4(R^2/M,R^2/M) over R=r/i
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc Hom (module M, module N, list #)
+"USAGE:   Hom(M,N,[any]);  M,N=modules
+COMPUTE: A presentation of Hom(M',N'), M'=coker(M), N'=coker(N) as follows:
+         let
+@example
+   F1 --M-> F0 -->M' --> 0,    G1 --N-> G0 --> N' --> 0
+@end example
+         be presentations of M' and N'. Consider
+@example
+                                  0               0
+                                  |^              |^
+       0 --> Hom(M',N') ----> Hom(F0,N') ----> Hom(F1,N')
+                                  |^              |^
+  (A:  induced by M)          Hom(F0,G0) --A-> Hom(F1,G0)
+                                  |^              |^
+  (B,C:induced by N)              |C              |B
+                              Hom(F0,G1) ----> Hom(F1,G1)
+
+@end example
+         Let D=modulo(A,B) and Hom=modulo(D,C), then we have exact sequences
+@example
+   R^p  --D-> Hom(F0,G0) --A-> Hom(F1,G0)/im(B),
+
+ R^q -Hom-> R^p --D-> Hom(F0,G0)/im(C) --A-> Hom(F1,G0)/im(B).
+@end example
+         Hence Hom presents Hom(M',N')
+RETURN:  module Hom, a presentation of Hom(M',N'), resp., in case of
+         3 arguments, a list l (of size <=3):
+@format
+           - l[1] = Hom
+           - l[2] = SB of Hom
+           - l[3] = kbase of coker(Hom) (if finite dimensional, not 0),
+                    represented by elements in Hom(F0,G0) via mapping D
+@end format
+DISPLAY: printlevel >=0: (affine) dimension of Hom  (default)
+@*       printlevel >=1: D and C and kbase of coker(Hom) in Hom(F0,G0)
+@*       printlevel >=2: elements of kbase of coker(Hom) as matrix :F0-->G0
+NOTE:    DISPLAY is as described only for a direct call of 'Hom'. Calling 'Hom'
+         from another proc has the same effect as decreasing printlevel by 1.
+EXAMPLE: example Hom;  shows examples
+"
+{
+//---------- initialisation ---------------------------------------------------
+  int l,p,di;
+  matrix kb;
+  module A,B,C,D,homMN,homMN0;
+  list L;
+//---------- computation of Hom -----------------------------------------------
+  B = kohom(N,ncols(M));
+  A = kontrahom(M,nrows(N));
+  C = kohom(N,nrows(M));
+  D = modulo(A,B);
+  homMN = modulo(D,C);
+  homMN0= std(homMN);
+  p = printlevel-voice+3;       // p=printlevel+1 (default: p=1)
+  di= dim(homMN0);
+  dbprint(p,"// dimension of Hom:  "+string(di));
+  if (di==0)
+  {
+    dbprint(p,"// vdim of Hom:       "+string(vdim(homMN0)));
+  }
+  dbprint(p,"");
+  dbprint(p-1,
+   "// given  F1 --M-> F0 -->M'--> 0 and  G1 --N-> G0 -->N'--> 0,",
+   "// show D = ker( Hom(F0,G0) --> Hom(F1,G0)/im(Hom(F1,G1)->Hom(F1,G0)) )",D,
+   "// show C = im ( Hom(F0,G1) --> Hom(F0,G0) )",C,"");
+//---------- extra output if size(#)>0 ----------------------------------------
+  if( size(#)>0 )
+  {
+     if( vdim(homMN0)>0 )
+     {
+        kb = kbase(homMN0);
+        kb = matrix(D)*kb;
+        if( p>2 )
+        {
+          for (l=1;l<=ncols(kb);l=l+1)
+          {
+            "// element",l,"of kbase of Hom in Hom(F0,G0) as matrix: F0-->G0:";
+             print(matrix(ideal(kb[l]),nrows(N),nrows(M)));
+          }
+        }
+        else
+        {
+          dbprint(p-1,"// columns of matrix are kbase of Hom in Hom(F0,G0)",
+                      kb);
+        }
+        L=homMN,homMN0,kb;
+        return(L);
+     }
+     L=homMN,homMN0;
+     return(L);
+  }
+  return(homMN);
+}
+example
+{"EXAMPLE:";  echo = 2;
+  int p     = printlevel;
+  printlevel= 1;   //in 'example proc' printlevel has to be increased by 1
+  ring r    = 0,(x,y),dp;
+  ideal i   = x2-y3,xy;
+  qring q   = std(i);
+  ideal i   = fetch(r,i);
+  module M  = [-x,y],[-y2,x],[x3];
+  module H  = Hom(M,i);
+  print(H);
+
+  printlevel= 2;
+  list L    = Hom(M,i,1);"";
+
+  printlevel=1;
+  ring s    = 3,(x,y,z),(c,dp);
+  ideal i   = jacob(ideal(x2+y5+z4));
+  qring rq=std(i);
+  matrix M[2][2]=xy,x3,5y,4z,x2;
+  matrix N[3][2]=x2,x,y3,3xz,x2z,z;
+  print(M);
+  print(N);
+  list l=Hom(M,N,1);
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc homology (matrix A,matrix B,module M,module N,list #)
+"USAGE:   homology(A,B,M,N);
+COMPUTE: Let M and N be submodules of R^m and R^n presenting M'=R^m/M, N'=R^n/N
+         (R=basering) and let A,B matrices inducing maps
+@example
+    R^k --A--> R^m --B--> R^n.
+@end example
+         Compute a presentation of the module
+@example
+    ker(B)/im(A) := ker(M'/im(A) --B--> N'/im(BM)+im(BA)).
+@end example
+         If B induces a map M'-->N' (i.e BM=0) and if im(A) is contained in
+         ker(B) (that is, BA=0) then ker(B)/im(A) is the homology of the
+         complex
+@example
+    R^k--A-->M'--B-->N'.
+@end example
+RETURN:  module H, a presentation of ker(B)/im(A).
+NOTE:    homology returns a free module of rank m if ker(B)=im(A).
+EXAMPLE: example homology; shows examples
+"
+{
+  module ker,ima;
+  ker = modulo(B,N);
+  ima = A,M;
+  return(modulo(ker,ima));
+}
+example
+{"EXAMPLE";    echo=2;
+  ring r;
+  ideal id=maxideal(4); // GB
+  qring qr=id;
+  module N=maxideal(3)*freemodule(2);
+  module M=maxideal(2)*freemodule(2);
+  module B=[2x,0],[x,y],[z2,y];
+  module A=M;
+  module H=homology(A,B,M,N);
+  H=std(H);
+  // dimension of homology:
+  dim(H);
+  // vector space dimension:
+  vdim(H);
+
+  ring s=0,x,ds;
+  qring qs=std(x4);
+  module A=[x];
+  module B=A;
+  module M=[x3];
+  module N=M;
+  homology(A,B,M,N);
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc hom_kernel (matrix A,module M,module N)
+"USAGE:   hom_kernel(A,M,N);
+COMPUTE: Let M and N be submodules of R^m and R^n, presenting M'=R^m/M,
+         N'=R^n/N (R=basering), and let A:R^m-->R^n be a matrix inducing a
+         map A':M'-->N'. Then ker(A,M,N); computes a presentation K of
+         ker(A') as in the commutative diagram:
+@example
+          ker(A') --->  M' --A'--> N'
+             |^         |^         |^
+             |          |          |
+             R^r  ---> R^m --A--> R^n
+             |^         |^         |^
+             |K         |M         |N
+             |          |          |
+             R^s  ---> R^p -----> R^q
+@end example
+RETURN:  module K, a presentation of ker(A':coker(M)->coker(N)).
+EXAMPLE: example hom_kernel; shows examples.
+"
+{
+  module M1 = modulo(A,N);
+  return(modulo(M1,M));
+}
+example
+{"EXAMPLE";    echo=2;
+  ring r;
+  module N=[2x,x],[0,y];
+  module M=maxideal(1)*freemodule(2);
+  matrix A[2][3]=2x,0,x,y,z2,y;
+  module K=hom_kernel(A,M,N);
+  // dimension of kernel:
+  dim(std(K));
+  // vector space dimension of kernel:
+  vdim(std(K));
+  print(K);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc kohom (matrix M, int j)
+"USAGE:   kohom(A,k); A=matrix, k=integer
+RETURN:  matrix Hom(R^k,A), i.e. let A be a matrix defining a map F1-->F2
+         of free R-modules, then the matrix of Hom(R^k,F1)-->Hom(R^k,F2)
+         is computed (R=basering).
+EXAMPLE: example kohom; shows an example.
+"
+{
+  if (j==1)
+  { return(M);}
+  if (j>1)
+  { return(tensor(M,diag(1,j))); }
+  else { return(0);}
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring r;
+  matrix n[2][3]=x,y,5,z,77,33;
+  print(kohom(n,3));
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc kontrahom (matrix M, int j)
+"USAGE:   kontrahom(A,k); A=matrix, k=integer
+RETURN:  matrix Hom(A,R^k), i.e. let A be a matrix defining a map F1-->F2 of
+         free  R-modules, then the matrix of Hom(F2,R^k)-->Hom(F1,R^k) is
+         computed (R=basering).
+EXAMPLE: example kontrahom; shows an example.
+"
+{
+if (j==1)
+  { return(transpose(M));}
+  if (j>1)
+  { return(transpose(tensor(diag(1,j),M)));}
+  else { return(0);}
+}
+example
+{"EXAMPLE:";  echo=2;
+  ring r;
+  matrix n[2][3]=x,y,5,z,77,33;
+  print(kontrahom(n,3));
+}
+///////////////////////////////////////////////////////////////////////////////
+///////////////////////////////////////////////////////////////////////////////
+
+proc tensorMod(module Phi, module Psi)
+"USAGE:   tensorMod(M,N);  M,N modules
+COMPUTE: presentation matrix A of the tensor product T of the modules
+         M'=coker(M), N'=coker(N): if matrix(M) defines a map M: R^r-->R^s and
+         matrix(N) defines a map N: R^p-->R^q, then A defines a presentation
+@example
+         R^(sp+rq) --A-> R^(sq)  --> T --> 0 .
+@end example
+RETURN:  matrix A satisfying coker(A) = tensorprod(coker(M),coker(N)) .
+EXAMPLE: example tensorMod; shows an example.
+"
+{
+   int s=nrows(Phi);
+   int q=nrows(Psi);
+   matrix A=tensor(unitmat(s),Psi);
+   matrix B=tensor(Phi,unitmat(q));
+   matrix R=concat(A,B);
+   return(R);
+}
+example
+{"EXAMPLE:";  echo=2;
+  ring A=0,(x,y,z),dp;
+  matrix M[3][3]=1,2,3,4,5,6,7,8,9;
+  matrix N[2][2]=x,y,0,z;
+  print(M);
+  print(N);
+  print(tensorMod(M,N));
+}
+///////////////////////////////////////////////////////////////////////////////
+proc Tor(intvec v, module M, module N, list #)
+"USAGE:   Tor(v,M,N[,any]);  v int resp. intvec, M,N modules
+COMPUTE: a presentation of Tor_k(M',N'), for k=v[1],v[2],... , where
+         M'=coker(M) and N'=coker(N): let
+@example
+       0 <-- M' <-- G0 <-M-- G1
+       0 <-- N' <-- F0 <--N- F1 <-- F2 <--...
+@end example
+         be a presentation of M', resp. a free resolution of N', and consider
+         the commutative diagram
+@example
+          0                    0                    0
+          |^                   |^                   |^
+  Tensor(M',Fk+1) -Ak+1-> Tensor(M',Fk) -Ak-> Tensor(M',Fk-1)
+          |^                   |^                   |^
+  Tensor(G0,Fk+1) -Ak+1-> Tensor(G0,Fk) -Ak-> Tensor(G0,Fk-1)
+                               |^                   |^
+                               |C                   |B
+                          Tensor(G1,Fk) ----> Tensor(G1,Fk-1)
+
+       (Ak,Ak+1 induced by N and B,C induced by M).
+@end example
+         Let K=modulo(Ak,B), J=module(C)+module(Ak+1) and Tor=modulo(K,J),
+         then we have exact sequences
+@example
+    R^p  --K-> Tensor(G0,Fk) --Ak-> Tensor(G0,Fk-1)/im(B),
+
+    R^q -Tor-> R^p --K-> Tensor(G0,Fk)/(im(C)+im(Ak+1)).
+@end example
+         Hence, Tor presents Tor_k(M',N').
+RETURN:  - if v is of type int: module Tor, a presentation of Tor_k(M',N');@*
+         - if v is of type intvec: a list of Tor_k(M',N') (k=v[1],v[2],...);@*
+         - in case of a third argument of any type: list l with
+@format
+     l[1] = module Tor/list of Tor_k(M',N'),
+     l[2] = SB of Tor/list of SB of Tor_k(M',N'),
+     l[3] = matrix/list of matrices, each representing a kbase of Tor_k(M',N')
+                (if finite dimensional), or 0.
+@end format
+DISPLAY: printlevel >=0: (affine) dimension of Tor_k for each k  (default).
+@*       printlevel >=1: matrices Ak, Ak+1 and kbase of Tor_k in Tensor(G0,Fk)
+         (if finite dimensional).
+NOTE:    In order to compute Tor_k(M,N) use the command Tor(k,syz(M),syz(N));
+         or: list P=mres(M,2); list Q=mres(N,2); Tor(k,P[2],Q[2]);
+EXAMPLE: example Tor; shows an example
+{
+//---------- initialisation ---------------------------------------------------
+  int k,max,ii,l,row,col,di;
+  module A,B,C,D,N1,N2,M1,ker,imag,Im,Im1,Im2,f,torMN,torMN0;
+  matrix kb;
+  list L1,L2,L3,L,resN,K;
+  ideal  test1;
+  intmat Be;
+  int s = size(v);
+  max = Max(v);                  // maximum integer occurring in intvec v
+  int p = printlevel-voice+3;    // p=printlevel+1 (default: p=1)
+
+//---------- test: coker(M)=basering, coker(M)=0 ? ----------------------------
+  if( max<0 ) { dbprint(p,"// Tor_i=0 for i<0!"); return([1]); }
+  M1 = std(M);
+
+  if( size(M1)==0 or size(N)==0 )  // coker(M)=basering ==> Tor_i=0 for i>0
+  {
+    dbprint(p-1,"// one of the modules M',N' is free, hence Tor_i=0 for i<>0");
+    for( ii=1; ii<=s; ii++ )
+    {
+      k=v[ii];
+      if (k==0) { torMN=module(tensorMod(M1,N)); }
+      else { torMN  = gen(1); }
+      torMN0 = std(torMN);
+      L1[ii] = torMN;
+      L2[ii] = torMN0;
+      L3[ii] = matrix(kbase(torMN0));
+      di=dim(torMN0);
+      dbprint(p,"// dimension of Tor_"+string(k)+":  "+string(di));
+      if (di==0)
+      {
+        dbprint(p,"// vdim of Tor_"+string(k)+":       "
+                  +string(vdim(torMN0)));
+      }
+      dbprint(p,"");
+    }
+
+    if( size(#) )
+    {  if( s>1 ) { L = L1,L2,L3; return(L); }
+       else { L = torMN,torMN0,L3[1]; return(L); }
+    }
+    else
+    {  if( s>1 ) { return(L1); }
+       else { return(torMN); }
+    }
+  }
+
+  if( dim(M1)==-1 )              // coker(M)=0, all Tor's are 0
+  { dbprint(p-1,"2nd module presents 0, hence Tor_k=0, for all k");
+    for( ii=1; ii<=s; ii++ )
+    { k=v[ii];
+      torMN    = gen(1);
+      torMN0   = std(torMN);
+      L1[ii] = torMN;
+      L2[ii] = torMN0;
+      L3[ii] = matrix(kbase(torMN0));
+      di=dim(torMN0);
+      dbprint(p,"// dimension of Tor_"+string(k)+":  "+string(di));
+      if (di==0)
+      {
+        dbprint(p,"// vdim of Tor_"+string(k)+":       "
+                  +string(vdim(torMN0)));
+      }
+      dbprint(p,"");
+    }
+  }
+  else
+  {
+    if( size(M1) < size(M) ) { M=M1;}
+    row = nrows(M);
+//---------- resolution of N -------------------------------------------------
+    resN = mres(N,max+1);
+    for( ii=1; ii<=s; ii++ )
+    { k=v[ii];
+      if( k<0  )                             // Tor_k is 0 for negative k
+      { dbprint(p-1,"// Tor_k=0 for k<0!");
+        torMN  = gen(1);
+        torMN0 = std(torMN);
+        L1[ii] = torMN;
+        L2[ii] = torMN0;
+        L3[ii] = matrix(kbase(torMN0));
+        di=dim(torMN0);
+        dbprint(p,"// dimension of Tor_"+string(k)+":  "+string(di));
+        if (di==0)
+        {
+          dbprint(p,"// vdim of Tor_"+string(k)+":       "
+                    +string(vdim(torMN0)));
+        }
+        dbprint(p,"");
+      }
+      else
+      {
+        N2 = resN[k+1];
+        if( k==0 ) { torMN=module(tensorMod(M,N)); }
+        else
+        {
+          N1 = resN[k];
+          col = ncols(N1);
+
+//---------- computing homology ----------------------------------------------
+          imag = tensor(unitmat(nrows(N1)),M);
+          f = tensor(matrix(N1),unitmat(row));
+          Im1 = tensor(unitmat(col),M);
+          Im2 = tensor(matrix(N2),unitmat(row));
+          ker = modulo(f,imag);
+          Im  = Im2,Im1;
+          torMN = modulo(ker,Im);
+          dbprint(p-1,"// Computing Tor_"+string(k)+
+                      " (help Tor; gives an explanation):",
+          "// Let 0 <- coker(M) <- G0 <-M- G1 be the present. of coker(M),",
+          "// and 0 <- coker(N) <- F0 <-N- F1 <- F2 <- ... a resolution of",
+          "// coker(N), then Tensor(G0,F"+string(k)+")-->Tensor(G0,F"+
+          string(k-1)+") is given by:",f,
+          "// and Tensor(G0,F"+string(k+1)+") + Tensor(G1,F"+string(k)+
+          ")-->Tensor(G0,F"+string(k)+") is given by:",Im,"");
+        }
+
+        torMN0 = std(torMN);
+        di=dim(torMN0);
+        dbprint(p,"// dimension of Tor_"+string(k)+":  "+string(di));
+        if (di==0)
+        {
+          dbprint(p,"// vdim of Tor_"+string(k)+":       "
+                    +string(vdim(torMN0)));
+        }
+        dbprint(p,"");
+
+//---------- more information -------------------------------------------------
+        if( size(#)>0 )
+        { if( vdim(torMN0) >= 0 )
+          { kb = kbase(torMN0);
+            if ( size(ker)!=0) { kb = matrix(ker)*kb; }
+            dbprint(p-1,"// columns of matrix are kbase of Tor_"+
+                     string(k)+" in Tensor(G0,F"+string(k)+")",kb,"");
+            L3[ii] = matrix(kb);
+          }
+          L2[ii] = torMN0;
+        }
+        L1[ii] = torMN;
+      }
+    }
+  }
+  if( size(#) )
+  {  if( s>1 ) { L = L1,L2,L3; return(L); }
+     else { L = torMN,torMN0,matrix(kb); return(L); }
+  }
+  else
+  {  if( s>1 ) { return(L1); }
+     else { return(torMN); }
+  }
+}
+example
+{"EXAMPLE:";   echo=2;
+  int p      = printlevel;
+  printlevel = 1;
+  ring r     = 0,(x,y),dp;
+  ideal i    = x2,y;
+  ideal j    = x;
+  list E     = Tor(0..2,i,j);    // Tor_k(r/i,r/j) for k=0,1,2 over r
+
+  qring R    = std(i);
+  ideal j    = fetch(r,j);
+  module M   = [x,0],[0,x];
+  printlevel = 2;
+  module E1  = Tor(1,M,j);       // Tor_1(R^2/M,R/j) over R=r/i
+
+  list l     = Tor(3,M,M,1);     // Tor_3(R^2/M,R^2/M) over R=r/i
+  printlevel = p;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc fitting(module M, int n)
+"USAGE:   fitting (M,n);  M module, n int
+RETURN:  ideal, (standard basis of) n-th Fitting ideal of M'=coker(M).
+EXAMPLE: example fitting; shows an example
+"
+{
+  n=nrows(M)-n;
+  if(n<=0){return(ideal(1));}
+  if((n>nrows(M))||(n>ncols(M))){return(ideal(0));}
+  return(std(minor(M,n)));
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,x(0..4),dp;
+  matrix M[2][4]=x(0),x(1),x(2),x(3),x(1),x(2),x(3),x(4);
+  print(M);
+  fitting(M,-1);
+  fitting(M,0);
+  fitting(M,1);
+  fitting(M,2);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc isLocallyFree(matrix S, int r)
+"USAGE:   isLocallyFree(M,r);  M module, r int
+RETURN:  1 if M'=coker(M) is locally free of constant rank r;@*
+         0 if this is not the case.
+EXAMPLE: example isLocallyFree; shows an example.
+"
+{
+   ideal F=fitting(S,r);
+   ideal G=fitting(S,r-1);
+   if((deg(F[1])==0)&&(size(G)==0)){return(1);}
+   return(0);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,(x,y,z),dp;
+  matrix M[2][3];     // the presentation matrix
+  M=x-1,y-1,z,y-1,x-2,x;
+  ideal I=fitting(M,0); // 0-th Fitting ideal of coker(M)
+  qring Q=I;
+  matrix M=fetch(R,M);
+  isLocallyFree(M,1); // as R/I-module, coker(M) is locally free of rk 1
+  isLocallyFree(M,0);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc flatteningStrat (module M)
+"USAGE:   flatteningStrat(M);  M module
+RETURN:  list of ideals.
+         The list entries L[1],...,L[r] describe the flattening stratification
+         of M'=coker(M): setting L[0]=0, L[r+1]=1, the flattening
+         stratification is given by the open sets Spec(A/V(L[i-1])) \ V(L[i]),
+         i=1,...,r+1  (A = basering).
+NOTE:    for more information see the book 'A Singular Introduction to
+         Commutative Algebra' (by Greuel/Pfister, Springer 2002).
+EXAMPLE: example flatteningStrat; shows an example
+"
+{
+   list l;
+   int v,w;
+   ideal F;
+   while(1)
+   {
+      F=fitting(M,w); // fitting returns a GB
+      if(F[1]==1){return(l);}
+      if(size(F)!=0){v++;l[v]=F;}
+      w++;
+   }
+   return(l);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring A = 0,x(0..4),dp;
+  // presentation matrix:
+  matrix M[2][4] = x(0),x(1),x(2),x(3),x(1),x(2),x(3),x(4);
+  list L = flatteningStrat(M);
+  L;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc isFlat(module M)
+"USAGE:   isFlat(M);  M module
+RETURN:  1 if M'=coker(M) is flat;@*
+         0 if this is not the case.
+EXAMPLE: example isFlat; shows an example.
+"
+{
+   if (size(ideal(M))==0) {return(1);}
+   int w;
+   ideal F=fitting(M,0);
+   while(size(F)==0)
+   {
+      w++;
+      F=fitting(M,w); // fitting returns a GB
+   }
+   if (deg(F[1])==0) {return(1);}
+   return(0);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring A = 0,(x,y),dp;
+  matrix M[3][3] = x-1,y,x,x,x+1,y,x2,xy+x+1,x2+y;
+  print(M);
+  isFlat(M);             // coker(M) is not flat over A=Q[x,y]
+
+  qring B = std(x2+x-y);   // the ring B=Q[x,y]/<x2+x-y>
+  matrix M = fetch(A,M);
+  isFlat(M);             // coker(M) is flat over B
+
+  setring A;
+  qring C = std(x2+x+y);   // the ring C=Q[x,y]/<x2+x+y>
+  matrix M = fetch(A,M);
+  isFlat(M);             // coker(M) is not flat over C
+}
+///////////////////////////////////////////////////////////////////////////////
+proc flatLocus(module M)
+"USAGE:   flatLocus(M);  M module
+RETURN:  ideal I, s.th. complement of V(I) is flat locus of coker(M).
+NOTE:    computation is based on Fitting ideals;@*
+         output is not radical (in general)
+EXAMPLE: example flatLocus; shows an example
+"
+{
+   if (size(ideal(M))==0) {return(ideal(1));}
+   int v,w;
+   ideal F=fitting(M,0);
+   while(size(F)==0)
+   {
+      w++;
+      F=fitting(M,w);
+   }
+   if(size(ideal(basering))>0)
+   {
+      for(v=w+1;v<=nrows(M);v++)
+      {
+         F=F+intersect(fitting(M,v),quotient(ideal(0),fitting(M,v-1)));
+      }
+   }
+   return(interred(F));
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,(x,y,z),dp;
+  matrix M[2][3]=x,y,z,0,x3,z3;
+  ideal I=flatLocus(M); // coker(M) is flat outside V(x,yz)
+  I;                    // computed ideal not radical
+  ideal J=radical(I);
+  J;
+
+  qring r=std(J);
+  matrix M=fetch(r,M);
+  flatLocus(M);         // coker(M) is flat over Spec(Q[x,y,z]/<x,yz>)
+
+  isFlat(M);            // flatness test
+}
+///////////////////////////////////////////////////////////////////////////////
+proc isReg(ideal I, module N)
+"USAGE:   isReg(I,M);  I ideal, M module
+RETURN:  1 if given (ordered) list of generators for I is coker(M)-sequence;@*
+         0 if this is not the case.
+EXAMPLE: example isReg; shows an example.
+"
+{
+  int n=nrows(N);
+  int i;
+  while(i<ncols(I))
+  {
+     i++;
+     N=std(N);
+     if(size(reduce(quotient(N,I[i]),N,5))!=0){return(0);}
+     N=N+I[i]*freemodule(n);
+  }
+  if (size(reduce(freemodule(n),std(N),5))==0){return(0);}
+  return(1);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R = 0,(x,y,z),dp;
+  ideal I = x*(y-1),y,z*(y-1);
+  isReg(I,0);             // given list of generators is Q[x,y,z]-sequence
+
+  I = x*(y-1),z*(y-1),y;  // change sorting of generators
+  isReg(I,0);
+
+  ring r = 0,(x,y,z),ds;  // local ring
+  ideal I=fetch(R,I);
+  isReg(I,0);             // result independent of sorting of generators
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// the following static procedures are used by KoszulHomology:
+//  * binom_int  (binomial coeff. as integer, or -1 if too large)
+//  * basisNumber
+//  * basisElement
+// for details, see 'A Singular Introduction to Commutative Algebra' (by
+// Greuel/Pfister, Springer 2002), Chapter 7
+
+static proc binom_int(int n, int p)
+{
+  bigint s = binomial(n,p);
+  int a=int(s);
+  if ((s!=0)&&(a==0)) { return(-1); }
+  return(a);
+}
+
+static proc basisNumber(int n,intvec v)
+{
+  int p=size(v);
+  if(p==1){return(v[1]);}
+  int j=n-1;
+  int b;
+  while(j>=n-v[1]+1)
+  {
+    b=b+binom_int(j,p-1);
+    j--;
+  }
+  intvec w=v-v[1];
+  w=w[2..size(w)];
+  b=b+basisNumber(n-v[1],w);
+  return(b);
+}
+
+static proc basisElement(int n,int p,int N)
+{
+  if(p==1){return(N);}
+  int s,R;
+  while(R<N)
+  {
+     s++;
+     R=R+binom_int(n-s,p-1);
+  }
+  R=N-R+binom_int(n-s,p-1);
+  intvec v=basisElement(n-s,p-1,R);
+  intvec w=s,v+s;
+  return(w);
+}
+
+proc KoszulMap(ideal x,int p)
+{
+  return(koszul(p,x)); // compatibility
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc KoszulHomology(ideal x, module M, int p)
+"USAGE:   KoszulHomology(I,M,p);  I ideal, M module, p int
+COMPUTE: A presentation of the p-th Koszul homology module H_p(f_1,...,f_k;M'),
+         where M'=coker(M) and f_1,...,f_k are the given (ordered list
+         of non-zero) generators of the ideal I.
+         The computed presentation is minimized via prune.
+         In particular, if H_p(f_1,...,f_k;M')=0 then the return value is 0.
+RETURN:  module H, s.th. coker(H) = H_p(f_1,...,f_k;M').
+NOTE:    size of input ideal has to be <= 20.
+EXAMPLE: example KoszulHomology; shows an example.
+{
+  x=simplify(x,2);
+  int n     = size(x);
+  if (n==0)
+  {
+    ERROR("// KoszulHomology only for non-zero ideals");
+  }
+  if (n>20)
+  {
+    ERROR("// too many generators in input ideal");
+  }
+  if (p>n)
+  {
+    module hom=0;
+    return(hom);
+  }
+
+  int a     = binom_int(n,p-1);  // n over p-1 independent of char(basering)
+  int b     = binom_int(n,p);
+
+  matrix N  = matrix(M);
+  module ker= freemodule(nrows(N));
+  if(p!=0)
+  {
+    module im= tensor(unitmat(a),N);
+    module f = tensor(koszul(p,x),unitmat(nrows(N)));
+    ker      = modulo(f,im);
+  }
+  module im1 = tensor(unitmat(b),N);
+  module im2 = tensor(koszul(p+1,x),unitmat(nrows(N)));
+  module hom = modulo(ker,im1+im2);
+  hom        = prune(hom);
+  return(hom);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,x(1..3),dp;
+  ideal x=maxideal(1);
+  module M=0;
+  KoszulHomology(x,M,0);  // H_0(x,R), x=(x_1,x_2,x_3)
+
+  KoszulHomology(x,M,1);  // H_1(x,R), x=(x_1,x_2,x_3)
+
+  qring S=std(x(1)*x(2));
+  module M=0;
+  ideal x=maxideal(1);
+  KoszulHomology(x,M,1);
+
+  KoszulHomology(x,M,2);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc depth(module M,ideal #)
+"USAGE:   depth(M,[I]);  M module, I ideal
+RETURN:  int,
+         - if called with 1 argument: the depth of M'=coker(M) w.r.t. the
+         ideal generated by the variables in the basering
+         (the maximal ideal, if the ring is local)@*
+         - if called with 2 arguments: the depth of M'=coker(M) w.r.t. the
+         ideal I.
+NOTE:    Not checked: if I*M'==M', depth is infinity.
+NOTE:    procedure makes use of KoszulHomology.
+EXAMPLE: example depth; shows an example.
+"
+{
+  ideal m=maxideal(1);
+  int i;
+  ideal I;
+
+  if (size(#)==0)
+  {
+    I=m;
+  }
+  else
+  {
+    I=simplify(#,2);
+  }
+
+  //if (size(reduce(M,std(I*M),5))==0) {return (-1); }
+  int n=size(I);
+  while(i<n/*size(I)*/)
+  {
+    i++;
+    if(size(KoszulHomology(I,M,i))==0){return(n/*size(I)*/-i+1);}
+  }
+  return(0);
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,(x,y,z),dp;
+  ideal I=x2,xy,yz;
+  module M=0;
+  depth(M,I);  // depth(<x2,xy,yz>,Q[x,y,z])
+  M=[1];
+  depth(M);  // depth(0)
+  ring r=0,(x,y,z),ds;  // local ring
+  matrix M[2][2]=x,xy,1+yz,0;
+  print(M);
+  depth(M);     // depth(maxideal,coker(M))
+  ideal I=x;
+  depth(M,I);   // depth(<x>,coker(M))
+  I=x+z;
+  depth(M,I);   // depth(<x+z>,coker(M))
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc isCM(module M)
+"USAGE:   isCM(M);  M module
+RETURN:  1 if M'=coker(M) is Cohen-Macaulay;@*
+         0 if this is not the case.
+ASSUME:  basering is local.
+EXAMPLE: example isCM; shows an example
+"
+{
+  // test if basering is local:
+  ideal m=maxideal(1);
+  int i;
+  poly f=1;
+  for (i=1; i<=size(m); i++)
+  {
+    f=f+m[i];
+  }
+  if (ord(f)>0)
+  {
+    print("// basering must be local -- result has no meaning");
+    return(0);
+  }
+
+  return(depth(M)==dim(std(Ann(M))));
+}
+example
+{"EXAMPLE:";   echo=2;
+  ring R=0,(x,y,z),ds;  // local ring R = Q[x,y,z]_<x,y,z>
+  module M=xz,yz,z2;
+  isCM(M);             // test if R/<xz,yz,z2> is Cohen-Macaulay
+
+  M=x2+y2,z7;          // test if R/<x2+y2,z7> is Cohen-Macaulay
+  isCM(M);
+}
+
+proc canonMap(list #)
+"USAGE:  canonMap(id); id= ideal/module,
+RETURN:  a list L, the kernel in two different representations and
+@*       the cokernel of the canonical map
+@*       M ---> Ext^c_R(Ext^c_R(M,R),R) given by presentations
+@*       Here M is the R-module (R=basering) given by the presentation
+@*       defined by id, i.e. M=R/id resp. M=R^n/id
+@*       c is the codimension of M
+@*       L[1] is the preimage of the kernel in R resp. R^n
+@*       L[2] is a presentation of the kernel
+@*       L[3] is a presentation of the cokernel
+EXAMPLE: example canonMap; shows an example
+"
+{
+   module M=#[1];
+   int c=nvars(basering)-dim(std(M));
+   if(c==0)
+   {
+      module K=syz(transpose(M));
+      module Ke=syz(transpose(K));
+      module Co=modulo(syz(transpose(syz(K))),transpose(K));
+    }
+   else
+   {
+      int i;
+      resolution F=mres(M,c+1);
+      module K=syz(transpose(F[c+1]));
+      K=simplify(reduce(K,std(transpose(F[c]))),2);
+      module A=modulo(K,transpose(F[c]));
+      resolution G=nres(A,c+1);
+      for(i=1;i<=c;i++)
+      {
+         K=lift(transpose(F[c-i+1]),matrix(K)*matrix(G[i]));
+      }
+      module Ke=modulo(transpose(K),transpose(G[c]));
+      module Co=modulo(syz(transpose(G[c+1])),transpose(K)+transpose(G[c]));
+   }
+   return(list(Ke,prune(modulo(Ke,M)),prune(Co)));
+
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s=0,(x,y),dp;
+   ideal i = x,y;
+   canonMap(i);
+   ring R = 0,(x,y,z,w),dp;
+   ideal I1 = x,y;
+   ideal I2 = z,w;
+   ideal I = intersect(I1,I2);
+   canonMap(I);
+   module M = syz(I);
+   canonMap(M);
+   ring S = 0,(x,y,z,t),Wp(3,4,5,1);
+   ideal I = x-t3,y-t4,z-t5;
+   ideal J = eliminate(I,t);
+   ring T = 0,(x,y,z),Wp(3,4,5);
+   ideal p = imap(S,J);
+   ideal p2 = p^2;
+   canonMap(p2);
+}
+
+// taken from qhmoduli.lib
+static proc Max(def data)
+"USAGE:   Max(data); intvec/list of integers
+PURPOSE: find the maximal integer contained in 'data'
+RETURN:  list
+ASSUME:  'data' contains only integers and is not empty
+"
+{
+  int i;
+  int max = data[1];
+
+  for(i = size(data); i>1;i--)
+  {
+    if(data[i] > max) { max = data[i]; }
+  }
+  return(max);
+}
+example
+{"EXAMPLE:";  echo = 2;
+  Max(list(1,2,3));
+}