source: git/Singular/LIB/homolog.lib @ 2b4e70

spielwiese
Last change on this file since 2b4e70 was 2b4e70, checked in by Gert-Martin Greuel <greuel@…>, 23 years ago
* GMG: dbpri durch dbprint ersetzt git-svn-id: file:///usr/local/Singular/svn/trunk@4996 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 32.0 KB
Line 
1//(BM/GMG)
2///////////////////////////////////////////////////////////////////////////////
3version="$Id: homolog.lib,v 1.13 2000-12-30 15:45:35 greuel Exp $";
4category="Commutative Algebra";
5info="
6LIBRARY:  homolog.lib   Procedures for Homological Algebra
7AUTHORS:  Gert-Martin Greuel, email: greuel@mathematik.uni-kl.de,
8          Bernd Martin, email: martin@math.tu-cottbus.de
9
10PROCEDURES:
11 cup(M);                cup: Ext^1(M',M') x Ext^1() --> Ext^2()
12 cupproduct(M,N,P,p,q); cup: Ext^p(M',N') x Ext^q(N',P') --> Ext^p+q(M',P')
13 Ext_R(k,M);            Ext^k(M',R),    M module, R basering, M'=coker(M)
14 Ext(k,M,N);            Ext^k(M',N'),   M,N modules, M'=coker(M), N'=coker(N)
15 Hom(M,N);              Hom(M',N'),     M,N modules, M'=coker(M), N'=coker(N)
16 homology(A,B,M,N)      ker(B)/im(A),   homology of complex R^k--A->M'--B->N'
17 kernel(A,M,N);         ker(M'--A->N')  M,N modules, A matrix
18 kohom(A,k);            Hom(R^k,A),     A matrix over basering R
19 kontrahom(A,k);        Hom(A,R^k),     A matrix over basering R
20";
21
22LIB "general.lib";
23LIB "deform.lib";
24LIB "matrix.lib";
25LIB "poly.lib";
26///////////////////////////////////////////////////////////////////////////////
27
28proc cup (module M,list #)
29"USAGE:   cup(M,[,any,any]);  M=module
30COMPUTE: cup-product Ext^1(M',M') x Ext^1(M',M') ---> Ext^2(M',M'),
31         where M':=R^m/M, if M in R^m, R basering (i.e. M':=coker(matrix(M)))
32         in case of a second argument: symmetrized cup-product
33ASSUME:  all Ext's  are finite dimensional
34RETURN:  matrix of the associated linear map,
35         i.e. the columns of <matrix> present the coordinates of b_i & b_j
36         (resp. (1/2)(b_i & b_j + b_j & b_i) in the symmetric version)
37         with respect to a kbase of Ext^2,
38         (where b_1,b_2,... is a kbase of Ext^1 and & denotes cup product)
39         in case of  a third argument return a list:
40               L[1] = matrix see above (and symmetric case)
41               L[2] = matrix of kbase of Ext^1
42               L[3] = matrix of kbase of Ext^2
43NOTE:    printlevel >=1;  shows what is going on
44         printlevel >=2;  shows result in another representation
45         For computing cupproduct of M itself, apply proc to syz(M)!
46EXAMPLE: example cup; shows examples
47"
48{
49//---------- initialization ---------------------------------------------------
50   int    i,j,k,f0,f1,f2,f3,e1,e2;
51   module M1,M2,A,B,C,ker,ima,ext1,ext2,ext10,ext20;
52   matrix cup[1][0];
53   matrix kb1,lift1,kb2,mA,mB,mC;
54   ideal  tes1,tes2,null;
55   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
56//-----------------------------------------------------------------------------
57//take a resolution of M<--F(0)<--- ...  <---F(3)
58//apply Hom(-,M) and compute the Ext's
59//-----------------------------------------------------------------------------
60   list resM = nres(M,3);
61   M1 = resM[2];
62   M2 = resM[3];
63   f0 = nrows(M);
64   f1 = ncols(M);
65   f2 = ncols(M1);
66   f3 = ncols(M2);
67   tes1 = simplify(ideal(M),10);
68   tes2=simplify(ideal(M1),10);
69   if ((tes1[1]*tes2[1]==0) or (tes1[1]==1) or (tes2[1]==1))
70   {
71      dbprint(p,"// Ext == 0 , hence 'cup' is the zero-map");
72      return(@cup);
73   }
74//------ compute Ext^1 --------------------------------------------------------
75   B     = kohom(M,f2);
76   A     = kontrahom(M1,f0);
77   C     = intersect(A,B);
78   C     = reduce(C,std(null));C = simplify(C,10);
79   ker   = lift(A,C)+syz(A);
80   ima   = kohom(M,f1);
81   ima   = ima + kontrahom(M,f0);
82   ext1  = modulo(ker,ima);
83   ext10 = std(ext1);
84   e1    = vdim(ext10);
85   dbprint(p-1,"// vdim (Ext^1) = "+string(e1));
86   if (e1 < 0)
87   {
88     "// Ext^1 not of finite dimension";
89     return(cup);
90   }
91   kb1 = kbase(ext10);
92   kb1 = matrix(ker)*kb1;
93   dbprint(p-1,"// kbase of Ext^1(M,M)",
94              "//  - the columns present the kbase elements in Hom(F(1),F(0))",
95              "//  - F(*) a free resolution of M",kb1);
96
97//------ compute the liftings of Ext^1 ----------------------------------------
98   mC = matrix(A)*kb1;
99   lift1 =lift(B,mC);
100   dbprint(p-1,"// lift kbase of Ext^1:",
101    "//  - the columns present liftings of kbase elements into Hom(F(2),F(1))",
102    "//  - F(*) a free resolution of M ",lift1);
103
104//------ compute Ext^2  -------------------------------------------------------
105   B    = kohom(M,f3);
106   A    = kontrahom(M2,f0);
107   C    = intersect(A,B);
108   C    = reduce(C,std(null));C = simplify(C,10);
109   ker  = lift(A,C)+syz(A);
110   ima  = kohom(M,f2);
111   ima  = ima + kontrahom(M1,f0);
112   ext2 = modulo(ker,ima);
113   ext20= std(ext2);
114   e2   = vdim(ext20);
115   if (e2<0)
116   {
117     "// Ext^2 not of finite dimension";
118     return(cup);
119   }
120   dbprint(p-1,"// vdim (Ext^2) = "+string(e2));
121   kb2 = kbase(ext20);
122   kb2 = matrix(ker)*kb2;
123   dbprint(p-1,"// kbase of Ext^2(M,M)",
124               "//  - the columns present the kbase elements in Hom(F(2),F(0))",
125               "//  - F(*) is a a free resolution of M ",kb2);
126//-------  compute: cup-products of base-elements -----------------------------
127   for (i=1;i<=e1;i=i+1)
128   {
129     for (j=1;j<=e1;j=j+1)
130     {
131       mA = matrix(ideal(lift1[j]),f1,f2);
132       mB = matrix(ideal(kb1[i]),f0,f1);
133       mC = mB*mA;
134       if (size(#)==0)
135       {                                          //non symmestric
136         mC = matrix(ideal(mC),f0*f2,1);
137         cup= concat(cup,mC);
138       }
139       else                                       //symmetric version
140       {
141         if (j>=i)
142         {
143           if (j>i)
144           {
145             mA = matrix(ideal(lift1[i]),f1,f2);
146             mB = matrix(ideal(kb1[j]),f0,f1);
147             mC = mC+mB*mA;mC=(1/2)*mC;
148           }
149           mC = matrix(ideal(mC),f0*f2,1);
150           cup= concat(cup,mC);
151         }
152       }
153     }
154   }
155   dbprint(p-1,"// matrix of cup-products (in Ext^2)",cup,"////// end level 2 //////");
156//------- comptute: presentation of base-elements -----------------------------
157   cup = lift(ker,cup);
158   cup = lift_kbase(cup,ext20);
159   if( p>2 )
160   {
161     "// the associated matrices of the bilinear mapping 'cup' ";
162     "// corresponding to the kbase elements of Ext^2(M,M) are shown,";
163     "//  i.e. the rows of the final matrix are written as matrix of";
164     "//  a bilinear form on Ext^1 x Ext^1";
165     matrix BL[e1][e1];
166     for (k=1;k<=e2;k=k+1)
167     {
168       "//_____"+string(k)+". component:";
169       for (i=1;i<=e1;i=i+1)
170       {
171         for (j=1;j<=e1;j=j+1)
172         {
173           if (size(#)==0) { BL[i,j]=cup[k,j+e1*(i-1)]; }
174           else
175           {
176             if (i<=j)
177             {
178               BL[i,j]=cup[k,j+e1*(i-1)-binomial(i,2)];
179               BL[j,i]=BL[i,j];
180             }
181           }
182         }
183       }
184       print(BL);
185     }
186     "////// end level 3 //////";
187   }
188   if (size(#)>2) { return(cup,kb1,kb2);}
189   else {return(cup);}
190}
191example
192{"EXAMPLE";  echo=2;
193  int p      = printlevel;
194  ring  rr   = 32003,(x,y,z),(dp,C);
195  ideal  I   = x4+y3+z2;
196  qring  o   = std(I);
197  module M   = [x,y,0,z],[y2,-x3,z,0],[z,0,-y,-x3],[0,z,x,-y2];
198  print(cup(M));
199  print(cup(M,1));
200  // 2nd EXAMPLE  (shows what is going on)
201  printlevel = 3;
202  ring   r   = 0,(x,y),(dp,C);
203  ideal  i   = x2-y3;
204  qring  q   = std(i);
205  module M   = [-x,y],[-y2,x];
206  print(cup(M));
207  printlevel = p;
208}
209///////////////////////////////////////////////////////////////////////////////
210
211proc cupproduct (module M,N,P,int p,q,list #)
212"USAGE:   cupproduct(M,N,P,p,q[,any]);  M,N,P modules, p,q integers
213COMPUTE: cup-product Ext^p(M',N') x Ext^q(N',P') ---> Ext^p+q(M',P')
214         where M':=R^m/M, if M in R^m, R basering (i.e. M':=coker(matrix(M)))
215ASSUME:  all Ext's  are of finite dimension
216RETURN:  matrix of the associated linear map Ext^p(tensor)Ext^q-->Ext^p+q
217         i.e. the columnes of <matrix> present the coordinates of
218         the cup products (b_i & c_j) with respect to a kbase of Ext^p+q
219         (b_i resp. c_j are choosen bases of Ext^p resp. Ext^q)
220         in case of a 6th argument:
221            return a list
222            L[1] = matrix (see above)
223            L[2] = matrix of kbase of Ext^p(M',N')
224            L[3] = matrix of kbase of Ext^q(N',P')
225            L[4] = matrix of kbase of Ext^p+q(N',P')
226NOTE:    printlevel >=1;  shows what is going on
227         printlevel >=2;  shows result in another representation
228         For computing cupproduct of M,N itself, apply proc to syz(M),syz(N)!
229EXAMPLE: example cupproduct; shows examples
230"
231{
232//---------- initialization ---------------------------------------------------
233   int    e1,e2,e3,i,j,k,f0,f1,f2;
234   module M1,M2,N1,N2,P1,P2,A,B,C,ker,ima,extMN,extMN0,extMP,
235          extMP0,extNP,extNP0;
236   matrix cup[1][0];
237   matrix kbMN,kbMP,kbNP,lift1,mA,mB,mC;
238   ideal  test1,test2,null;
239   int pp = printlevel-voice+3;  // pp=printlevel+1 (default: p=1)
240//-----------------------------------------------------------------------------
241//compute resolutions of M and N
242//                     M<--F(0)<--- ...  <---F(p+q+1)
243//                     N<--G(0)<--- ...  <---G(q+1)
244//-----------------------------------------------------------------------------
245   list resM = nres(M,p+q+1);
246   M1 = resM[p];
247   M2 = resM[p+1];
248   list resN = nres(N,q+1);
249   N1 = resN[q];
250   N2 = resN[q+1];
251   P1 = resM[p+q];
252   P2 = resM[p+q+1];
253//-------test: Ext==0?---------------------------------------------------------
254   test1 = simplify(ideal(M1),10);
255   test2 = simplify(ideal(N),10);
256   if (test1[1]==0) { dbprint(pp,"//Ext(M,N)=0");return(cup); }
257   test1 = simplify(ideal(N1),10);
258   test2 = simplify(ideal(P),10);
259   if (test1[1]==0) { dbprint(pp,"//Ext(N,P)=0");return(cup); }
260   test1 = simplify(ideal(P1),10);
261   if (test1[1]==0) { dbprint(pp,"//Ext(M,P)=0");return(cup); }
262 //------ compute kbases of Ext's ---------------------------------------------
263 //------ Ext(M,N)
264   test1 = simplify(ideal(M2),10);
265   if (test1[1]==0) { ker = freemodule(ncols(M1)*nrows(N));}
266   else
267   {
268     A   = kontrahom(M2,nrows(N));
269     B   = kohom(N,ncols(M2));
270     C   = intersect(A,B);
271     C   = reduce(C,std(ideal(0)));C=simplify(C,10);
272     ker = lift(A,C)+syz(A);
273   }
274   ima   = kohom(N,ncols(M1));
275   A     = kontrahom(M1,nrows(N));
276   ima   = ima+A;
277   extMN = modulo(ker,ima);
278   extMN0= std(extMN);
279   e1    = vdim(extMN0);
280   dbprint(pp-1,"// vdim Ext(M,N) = "+string(e1));
281   if (e1 < 0)
282   {
283     "// Ext(M,N) not of finite dimension";
284     return(cup);
285   }
286   kbMN  = kbase(extMN0);
287   kbMN = matrix(ker)*kbMN;
288   dbprint(pp-1,"// kbase of Ext^p(M,N)",
289          "//  - the columns present the kbase elements in Hom(F(p),G(0))",
290          "//  - F(*),G(*) are free resolutions of M and N",kbMN);
291//------- Ext(N,P)
292   test1 = simplify(ideal(N2),10);
293   if (test1[1]==0) {  ker = freemodule(ncols(N1)*nrows(P)); }
294   else
295   {
296     A = kontrahom(N2,nrows(P));
297     B = kohom(P,ncols(N2));
298     C = intersect(A,B);
299     C = reduce(C,std(ideal(0)));C=simplify(C,10);
300     ker = lift(A,C)+syz(A);
301   }
302   ima   = kohom(P,ncols(N1));
303   A     = kontrahom(N1,nrows(P));
304   ima   = ima+A;
305   extNP = modulo(ker,ima);
306   extNP0= std(extNP);
307   e2    = vdim(extNP0);
308   dbprint(pp-1,"// vdim Ext(N,P) = "+string(e2));
309   if (e2 < 0)
310   {
311     "// Ext(N,P) not of finite dimension";
312     return(cup);
313   }
314   kbNP  = kbase(extNP0);
315   kbNP  = matrix(ker)*kbNP;
316   dbprint(pp-1,"// kbase of Ext(N,P):",kbNP,
317          "// kbase of Ext^q(N,P)",
318          "//  - the columns present the kbase elements in Hom(G(q),H(0))",
319          "//  - G(*),H(*) are free resolutions of N and P",kbNP);
320
321//------ Ext(M,P)
322   test1 = simplify(ideal(P2),10);
323   if (test1[1]==0) { ker = freemodule(ncols(P1)*nrows(P)); }
324   else
325   {
326     A = kontrahom(P2,nrows(P));
327     B = kohom(P,ncols(P2));
328     C = intersect(A,B);
329     C = reduce(C,std(ideal(0)));C=simplify(C,10);
330     ker = lift(A,C)+syz(A);
331   }
332   ima   = kohom(P,ncols(P1));
333   A     = kontrahom(P1,nrows(P));
334   ima   = ima+A;
335   extMP = modulo(ker,ima);
336   extMP0= std(extMP);
337   e3    = vdim(extMP0);
338   dbprint(pp-1,"// vdim Ext(M,P) = "+string(e3));
339   if (e3 < 0)
340   {
341     "// Ext(M,P) not of finite dimension";
342     return(cup);
343   }
344   kbMP  = kbase(extMP0);
345   kbMP  = matrix(ker)*kbMP;
346   dbprint(pp-1,"// kbase of Ext^p+q(M,P)",
347          "//  - the columns present the kbase elements in Hom(F(p+q),H(0))",
348          "//  - F(*),H(*) are free resolutions of M and P",kbMP);
349//----- lift kbase of Ext(M,N) ------------------------------------------------
350   lift1 = kbMN;
351   for (i=1;i<=q;i=i+1)
352   {
353     mA = kontrahom(resM[p+i],nrows(resN[i]));
354     mB = kohom(resN[i],ncols(resM[p+i]));
355     lift1 = lift(mB,mA*lift1);
356   }
357   dbprint(pp-1,"// lifting of kbase of Ext^p(M,N)",
358   "//  - the columns present the lifting of kbase elements in Hom(F(p+q),G(q))",lift1);
359//-------  compute: cup-products of base-elements -----------------------------
360   f0 = nrows(P);
361   f1 = ncols(N1);
362   f2 = ncols(resM[p+q]);
363   for (i=1;i<=e1;i=i+1)
364   {
365     for (j=1;j<=e2;j=j+1)
366     {
367       mA = matrix(ideal(lift1[j]),f1,f2);
368       mB = matrix(ideal(kbMP[i]),f0,f1);
369       mC = mB*mA;
370       mC = matrix(ideal(mC),f0*f2,1);
371       cup= concat(cup,mC);
372     }
373   }
374   dbprint(pp-1,"// matrix of cup-products (in Ext^p+q)",cup,"////// end level 2 //////");
375//------- comptute: presentation of base-elements -----------------------------
376   cup = lift(ker,cup);
377   cup = lift_kbase(cup,extMP0);
378//------- special output ------------------------------------------------------
379   if (pp>2)
380   {
381     "// the associated matrices of the bilinear mapping 'cup' ";
382     "// corresponding to the kbase elements of Ext^p+q(M,P) are shown,";
383     "//  i.e. the rows of the final matrix are written as matrix of";
384     "//  a bilinear form on Ext^p x Ext^q";
385     matrix BL[e1][e2];
386     for (k=1;k<=e3;k=k+1)
387     {
388       "//----"+string(k)+". component:";
389       for (i=1;i<=e1;i=i+1)
390       {
391         for (j=1;j<=e2;j=j+1)
392         {
393           BL[i,j]=cup[k,j+e1*(i-1)];
394         }
395        }
396        print(BL);
397      }
398     "////// end level 3 //////";
399   }
400   if (size(#)) { return(cup,kbMN,kbNP,kbMP);}
401   else         { return(cup); }
402}
403example
404{"EXAMPLE";  echo=2;
405  int p      = printlevel;
406  ring  rr   = 32003,(x,y,z),(dp,C);
407  ideal  I   = x4+y3+z2;
408  qring  o   = std(I);
409  module M   = [x,y,0,z],[y2,-x3,z,0],[z,0,-y,-x3],[0,z,x,-y2];
410  print(cupproduct(M,M,M,1,3));
411  printlevel = 3;
412  list l     = (cupproduct(M,M,M,1,3,"any"));
413  show(l[1]);show(l[2]);
414  printlevel = p;
415}
416///////////////////////////////////////////////////////////////////////////////
417
418proc Ext_R (intvec v, module M, list #)
419"USAGE:   Ext_R(v,M[,p]);  v=int/intvec , M=module, p=int
420COMPUTE: A presentation of Ext^k(M',R); for k=v[1],v[2],..., M'=coker(M).
421         Let ...--> F2 --> F1 --M-> F0-->M'-->0 be a free resolution of M'. If
422         0 <-- F0* <-A1-- F1* <-A2-- F2* <-A3--... denotes the dual sequence,
423         Fi*=Hom(Fi,R), then Ext^k = ker(Ak)/im(Ak+1) is presented as in the
424         following exact sequences:
425                 Fk-1* <-Ak-- Fk* <-syz(Ak)-- R^p
426                 Fk*/im(Ak+1) <-syz(Ak)-- R^p <-Ext^k-- R^q
427         Hence Ext^k=modulo(syz(Ak),Ak+1) presents Ext^k(M',R);
428RETURN:  Ext^k, of type module, a presentation of Ext^k(M',R) if v is of type
429         int, resp. a list of Ext^k (k=v[1],v[2],...) if v is of type intvec.
430         In case of a third argument of type int return a list:
431           [1] = module Ext^k/list of Ext^k
432           [2] = SB of Ext^k/list of SB of Ext^k
433           [3] = matrix/list of matrices, each representing kbase of Ext^k
434                 (if finite dimensional)
435DISPLAY: printlevel >=0: degree of Ext^k for each k  (default)
436         printlevel >=1: Ak, Ak+1 and kbase of Ext^k in Fk*
437NOTE:    In order to compute Ext^k(M,R) use the command Ext_R(k,syz(M));
438         or the 2 commands: list L=mres(M,2);  Ext_R(k,L[2]);
439EXAMPLE: example Ext_R; shows examples
440"
441{
442
443// In case M is known to be a SB, set attrib(M,"isSB",1); in order to
444// avoid  unnecessary SB computations
445
446//------------ initialisation -------------------------------------------------
447  module m1,m2,ret,ret0;
448  matrix ker,kb;
449  list L1,L2,L3,L,resl,K;
450  int k,max,ii,t1,t2;
451  int s = size(v);
452  intvec v1 = sort(v)[1];
453  max = v1[s];                 // the maximum integer occuring in intvec v
454  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
455  // --------------- Variante mit sres
456  for( ii=1; ii<=size(#); ii++ )
457  {
458    t2=1; // return a list if t2=1
459    if( typeof(#[ii])=="string" )
460    {
461      if ( #[ii]=="sres" ) { t1=1; t2=0; } // use sres instead of mres if t1=1
462    }
463  }
464//----------------- compute resolution of coker(M) ----------------------------
465  if( max<0 ) { dbprint(p,"// Ext^i=0 for i<0!"); return([1]); }
466  if( t1==1 )
467  {
468    if( attrib(M,"isSB")==0 ) { M=std(M); }
469    resl = sres(M,max+1);
470  }
471  else { resl = mres(M,max+1); }
472  for( ii=1; ii<=s; ii++ )
473  {
474//-----------------  apply Hom(_,R) at k-th place -----------------------------
475    k=v[ii];
476    if( k<0 )                   // Ext^k=0 for negative k
477    {
478      dbprint(p-1,"// Ext^i=0 for i<0!");
479      ret    = gen(1);
480      ret0   = std(ret);
481      L1[ii] = ret;
482      L2[ii] = ret0;
483      L3[ii] = matrix(kbase(ret0));
484      dbprint(p,"// degree of Ext^"+string(k)+":");
485      if( p>=0 ) { degree(ret0);"";}
486    }
487    else
488    {
489      m2 = transpose(resl[k+1]);
490      if( k==0 ) { m1=0*gen(nrows(m2)); }
491      else { m1 = transpose(resl[k]); }
492//----------------- presentation of ker(m2)/im(m1) ----------------------------
493      ker = syz(m2);
494      ret = modulo(ker,m1);
495      dbprint(p-1,"// Computing Ext^"+string(k)+":",
496         "// Let 0<--coker(M)<--F0<--F1<--F2<--... be a resolution of M,",
497         "// then F"+string(k)+"*-->F"+string(k+1)+"* is given by:",m2,
498         "// and F"+string(k-1)+"*-->F"+string(k)+"* is given by:",m1,"");
499      ret0 = std(ret);
500      dbprint(p,"// degree of Ext^"+string(k)+":");
501      if( p>0 ) { degree(ret0);"";}
502      if( t2 )
503      {
504         if( vdim(ret0)>=0 )
505         {
506            kb = kbase(ret0);
507            if ( size(ker)!=0 ) { kb = matrix(ker)*kb; }
508            dbprint(p-1,
509            "// columns of matrix are kbase of Ext^"+string(k)+" in F"+string(k)+"*:",kb,"");
510            L3[ii] = kb;
511         }
512         L2[ii] = ret0;
513      }
514      L1[ii] = ret;
515    }
516  }
517  if( t2 )
518  {
519     if( s>1 ) { L = L1,L2,L3; return(L); }
520     else { L = ret,ret0,kb; return(L); }
521  }
522  else
523  {
524     if( s>1 ) { return(L1); }
525     else { return(ret); }
526  }
527}
528example
529{"EXAMPLE:";     echo=2;
530  int p      = printlevel;
531  printlevel = 1;
532  ring r     = 0,(x,y,z),dp;
533  ideal i    = x2y,y2z,z3x;
534  module E   = Ext_R(1,i);       //computes Ext^1(r/i,r)
535  is_zero(E);
536  module m   = [x],[0,y];
537  list L     = Ext_R(2..3,m);    //computes Ext^i(r^2/m,r), i=2,3
538  show(L);"";
539  qring R    = std(x2+yz);
540  intvec v   = 0,2,4;
541  printlevel = 2;                //shows what is going on
542  ideal i    = x,y,z;            //computes Ext^i(r/(x,y,z),r/(x2+yz)), i=0,2,4
543  list L     = Ext_R(v,i,1);     //over the qring R=r/(x2+yz), std and kbase
544  printlevel = p;
545}
546///////////////////////////////////////////////////////////////////////////////
547
548proc Ext (intvec v, module M, module N, list #)
549"USAGE:   Ext(v,M,N[,any]);  v=int/intvec, M,N=modules
550COMPUTE: A presentation of Ext^k(M',N'); for k=v[1],v[2],... where
551         M'=coker(M) and N'=coker(N). Let
552         0<--M'<-- F0 <-M-- F1 <-- F2 <--...  resp. 0<--N'<-- G0 <--N- G1 be
553         a free resolution of M' resp. a presentations of N'. Consider
554@format
555                      0                  0                  0
556                      |^                 |^                 |^
557               --> Hom(Fk-1,N') -Ak-> Hom(Fk,N') -Ak+1-> Hom(Fk+1,N')
558                      |^                 |^                 |^
559               --> Hom(Fk-1,G0) -Ak-> Hom(Fk,G0) -Ak+1-> Hom(Fk+1,G0)
560                                         |^                 |^
561                                         |C                 |B
562                                      Hom(Fk,G1) -----> Hom(Fk+1,G1)
563@end format
564         (Ak,Ak+1 induced by M and B,C induced by N).
565         Let K=modulo(Ak+1,B), J=module(Ak)+module(C) and Ext=modulo(K,J),
566         then we have exact sequences
567                  R^p  --K-> Hom(Fk,G0) --Ak+1-> Hom(Fk+1,G0)/im(B)
568         R^q -Ext-> R^p --K->Hom(Fk,G0)/im(Ak)+im(C) --Ak+1->Hom(Fk+1,G0)/im(B)
569         Hence Ext presents Ext^k(M',N')
570RETURN: 
571         Ext, of type module, a presentation of Ext^k(M',N') if v is of type
572         int, resp. a list of Ext^k (k=v[1],v[2],...) if v is of type intvec.
573         In case of a third argument of any type return a list:
574           [1] = module Ext/list of Ext^k
575           [2] = SB of Ext/list of SB of Ext^k
576           [3] = matrix/list of matrices, each representing a kbase of Ext^k
577                 (if finite dimensional)
578DISPLAY: printlevel >=0: degree of Ext^k for each k  (default)
579         printlevel >=1: matrices Ak, Ak+1 and kbase of Ext^k in Hom(Fk,G0)
580                            (if finite dimensional)
581NOTE:    In order to compute Ext^k(M,N) use the command Ext(k,syz(M),syz(N));
582         or: list P=mres(M,2); list Q=mres(N,2); Ext(k,P[2],Q[2]);
583EXAMPLE: example Ext;   shows examples
584"
585{
586//---------- initialisation ---------------------------------------------------
587  int k,max,ii,l,row,col;
588  module A,B,C,D,M1,M2,N1,ker,imag,extMN,extMN0;
589  matrix kb;
590  list L1,L2,L3,L,resM,K;
591  ideal  test1;
592  intmat Be;
593  int s = size(v);
594  intvec v1 = sort(v)[1];
595  max = v1[s];                      // the maximum integer occuring in intvec v
596  int p = printlevel-voice+3;       // p=printlevel+1 (default: p=1)
597//---------- test: coker(N)=basering, coker(N)=0 ? ----------------------------
598  if( max<0 ) { dbprint(p,"// Ext^i=0 for i<0!"); return([1]); }
599  N1 = std(N);
600  if( size(N1)==0 )      //coker(N)=basering, in this case proc Ext_R is faster
601  { printlevel=printlevel+1;
602    if( size(#)==0 )
603    { def E = Ext_R(v,M);
604      printlevel=printlevel-1;
605      return(E);
606    }
607    else
608    { def E = Ext_R(v,M,#[1]);
609       printlevel=printlevel-1;
610       return(E);
611     }
612  }
613  if( dim(N1)==-1 )                          //coker(N)=0, all Ext-groups are 0
614  { dbprint(p-1,"2nd module presents 0, hence Ext^k=0, for all k");
615    for( ii=1; ii<=s; ii++ )
616    { k=v[ii];
617      extMN    = gen(1);
618      extMN0   = std(extMN);
619      L1[ii] = extMN;
620      L2[ii] = extMN0;
621      L3[ii] = matrix(kbase(extMN0));
622      if( p>0 ) { "// degree of Ext^"+string(k)+":"; degree(extMN0);""; }
623    }
624  }
625  else
626  {
627    if( size(N1) < size(N) ) { N=N1;}
628    row = nrows(N);
629//---------- resolution of M -------------------------------------------------
630    resM = mres(M,max+1);
631    for( ii=1; ii<=s; ii++ )
632    { k=v[ii];
633      if( k<0  )                                   // Ext^k is 0 for negative k
634      { dbprint(p-1,"// Ext^k=0 for k<0!");
635        extMN    = gen(1);
636        extMN0   = std(extMN);
637        L1[ii] = extMN;
638        L2[ii] = extMN0;
639        L3[ii] = matrix(kbase(extMN0));
640        if( p>0 ) { "// degree of Ext^"+string(k)+":"; degree(extMN0);""; }
641      }
642      else
643      { M2 = resM[k+1];
644        if( k==0 ) { M1=0*gen(nrows(M2)); }
645        else { M1 = resM[k]; }
646        col = ncols(M1);
647        D = kohom(N,col);
648//---------- computing homology ----------------------------------------------
649        imag  = kontrahom(M1,row);
650        A     = kontrahom(M2,row);
651        B     = kohom(N,ncols(M2));
652        ker   = modulo(A,B);
653        imag  = imag,D;
654        extMN = modulo(ker,imag);
655        dbprint(p-1,"// Computing Ext^"+string(k)+" (help Ext; gives an explanation):",
656    "// Let 0<--coker(M)<--F0<--F1<--F2<--... be a resolution of coker(M),",
657    "// and 0<--coker(N)<--G0<--G1 a presentation of coker(N),",
658    "// then Hom(F"+string(k)+",G0)-->Hom(F"+string(k+1)+",G0) is given by:",A,
659    "// and Hom(F"+string(k-1)+",G0) + Hom(F"+string(k)+",G1)-->Hom(F"+string(k)+",G0) is given by:",imag,"");
660        extMN0 = std(extMN);
661        if( p>0 ) { "// degree of Ext^"+string(k)+":"; degree(extMN0);""; }
662//---------- more information -------------------------------------------------
663        if( size(#)>0 )
664        { if( vdim(extMN0) >= 0 )
665          { kb = kbase(extMN0);
666            if ( size(ker)!=0) { kb = matrix(ker)*kb; }
667            dbprint(p-1,"// columns of matrix are kbase of Ext^"+
668                     string(k)+" in Hom(F"+string(k)+",G0)",kb,"");
669            if( p>0 )
670            { for (l=1;l<=ncols(kb);l=l+1)
671              {
672                "// element",l,"of kbase of Ext^"+string(k)+" in Hom(F"+string(k)+",G0)";
673                "// as matrix: F"+string(k)+"-->G0";
674                print(matrix(ideal(kb[l]),row,col));
675              }
676              "";
677            }
678            L3[ii] = matrix(kb);
679          }
680          L2[ii] = extMN0;
681        }
682        L1[ii] = extMN;
683      }
684    }
685  }
686  if( size(#) )
687  {  if( s>1 ) { L = L1,L2,L3; return(L); }
688     else { L = extMN,extMN0,matrix(kb); return(L); }
689  }
690  else
691  {  if( s>1 ) { return(L1); }
692     else { return(extMN); }
693  }
694}
695example
696{"EXAMPLE:";   echo=2;
697  int p      = printlevel;
698  printlevel = 1;
699  ring r     = 0,(x,y),dp;
700  ideal i    = x2-y3;
701  ideal j    = x2-y5;
702  list E     = Ext(0..2,i,j);    // Ext^k(r/i,r/j) for k=0,1,2 over r
703  qring R    = std(i);
704  ideal j    = fetch(r,j);
705  module M   = [-x,y],[-y2,x];
706  printlevel = 2;
707  module E1  = Ext(1,M,j);       // Ext^1(R^2/M,R/j) over R=r/i
708  list l     = Ext(4,M,M,1);     // Ext^4(R^2/M,R^2/M) over R=r/i
709  printlevel = p;
710}
711///////////////////////////////////////////////////////////////////////////////
712
713proc Hom (module M, module N, list #)
714"USAGE:   Hom(M,N,[any]);  M,N=modules
715COMPUTE: A presentation of Hom(M',N'), M'=coker(M), N'=coker(N) as follows:
716         Let ...-->F1 --M-> F0-->M'-->0 and ...-->G1 --N-> G0-->N'-->0  be
717         presentations of M' and N'. Consider
718@format
719                                         0               0
720                                         |^              |^
721              0 --> Hom(M',N') ----> Hom(F0,N') ----> Hom(F1,N')
722                                         |^              |^
723         (A:  induced by M)          Hom(F0,G0) --A-> Hom(F1,G0)
724                                         |^              |^
725         (B,C:induced by N)              |C              |B
726                                     Hom(F0,G1) ----> Hom(F1,G1)
727
728         Let D=modulo(A,B) and Hom=modulo(D,C), then we have exact sequences
729              R^p  --D-> Hom(F0,G0) --A-> Hom(F1,G0)/im(B)
730              R^q -Hom-> R^p --D-> Hom(F0,G0)/im(C) --A-> Hom(F1,G0)/im(B).
731         Hence Hom presents Hom(M',N')
732@end format
733RETURN:  Hom, of type module, presentation of Hom(M',N') or,
734         in case of 3 arguments, a list:
735           [1] = Hom
736           [2] = SB of Hom
737           [3] = kbase of coker(Hom) (if finite dimensional), represented by
738                 elements in Hom(F0,G0) via mapping D
739DISPLAY: printlevel >=0: degree of Hom  (default)
740         printlevel >=1: D and C and kbase of coker(Hom) in Hom(F0,G0)
741         printlevel >=2: elements of kbase of coker(Hom) as matrix :F0-->G0
742NOTE:    DISPLAY is as described only for a direct call of 'Hom'. Calling 'Hom'
743         from another proc has the same effect as decreasing printlevel by 1.
744EXAMPLE: example Hom;  shows examples
745"
746{
747//---------- initialisation ---------------------------------------------------
748  int l,p;
749  matrix kb;
750  module A,B,C,D,homMN,homMN0;
751  list L;
752//---------- computation of Hom -----------------------------------------------
753  B = kohom(N,ncols(M));
754  A = kontrahom(M,nrows(N));
755  C = kohom(N,nrows(M));
756  D = modulo(A,B);
757  homMN = modulo(D,C);
758  homMN0= std(homMN);
759  p = printlevel-voice+3;       // p=printlevel+1 (default: p=1)
760  if( p>=0 ) { "// degree of Hom:"; degree(homMN0); ""; }
761  dbprint(p-1,"// given ...--> F1 --M-> F0 -->M'--> 0 and ...--> G1 --N-> G0 -->N'--> 0,",
762         "// show D=ker(Hom(F0,G0) --> Hom(F1,G0)/im(Hom(F1,G1) --> Hom(F1,G0)))",D,
763         "// show C=im(Hom(F0,G1) --> Hom(F0,G0))",C,"");
764//---------- extra output if size(#)>0 ----------------------------------------
765  if( size(#)>0 )
766  {  if( vdim(homMN0)>0 )
767     {  kb = kbase(homMN0);
768        kb = matrix(D)*kb;
769        if( p>2 )
770        {  for (l=1;l<=ncols(kb);l=l+1)
771           {
772            "// element",l,"of kbase of Hom in Hom(F0,G0) as matrix: F0-->G0:";
773             print(matrix(ideal(kb[l]),nrows(N),nrows(M)));
774           }
775        }
776        else
777       {dbprint(p-1,"// columns of matrix are kbase of Hom in Hom(F0,G0)",kb);}
778        L=homMN,homMN0,kb; return(L);
779     }
780     L=homMN,homMN0; return(L);
781  }
782  return(homMN);
783}
784example
785{"EXAMPLE:";  echo = 2;
786  int p     = printlevel;
787  printlevel= 1;   //in 'example proc' printlevel has to be increased by 1
788  ring r    = 0,(x,y),dp;
789  ideal i   = x2-y3,xy;
790  qring q   = std(i);
791  ideal i   = fetch(r,i);
792  module M  = [-x,y],[-y2,x],[x3];
793  module H  = Hom(M,i);
794  print(H);
795  printlevel= 2;
796  list L    = Hom(M,i,1);"";
797  ring s    = 3,(x,y,z),(c,dp);
798  ideal i   = jacob(ideal(x2+y5+z4));
799  qring rq=std(i);
800  matrix M[2][2]=xy,x3,5y,4z,x2;
801  matrix N[3][2]=x2,x,y3,3xz,x2z,z;
802  print(M);
803  print(N);
804  list l=Hom(M,N,1);
805  printlevel = p;
806}
807///////////////////////////////////////////////////////////////////////////////
808
809proc homology (matrix A,matrix B,module M,module N,list #)
810"USAGE:   homology(A,B,M,N);
811COMPUTE: Let M and N be submodules of R^m and R^n presenting M'=R^m/M, N'=R^n/N
812         (R=basering) and let A,B matrices inducing maps R^k--A-->R^m--B-->R^n.
813         Compute a presentation R^q --H-> R^m of the module
814              ker(B)/im(A) := ker(M'/im(A) --B--> N'/im(BM)+im(BA)).
815         If B induces a map M'--B-->N' (i.e BM=0) and if R^k--A-->M'--B-->N' is
816         a complex (i.e. BA=0) then ker(B)/im(A) is the homology of the complex
817RETURN:  module H, a presentation of ker(B)/im(A)
818NOTE:    homology returns a free module of rank m if ker(B)=im(A)
819EXAMPLE: example homology; shows examples
820"
821{
822  module ker,ima;
823  ker = modulo(B,N);
824  ima = A,M;
825  return(modulo(ker,ima));
826}
827example
828{"EXAMPLE";    echo=2;
829  ring r;
830  ideal id=maxideal(4);
831  qring qr=std(id);
832  module N=maxideal(3)*freemodule(2);
833  module M=maxideal(2)*freemodule(2);
834  module B=[2x,0],[x,y],[z2,y];
835  module A=M;
836  degree(std(homology(A,B,M,N)));"";
837  ring s=0,x,ds;
838  qring qs=std(x4);
839  module A=[x];module B=A;
840  module M=[x3];module N=M;
841  homology(A,B,M,N);
842}
843//////////////////////////////////////////////////////////////////////////////
844
845proc kernel (matrix A,module M,module N)
846"USAGE:   kernel(A,M,N);
847COMPUTE: Let M and N be submodules of R^m and R^n presenting M'=R^m/M, N'=R^n/N
848         (R=basering) and let A:R^m-->R^n a matrix inducing a map A':M'-->N'.
849         Compute a presentation K of ker(A') as in the commutative diagram:
850@format
851                       ker(A') --->  M' --A'--> N'
852                           |^        |^         |^
853                           |         |          |
854                          R^r  ---> R^m --A--> R^n
855                           |^        |^         |^
856                           |K        |M         |N
857                           |         |          |
858                          R^s  ---> R^p -----> R^q
859@end format
860RETURN:  module K, a presentation of ker(A')
861EXAMPLE: example kernel; shows examples
862"
863{
864  module M1 = modulo(A,N);
865  return(modulo(M1,M));
866}
867example
868{"EXAMPLE";    echo=2;
869  ring r;
870  module N=[2x,x],[0,y];
871  module M=maxideal(1)*freemodule(2);
872  matrix A[2][2]=2x,0,x,y,z2,y;
873  module K=kernel(A,M,N);
874  degree(std(K));
875  print(K);
876}
877///////////////////////////////////////////////////////////////////////////////
878
879proc kohom (matrix M, int j)
880"USAGE:   kohom(A,k); A=matrix, k=integer
881RETURN:  matrix Hom(R^k,A) i.e. let A be a matrix defining a map: F1 --> F2 of
882         free R-modules, the matrix of Hom(R^k,F1)-->Hom(R^k,F2) is computed
883EXAMPLE: example kohom; shows an example
884"
885{
886  if (j==1)
887  { return(M);}
888  if (j>1)
889  { return(outer(M,diag(1,j))); }
890  else { return(0);}
891}
892example
893{"EXAMPLE:";   echo=2;
894  ring r;
895  matrix n[2][3]=x,y,5,z,77,33;
896  print(kohom(n,3));
897}
898///////////////////////////////////////////////////////////////////////////////
899
900proc kontrahom (matrix M, int j)
901"USAGE:   kontrahom(A,k); A=matrix, k=integer
902RETURN:  matrix Hom(A,R^k), i.e. let A be a matrix defining a map: F1 --> F2 of
903         free  R-modules, the matrix of Hom(F2,R^k)-->Hom(F1,R^k) is computed
904EXAMPLE: example kontrahom; shows an example
905"
906{
907if (j==1)
908  { return(transpose(M));}
909  if (j>1)
910  { return(transpose(outer(diag(1,j),M)));}
911  else { return(0);}
912}
913example
914{"EXAMPLE:";  echo=2;
915  ring r;
916  matrix n[2][3]=x,y,5,z,77,33;
917  print(kontrahom(n,3));
918}
919///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.