source: git/Singular/LIB/homolog.lib @ 3939bc

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