spielwiese
Last change on this file since 7f3ad4 was 7f3ad4, checked in by Hans Schönemann <hannes@…>, 14 years ago
• Property mode set to 100644
File size: 15.8 KB
Line
1version="$Id: nchomolog.lib,v 1.9 2009-01-14 16:07:05 Singular Exp$";
2category="Noncommutative";
3info="
4LIBRARY:  nchomolog.lib   Procedures for Noncommutative Homological Algebra
5AUTHORS:  Viktor Levandovskyy  levandov@math.rwth-aachen.de,
6@*             Gerhard Pfister, pfister@mathematik.uni-kl.de
7
8PROCEDURES:
9 ncExt_R(k,M);            Ext^k(M',R),    M module, R basering, M'=coker(M)
10 ncHom(M,N);              Hom(M',N'),     M,N modules, M'=coker(M), N'=coker(N)
11 coHom(A,k);            Hom(R^k,A),     A matrix over basering R
12 contraHom(A,k);        Hom(A,R^k),     A matrix over basering R
13 dmodoublext(M, l);  computes Ext_D^i(Ext_D^i(M,D),D), where D is a basering
14";
15
16LIB "dmod.lib";
17LIB "gkdim.lib";
18LIB "involut.lib";
19LIB "nctools.lib";
20
21//  ncExt(k,M,N);            Ext^k(M',N'),   M,N modules, M'=coker(M), N'=coker(N)
22//  ncTensorMod(M,N);        Tensor product of modules M'=coker(M), N'=coker(N)
23//  ncTor(k,M,N);            Tor_k(M',N'),   M,N modules, M'=coker(M), N'=coker(N)
24//  tensorMaps(M,N);       tensor product of  matrices
25
26proc contraHom(matrix M, int s)
27{
28   int n,m=ncols(M),nrows(M);
29   int a,b,c;
30   matrix R[s*n][s*m];
31   for(b=1; b<=m; b++)
32   {
33      for(a=1; a<=s; a++)
34      {
35         for(c=1; c<=n; c++)
36         {
37            R[(a-1)*n+c,(a-1)*m+b] = M[b,c];
38         }
39      }
40   }
41   return(R);
42}
43example
44{ "EXAMPLE:"; echo = 2;
45  ring A=0,(x,y,z),dp;
46  matrix M[3][3]=1,2,3,
47               4,5,6,
48               7,8,9;
49  module cM = contraHom(M,2);
50  print(cM);
51}
52
53proc coHom(matrix M, int s)
54{
55   int n,m=ncols(M),nrows(M);
56   int a,b,c;
57   matrix R[s*m][s*n];
58   for(b=1; b<=s; b++)
59   {
60      for(a=1; a<=m; a++)
61      {
62         for(c=1; c<=n; c++)
63         {
64            R[(a-1)*s+b,(c-1)*s+b] = M[a,c];
65         }
66      }
67   }
68   return(R);
69}
70example
71{ "EXAMPLE:"; echo = 2;
72  ring A=0,(x,y,z),dp;
73  matrix M[3][3]=1,2,3,
74                 4,5,6,
75                 7,8,9;
76  module cM = coHom(M,2);
77  print(cM);
78}
79
80proc ncHom(matrix M, matrix N)
81"USAGE:   ncHom(M,N);  M,N modules
82COMPUTE: A presentation of Hom(M',N'), M'=coker(M), N'=coker(N)
83ASSUME: M' is a left module, N' is a centralizing bimodule
84NOTE: ncHom(M,N) is a right module, hence a right presentation matrix
85is returned
86EXAMPLE: example ncHom;  shows examples
87"
88{
89  // assume: M is left module
90  // assume: N is centralizing bimodule
91  // returns a right presentation matrix
92  // for a right module
93  matrix F  = contraHom(M,nrows(N));
94  matrix B  = coHom(N,ncols(M));
95  matrix C  = coHom(N,nrows(M));
96  def Rbase = basering;
97  def Rop   = opposite(Rbase);
98  setring Rop;
99  matrix Bop = oppose(Rbase, B);
100  matrix Cop = oppose(Rbase, C);
101  matrix Fop = oppose(Rbase, F);
102  matrix Dop = modulo(Fop, Bop);
103  matrix Eop = modulo(Dop, Cop);
104  setring Rbase;
105  matrix E   = oppose(Rop, Eop);
106  kill Rop;
107  return(E);
108}
109example
110{ "EXAMPLE:"; echo = 2;
111  ring A=0,(x,y,z),dp;
112  matrix M[3][3]=1,2,3,
113                 4,5,6,
114                 7,8,9;
115  matrix N[2][2]=x,y,
116                 z,0;
117  module H = ncHom(M,N);
118  print(H);
119}
120
121proc ncHom_alt(matrix M, matrix N)
122{
123  // shorter but potentially slower
124  matrix F = contraHom(M,nrows(N)); // \varphi^*
125  matrix B = coHom(N,ncols(M));     // i
126  matrix C = coHom(N,nrows(M));     // j
127  matrix D = rightModulo(F,B);      // D
128  matrix E = rightModulo(D,C);      // Hom(M,N)
129  return(E);
130}
131example
132{ "EXAMPLE:"; echo = 2;
133  ring A=0,(x,y,z),dp;
134  matrix M[3][3]=1,2,3,
135                 4,5,6,
136                 7,8,9;
137  matrix N[2][2]=x,y,
138                 z,0;
139  module H = ncHom_alt(M,N);
140  print(H);
141}
142
143proc ncHom_R(matrix M)
144"USAGE:   ncHom_R(M);  M a module
145COMPUTE: A presentation of Hom_R(M',R), M'=coker(M)
146ASSUME: M' is a left module
147NOTE: ncHom_R(M) is a right module, hence a right presentation matrix is returned
148EXAMPLE: example ncHom_R;  shows examples
149"
150{
151  // assume: M is left module
152  // returns a right presentation matrix
153  // for a right module
154  matrix F  = transpose(M);
155  def Rbase = basering;
156  def Rop   = opposite(Rbase);
157  setring Rop;
158  matrix Fop = oppose(Rbase, F);
159  matrix Dop = modulo(Fop, std(0)); //ker Hom(A^n,A) -> Hom(A^m,A)
160  matrix Eop = modulo(Dop, std(0)); // its presentation
161  setring Rbase;
162  matrix E   = oppose(Rop, Eop);
163  kill Rop;
164  return(E);
165}
166example
167{ "EXAMPLE:"; echo = 2;
168  ring A=0,(x,t,dx,dt),dp;
169  def W = Weyl(); setring W;
170  matrix M[2][2] =
171    dt,  dx,
172    t*dx,x*dt;
173  module H = ncHom_R(M);
174  print(H);
175  matrix N[2][1] = x,dx;
176  H = ncHom_R(N);
177  print(H);
178}
179
180
181proc ncExt(int i, matrix Ps, matrix Ph)
182"USAGE:   Ext(i,M,N);  i int, M,N modules
183COMPUTE: A presentation of Ext^i(M',N');  for M'=coker(M) and N'=coker(N).
184NOTE: ncExt(M,N) is a right module, hence a right presentation matrix
185is returned
186EXAMPLE: example ncExt;  shows examples
187"
188{
189  if(i==0) { return(module(ncHom(Ps,Ph))); }
190  list Phi   = mres(Ps,i+1);
191  module Im  = coHom(Ph,ncols(Phi[i+1]));
192  module f   = contraHom(matrix(Phi[i+1]),nrows(Ph));
193  module Im1 = coHom(Ph,ncols(Phi[i]));
194  module Im2 = contraHom(matrix(Phi[i]),nrows(Ph));
195  def Rbase = basering;
196  def Rop   = opposite(Rbase);
197  setring Rop;
198  module fop    = oppose(Rbase,f);
199  module Imop   = oppose(Rbase,Im);
200  module Im1op  = oppose(Rbase,Im1);
201  module Im2op  = oppose(Rbase,Im2);
202  module ker_op = modulo(fop,Imop);
203  module ext_op = modulo(ker_op,Im1op+Im2op);
204  //  ext        = prune(ext);
205 // to be discussed and done prune_from_the_left
206  setring Rbase;
207  module ext = oppose(Rop,ext_op);
208  kill Rop;
209  return(ext);
210}
211example
212{ "EXAMPLE:"; echo = 2;
213  ring R     = 0,(x,y),dp;
214  ideal I    = x2-y3;
215  qring S    = std(I);
216  module M   = [-x,y],[-y2,x];
217  module E1  = ncExt(1,M,M);
218  E1;
219}
220
221proc ncExt_R(int i, matrix Ps)
222"USAGE:   ncExt_R(i, M);  i int, M module
223COMPUTE:  a presentation of Ext^i(M',R); for M'=coker(M).
224RETURN:   right module Ext, a presentation of Ext^i(M',R)
225EXAMPLE: example ncExt_R; shows an example
226"{
227  if (i==0)
228  {
229    return(ncHom_R(Ps)); // the rest is not needed
230  }
231  list Phi   = nres(Ps,i+1); // left resolution
232  module f   = transpose(matrix(Phi[i+1])); // transp. because of Hom_R
233  module Im2 = transpose(matrix(Phi[i]));
234  def Rbase = basering;
235  def Rop   = opposite(Rbase);
236  setring Rop;
237  module fop    = oppose(Rbase,f);
238  module Im2op  = oppose(Rbase,Im2);
239  module ker_op = modulo(fop,std(0));
240  module ext_op = modulo(ker_op,Im2op);
241  //  ext        = prune(ext);
242  // to be discussed and done prune_from_the_left
243  // necessary: compute SB!
244  // "Computing SB of Ext";
245//   option(redSB);
246//   option(redTail);
247//   ext_op = std(ext_op);
248//   int dimop = GKdim(ext_op);
249//   printf("Ext has dimension %s",dimop);
250//   if (dimop==0)
251//   {
252//       printf("of K-dimension %s",vdim(ext_op));
253//   }
254  setring Rbase;
255  module ext = oppose(Rop,ext_op); // a right module!
256  kill Rop;
257  return(ext);
258}
259example
260{ "EXAMPLE:"; echo = 2;
261  ring R     = 0,(x,y),dp;
262  poly F    = x2-y2;
263  def A = annfs(F);
264  setring A;
265  matrix M[1][size(LD)] = LD;
266  print(ncExt_R(1,M)); // hence the Ext^1 is zero
267  module E  = ncExt_R(2,M); // right module
268  print(E);
269  def Aop = opposite(A);
270  setring Aop;
271  module Eop = oppose(A,E);
272  module T1  = ncExt_R(2,Eop);
273  setring A;
274  module T1 = oppose(Aop,T1);
275  print(T1); // this is a left module Ext^2(Ext^2(M,A),A)
276}
277
278proc nctors(matrix M)
279{
281  def save = basering;
282  matrix MM = M;  // left
283  def sop = opposite(save);
284  setring sop;
285  matrix MM  = oppose(save,MM); // right
286  MM = transpose(MM); // transposed
287  list Phi = nres(MM,2); // i=1
288  module f   = transpose(matrix(Phi[2])); // transp. because of Hom_R
289  module Im2 = transpose(matrix(Phi[1]));
290  setring save;
291  module fop    = oppose(sop,f);
292  module Im2op  = oppose(sop,Im2);
293  module ker_op = modulo(fop,std(0));
294  module ext_op = modulo(ker_op,Im2op);
295  //  matrix E = ncExt_R(1,MM);
296  //  setring save;
297  //  matrix E = oppose(sop,E);
298  return(ext_op);
299}
300
301proc altExt_R(int i, matrix Ps, map Invo)
302  // TODO!!!!!!!!
303  // matrix Ph
304  // work thru Involutions;
305{
306  if(i==0)
307  { // return the formal adjoint
308    matrix Ret   = transpose(Ps);
309    matrix Retop = involution(Ret, Invo);
310    //    "Computing prune of Hom";
311    //    Retop = prune(Retop);
312    //    Retop = std(Retop);
313    return(Retop);
314  }
315  list Phi   = mres(Ps,i+1);
316  //  module Im  = coHom(Ph,ncols(Phi[i+1]));
317  module f   = transpose(matrix(Phi[i+1]));
318  f = involution(f, Invo);
319  //= contraHom(matrix(Phi[i+1]),nrows(Ph));
320  //  module Im1 = coHom(Ph,ncols(Phi[i]));
321  module Im2 = transpose(matrix(Phi[i]));
322  Im2 = involution(Im2, Invo);
323  //contraHom(matrix(Phi[i]),nrows(Ph));
324  module ker_op = modulo(f,std(0));
325  module ext_op = modulo(ker_op,Im2);
326  //  ext        = prune(ext);
327 // to be discussed and done prune_from_the_left
328  // optionally: compute SB!
329  //  "Computing prune of Ext";
330  ext_op = std(ext_op);
331  int dimop = GKdim(ext_op);
332  printf("Ext has dimension %s",dimop);
333  if (dimop==0)
334  {
335      printf("of K-dimension %s",vdim(ext_op));
336  }
337  module ext = involution(ext_op, Invo); // what about transpose?
338  return(ext);
339}
340example
341{ "EXAMPLE:"; echo = 2;
342  ring R     = 0,(x,y),dp;
343  ideal I    = x2-y3;
344  qring S    = std(I);
345  module M   = [-x,y],[-y2,x];
346  module E1  = ncExt(2,M,M);
347  E1;
348}
349
350proc tensorMaps(matrix M, matrix N)
351{
352   int r = ncols(M);
353   int s = nrows(M);
354   int p = ncols(N);
355   int q = nrows(N);
356   int a,b,c,d;
357   matrix R[s*q][r*p];
358   for(b=1;b<=p;b++)
359   {
360      for(d=1;d<=q;d++)
361      {
362         for(a=1;a<=r;a++)
363         {
364            for(c=1;c<=s;c++)
365            {
366               R[(c-1)*q+d,(a-1)*p+b]=M[c,a]*N[d,b];
367            }
368         }
369      }
370   }
371   return(R);
372}
373
374proc ncTensorMod(matrix Phi, matrix Psi)
375{
376   int s=nrows(Phi);
377   int q=nrows(Psi);
378   matrix A=tensorMaps(unitmat(s),Psi);  //I_s tensor Psi
379   matrix B=tensorMaps(Phi,unitmat(q));  //Phi tensor I_q
380   matrix R=concat(A,B);                 //sum of A and B
381   return(R);
382}
383
384
385proc ncTor(int i, matrix Ps, matrix Ph)
386{
387  if(i==0) { return(module(ncTensorMod(Ps,Ph))); }
388                               // the tensor product
389  list Phi   = mres(Ph,i+1);     // a resolution of Ph
390  module Im  = tensorMaps(unitmat(nrows(Phi[i])),Ps);
391  module f   = tensorMaps(matrix(Phi[i]),unitmat(nrows(Ps)));
392  module Im1 = tensorMaps(unitmat(ncols(Phi[i])),Ps);
393  module Im2 = tensorMaps(matrix(Phi[i+1]),unitmat(nrows(Ps)));
394  module ker = modulo(f,Im);
395  module tor = modulo(ker,Im1+Im2);
396  //  tor        = prune(tor);
397  return(tor);
398}
399
400
401static proc Hochschild()
402{
403  ring A    = 0,(x,y),dp;
404  ideal I   = x2-y3;
405  qring B   = std(I);
406  module M  = [-x,y],[-y2,x];
407  ring C    = 0,(x,y,z,w),dp; // x->z, y->w
408  ideal I   = x2-y3,z3-w2;
409  qring Be  = std(I);   //the enveloping algebra
410  matrix AA[1][2]  = x-z,y-w;  //the presentation of the algebra B as Be-module
411  module MM = imap(B,M);
412  module E = ncExt(1,AA,MM);
413  print(E);  //the presentation of the H^1(A,M)
414
415ring A          = 0,(x,y),dp;
416ideal I         = x2-y3;
417qring B         = std(I);
418ring C          = 0,(x,y,z,w),dp;
419ideal I         = x2-y3,z3-w2;
420qring Be        = std(I);   //the enveloping algebra
421matrix AA[1][2] = x-z,y-w;  //the presentation of B as Be-module
422matrix AAA[1][2] = z,w; // equivalent? pres. of B
423print(ncExt(1,AA,AA));  //the presentation of the H^1(A,A)
424print(ncExt(1,AAA,AAA));
425}
426
427static proc Lie()
428{
429// consider U(sl2)* U(sl2)^opp;
430LIB "ncalg.lib";
431ring A = 0,(e,f,h,H,F,E),Dp; // any degree ordering
432int N = 6; // nvars(A);
433matrix @D[N][N];
434@D[1,2] = -h;
435@D[1,3] = 2*e;
436@D[2,3] = -2*f;
437@D[4,5] = 2*F;
438@D[4,6] = -2*E;
439@D[5,6] = H;
440 def AA = nc_algebra(1,@D); setring AA;
441ideal Q = E,F,H;
442poly Z = 4*e*f+h^2-2*h; // center
443poly Zo = 4*F*E+H^2+2*H;  // center opposed
444ideal Qe = Z,Zo;
445//qring B = twostd(Qe);
446//ideal T = e-E,f-F,h-H;
447//ideal T2 = e-H,f-F,h-E;
448//Q = twostd(Q); // U is U(sl2) as left U(sl2)* U(sl2)^opp -- module
449matrix M[1][3] = E,F,H;
450module X0 = ncExt(0,M,M);
451print(X0);
452
453module X1 = ncExt(1,M,M);
454print(X1);
455module X2 = ncExt(2,M,M); // equal to Tor^Z_1(K,K)
456print(X2);
457
458// compute  Tor^Z_1(K,K)
459ring r = 0,(z),dp;
460ideal i = z;
461matrix I[1][1]=z;
462Tor(1,I,I);
463}
464
465
466proc AllExts(module N, list #)
467  // computes and shows everything
468  // assumes we are in the opposite
469  // and N is dual of some M
470  // if # is given, map Invo and Ext_Invo are used
471{
472  int UseInvo = 0;
473  int sl = size(#);
474  if (sl >0)
475  {
476    ideal I = ideal(#[1]);
477    map Invo = basering, I;
478    UseInvo  = 1;
479    "Using the involution";
480  }
481  int nv = nvars(basering);
482  int i,d;
483  module E;
484  list EE;
485  print("--- module:"); print(matrix(N));
486  for (i=1; i<=nv; i++)
487  {
488    if (UseInvo)
489    {
490      E = altExt_R(i,N,Invo);
491    }
492    else
493    {
494      E = ncExt_R(i,N);
495    }
496    printf("--- Ext %s",i);
497    print(matrix(E));
498    EE[i] = E;
499  }
500  return(E);
501}
502
503static proc dmod_exts(module M)
504{
505  // return all Ext_R for a D-module M
506}
507
508proc dmodualtest(module M, int n)
509{
510  // computes the "dual" of the "dual" of a d-mod M
511  // where n is the half-number of vars of Weyl algebra
512  // assumed to be basering
513  // returns the difference between M and Ext^n_D(Ext^n_D(M,D),D)
514  def save = basering;
515  setring save;
516  module Md = ncExt_R(n,M); // right module
517  // would be nice to use "prune"!
518  // NO! prune performs left sided operations!!!
519  //  Md = prune(Md);
520  //  print(Md);
521  def saveop = opposite(save);
522  setring saveop;
523  module Mdop = oppose(save,Md); // left module
524  // here we're eligible to use prune
525  Mdop = prune(Mdop);
526  module Mopd = ncExt_R(n,Mdop); // right module
527  setring save;
528  module M2 = oppose(saveop,Mopd);  // left module
529  M2 = prune(M2); // eligible since M2 is a left mod
530  M2 = groebner(M2);
531  ideal tst = M2 - M;
532  tst = groebner(tst);
533  return(tst);
534}
535example
536{ "EXAMPLE:"; echo = 2;
537  ring R   = 0,(x,y),dp;
538  poly F   = x3-y2;
539  def A    = annfs(F);
540  setring A;
541  dmodualtest(LD,2);
542}
543
544
545proc dmodoublext(module M, list #)
546"USAGE:   dmodoublext(M [,i]);  M module, i optional int
547COMPUTE:  a presentation of Ext^i(Ext^i(M,D),D); for basering D
548RETURN:   left module
549NOTE: by default, i is set to the integer part of the half of number of variables of D
550@* for holonomic modules over Weyl algebra, the double ext is known to be holonomic
551EXAMPLE: example dmodoublext; shows an example
552"
553{
554  // assume: basering is a Weyl algebra?
555  def save = basering;
556  setring save;
557  // if a list is nonempty and contains an integer N, n = N; otherwise n = nvars/2
558  int n;
559  if (size(#) > 0)
560  {
561    //    if (typeof(#) == "int")
562    //    {
563      n = int(#[1]);
564      //    }
565//     else
566//     {
567//       ERROR("the optional argument expected to have type int");
568//     }
569  }
570  else
571  {
572    n = nvars(save); n = n div 2;
573  }
574  // returns Ext^i_D(Ext^i_D(M,D),D), that is
575  // computes the "dual" of the "dual" of a d-mod M (for n = nvars/2)
576  module Md = ncExt_R(n,M); // right module
577  // no prune yet!
578  def saveop = opposite(save);
579  setring saveop;
580  module Mdop = oppose(save,Md); // left module
581  // here we're eligible to use prune
582  Mdop = prune(Mdop);
583  module Mopd = ncExt_R(n,Mdop); // right module
584  setring save;
585  module M2 = oppose(saveop,Mopd);  // left module
586  kill saveop;
587  M2 = prune(M2); // eligible since M2 is a left mod
588  def M3;
589  if (nrows(M2)==1)
590  {
591    M3 = ideal(M2);
592  }
593  else
594  {
595    M3 = M2;
596  }
597  M3 = groebner(M3);
598  return(M3);
599}
600example
601{ "EXAMPLE:"; echo = 2;
602  ring R   = 0,(x,y),dp;
603  poly F   = x3-y2;
604  def A    = annfs(F);
605  setring A;
606  dmodoublext(LD);
607  LD;
608  // fancier example:
609  setring A;
610  ideal I = Dx*(x2-y3),Dy*(x2-y3);
611  I = groebner(I);
612  print(dmodoublext(I,1));
613  print(dmodoublext(I,2));
614}
615
616static proc part_Ext_R(matrix M)
617{
618  // if i==0
619    matrix Ret = transpose(Ps);
620    def Rbase = basering;
621    def Rop   = opposite(Rbase);
622    setring Rop;
623    module Retop = oppose(Rbase,Ret);
624    module Hm = modulo(Retop,std(0)); // right kernel of transposed
625    //    "Computing prune of Hom";
626    //    Retop = prune(Retop);
627    //    Retop = std(Retop);
628    setring Rbase;
629    Ret = oppose(Rop, Hm);
630    kill Rop;
631    return(Ret);
632// some checkz:
633//  setring Rbase;
634  // ker_op is the right Kernel of f^t:
635  //  module ker = oppose(Rop,ker_op);
636  //  print(f*ker);
637//  module ext = oppose(Rop,ext_op);
638}
Note: See TracBrowser for help on using the repository browser.