source: git/Singular/LIB/ncalg.lib @ 108084

spielwiese
Last change on this file since 108084 was 108084, checked in by Viktor Levandovskyy <levandov@…>, 19 years ago
*levandov: some cosmetic changes git-svn-id: file:///usr/local/Singular/svn/trunk@8503 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 16.1 KB
Line 
1///////////////////////////////////////////////////////////////////////////////
2version="$Id: ncalg.lib,v 1.15 2005-08-12 16:47:08 levandov Exp $";
3category="Noncommutative";
4info="
5LIBRARY:  ncalg.lib      Definitions of important GR-algebras
6AUTHORS:  Viktor Levandovskyy,     levandov@mathematik.uni-kl.de,
7@*          Oleksandr Motsak,        motsak@mathematik.uni-kl.de.
8
9CONVENTIONS: This library provides pre-defined important noncommutative algebras.
10@* For universal enveloping algebras of finite dimensional Lie algebras sl_n, gl_n and g_2 there are functions @code{makeUsl}, @code{makeUgl} and @code{makeUg2}.
11@* There are quantized enveloping algebras U_q(sl_2) and U_q(sl_3) (via functions @code{makeQsl2}, @code{makeQsl3})
12@* and non-standard quantum deformation of so_3, accessible via @code{makeQso3} function.
13
14PROCEDURES:
15makeUsl(n[,p]);   create U(sl_n) in char p>=0
16makeUsl2([p]);    create U(sl_2) in the variables (e,f,h) in char p>=0
17makeUg2([p]);     create U(g_2) in the variables (x(i),y(i),Ha,Hb) in char p>=0
18makeUgl(n,[p]);   create U(gl_n) in the variables (e_ij (1<i,j<n)) in char p>=0
19makeQso3([n]);    create U_q(so_3) in the presentation of Klimyk (if int n is given, the quantum parameter will be specialized at the 2n-th root of unity)
20Qso3Casimir(n [,m]); returns a list with the (optionally normalized) Casimir elements of U_q(so_3) for the quantum parameter specialized at the 2n-th root of unity
21makeQsl2([n]);    preparation for U_q(sl_2) as factor-algebra; if n is specified, the quantum parameter q will be specialized at the n-th root of unity
22makeQsl3([n]);    preparation for U_q(sl_3) as factor-algebra; if n is specified, the quantum parameter q will be specialized at the n-th root of unity
23GKZsystem(A, sord, alg [,v]);  define a ring and a Gelfand-Kapranov-Zelevinsky system of differential equations
24";
25
26LIB "nctools.lib"; // rootofUnity,
27LIB "general.lib";
28LIB "toric.lib"; // needed for GKZsystem
29
30///////////////////////////////////////////////////////////////////////////////
31static proc defInt ( list # )
32// return 0 or int(#)
33{
34  int @p = 0;
35  if ( size(#) > 0 )
36  {
37    if ( typeof( #[1] ) == "int" )
38    {
39      @p = #[1];
40    };
41  };
42  return (@p);
43};
44
45///////////////////////////////////////////////////////////////////////////////
46proc makeUsl2(list #)
47"USAGE:   makeUsl2([p]), p an optional integer (field characteristic)
48RETURN:  ring
49PURPOSE: set up the U(sl_2) in the variables e,f,h over the field of char p
50NOTE:    activate this ring with the @code{setring} command
51SEE ALSO: makeUsl, makeUg2, makeUgl
52EXAMPLE: example makeUsl2; shows examples
53"{
54   int @p = defInt(#);
55   ring @@@rrr=@p,(e,f,h),dp;
56   matrix D[3][3]=0;
57   D[1,2]=-h;
58   D[1,3]=2*e;
59   D[2,3]=-2*f;
60   ncalgebra(1,D);
61   return(@@@rrr);
62}
63example
64{ "EXAMPLE:"; echo = 2;
65   def a=makeUsl2();
66   setring a;
67   a;
68}
69
70///////////////////////////////////////////////////////////////////////////////
71proc makeUsl(int n, list #)
72"USAGE:   makeUsl(n,[p]); n an integer, n>1; p an optional integer (field characteristic)
73RETURN:  ring
74PURPOSE: set up the U(sl_n) in the variables ( x(i),y(i),h(i) | i=1..n+1) over the field of char p
75NOTE:    activate this ring with the @code{setring} command
76@*       This presentation of U(sl_n) is the standard one, i.e. positive resp. negative roots are denoted by x(i) resp. y(i) and the Cartan elements are denoted by h(i).
77@* The variables are ordered as x(1),...x(n),y(1),...,y(n),h(1),...h(n).
78SEE ALSO: makeUsl2, makeUg2, makeUgl, makeQsl3, makeQso3
79EXAMPLE: example makeUsl; shows examples
80"{
81  if (n<2)
82  {
83    print("Incorrect input");
84    return(0);
85  }
86  if (n==2)
87  {
88    def @@@a=makeUsl2(#);
89    setring @@@a;
90    return(@@@a);
91  }
92
93  int @p = defInt(#);
94  ring @@@rr=@p,(x(1..n*(n-1)/2),y(1..n*(n-1)/2),h(1..n-1)),dp;
95  intmat CNT[n][n]=0;
96  matrix TMP[n][n]=0;
97  int k,l=1,1;
98  int buf=0;
99  list X,Y,H;
100  for(k=1; k<=n; k++)
101  {
102    for(l=k+1; l<=n; l++)
103    {
104      buf = (l-k-1)*(2*n-l+k)/2 + k;
105      CNT[k,l] = buf;
106      TMP[k,l] = 1;
107      X[buf] = TMP;
108      TMP = 0;
109      CNT[l,k] = buf;
110      TMP[l,k] = 1;
111      Y[buf] = TMP;
112      TMP=0;
113    }
114  }
115  for(k=1; k<=n-1; k++)
116  {
117    TMP[k,k]=1;
118    TMP[k+1,k+1]=-1;
119    H[k]=TMP;
120    TMP=0;
121  }
122  int i,j=1,1;
123  number p,q=0,0;
124  list V=X+Y+H;
125  int v=size(V);
126  matrix D[v][v]=0;
127  for(k=1; k<=v; k++)
128  {
129    for(l=k+1; l<=v; l++)
130    {
131      TMP=V[l]*V[k]-V[k]*V[l];
132      for(i=1; i<=n; i++)
133      {
134        for(j=i+1; j<=n; j++)
135        {
136          buf=(j-i-1)*(2*n-j+i)/2+i;
137          if (TMP[i,j]!=0)
138          {
139            D[k,l]=D[k,l]+leadcoef(TMP[i,j])*x(buf);
140          }
141          if (TMP[j,i]!=0)
142          {
143            D[k,l]=D[k,l]+leadcoef(TMP[j,i])*y(buf);
144          }
145        }
146      }
147      i=1;
148      while ( (TMP[i,i]==0) && (i<n) ) { i++; }
149      for(j=i; j<=n-1; j++)
150      {
151        p=leadcoef(TMP[j,j]);
152        q=leadcoef(TMP[j+1,j+1]);
153        D[k,l]=D[k,l]+p*h(j);
154        //        if ((j!=n-1)&&((p+q)!=0)) {D[k,l]=D[k,l]+(p+q)*h(j+1);}
155        TMP[j+1,j+1]=TMP[j+1,j+1]+p;
156      }
157    }
158  }
159  ncalgebra(1,D);
160  return(@@@rr);
161}
162example
163{ "EXAMPLE:"; echo = 2;
164   def a=makeUsl(3);
165   setring a;
166   a;
167}
168
169///////////////////////////////////////////////////////////////////////////////
170proc makeUg2(list #)
171"USAGE:  makeUg2([p]), p an optional int (field characteristic)
172RETURN:  ring
173PURPOSE: set up the U(g_2) in variables (x(i),y(i),Ha,Hb) for i=1..6 over the field of char p
174NOTE:    activate this ring with the @code{setring} command
175@* the variables are ordered as x(1),...x(6),y(1),...,y(6),Ha,Hb.
176SEE ALSO: makeUsl, makeUgl
177EXAMPLE: example makeUg2; shows examples
178"{
179  int @p = defInt(#);
180  ring @@@rrr=@p,(x(1..6),y(1..6),Ha,Hb),dp;
181  setring @@@rrr;
182  matrix D[14][14];
183  D[1,2]=-x(3);
184  D[1,3]=-2*x(4);
185  D[1,4]=3*x(5);
186  D[1,7]=-Ha;
187  D[1,9]=3*y(2);
188  D[1,10]=2*y(3);
189  D[1,11]=-y(4);
190  D[1,13]=2*x(1);
191  D[1,14]=-x(1);
192  D[2,5]=x(6);
193  D[2,8]=-Hb;
194  D[2,9]=-y(1);
195  D[2,12]=-y(5);
196  D[2,13]=-3*x(2);
197  D[2,14]=2*x(2);
198  D[3,4]=3*x(6);
199  D[3,7]=3*x(2);
200  D[3,8]=-x(1);
201  D[3,9]=-Ha-3*Hb;
202  D[3,10]=-2*y(1);
203  D[3,12]=-y(4);
204  D[3,13]=-x(3);
205  D[3,14]=x(3);
206  D[4,7]=2*x(3);
207  D[4,9]=-2*x(1);
208  D[4,10]=-2*Ha-3*Hb;
209  D[4,11]=y(1);
210  D[4,12]=y(3);
211  D[4,13]=x(4);
212  D[5,7]=-x(4);
213  D[5,10]=x(1);
214  D[5,11]=-Ha-Hb;
215  D[5,12]=y(2);
216  D[5,13]=3*x(5);
217  D[5,14]=-x(5);
218  D[6,8]=-x(5);
219  D[6,9]=-x(4);
220  D[6,10]=x(3);
221  D[6,11]=x(2);
222  D[6,12]=-Ha-2*Hb;
223  D[6,14]=x(6);
224  D[7,8]=y(3);
225  D[7,9]=2*y(4);
226  D[7,10]=-3*y(5);
227  D[7,13]=-2*y(1);
228  D[7,14]=y(1);
229  D[8,11]=-y(6);
230  D[8,13]=3*y(2);
231  D[8,14]=-2*y(2);
232  D[9,10]=-3*y(6);
233  D[9,13]=y(3);
234  D[9,14]=-y(3);
235  D[10,13]=-y(4);
236  D[11,13]=-3*y(5);
237  D[11,14]=y(5);
238  D[12,14]=-y(6);
239  ncalgebra(1,D);
240  return(@@@rrr);
241}
242example
243{ "EXAMPLE:"; echo = 2;
244   def a = makeUg2();
245   setring a;  a;
246}
247
248///////////////////////////////////////////////////////////////////////////////
249proc makeUgl(int n, list #)
250"USAGE:   makeUgl(n,[p]); n an int, n>1;  p an optional int (field characteristic)
251RETURN:  ring
252PURPOSE: set up the U(gl_n) in the (e_ij (1<i,j<n)) presentation (where e_ij corresponds to a matrix with 1 at i,j only) over the field of char p
253NOTE:    activate this ring with the @code{setring} command
254@* the variables are ordered as e_12,e_13,...,e_1n,e_21,...,e_nn.
255SEE ALSO: makeUsl, makeUg2
256EXAMPLE: example makeUgl; shows examples
257"{
258  if (n<2)
259  {
260    print("Incorrect input");
261    return(0);
262  };
263  int @p = defInt(#);
264  int i, j;
265  string vs = "";
266  for ( i = 1; i<= n ; i++ )
267  {
268        for ( j = 1; j<= n ; j++ )
269        {
270            if ( vs != "" )
271            {
272                vs = vs + ", ";
273            };
274            vs = vs + "e_" + string(i) + "_" + string(j);
275        };
276  };
277  string strRING = "ring RING_MAKEUGL=(" + string (@p) + "), (" + vs + "),dp;";
278  execute( strRING );
279  int N = nvars( RING_MAKEUGL ); // n*n
280  matrix D[N][N]=0;
281  int k, l;
282  int ik,il,jk,jl;
283  poly p ;
284  for( k=1; k<=N; k++)
285  {
286    ik = 1 + ((k-1)/n);
287    jk = k -  n*(ik-1);
288
289    for( l=k+1; l<=N; l++)
290    {
291        il = 1 + ((l-1)/n);
292        jl = l -  n*(il-1);
293        p = 0;
294        if( jl == ik )
295        {
296            p = p + var ( (il-1)*n + jk );
297        };
298        if( jk == il )
299        {
300            p = p - var ( (ik-1)*n + jl );
301        };
302        D[k,l]=p;
303    };
304  };
305  ncalgebra(1,D);
306  return(RING_MAKEUGL);
307}
308example
309{ "EXAMPLE:"; echo = 2;
310   def a=makeUgl(3);
311   setring a; a;
312};
313
314///////////////////////////////////////////////////////////////////////////////
315proc makeQso3(list #)
316"USAGE:   makeQso3([n]), n an optional int
317PURPOSE: set up the U_q(so_3) in the presentation of Klimyk; if n is specified, the quantum parameter Q will be specialized at the (2n)-th root of unity
318RETURN:  ring
319NOTE:    activate this ring with the @code{setring} command
320SEE ALSO: makeUsl, makeUg2, makeUgl, makeQsl2, makeQsl3, Qso3Casimir
321EXAMPLE: example makeQso3; shows examples
322"{
323  int @p = 2*defInt(#);
324  ring @@@r=(0,Q),(x,y,z),dp;
325  minpoly = rootofUnity(@p);
326  matrix C[3][3];
327  C[1,2]=Q2;
328  C[1,3]=1/Q2;
329  C[2,3]=Q2;
330  matrix D[3][3];
331  D[1,2]=-Q*z;
332  D[1,3]=1/Q*y;
333  D[2,3]=-Q*x;
334  ncalgebra(C,D);
335  return(@@@r);
336}
337example
338{ "EXAMPLE:"; echo = 2;
339   def K = makeQso3(3);
340   setring K;
341   K;
342}
343
344///////////////////////////////////////////////////////////////////////////////
345proc Qso3Casimir(int n, list #)
346"USAGE:   Qso3Casimir(n [,m]), n an integer, m an optional integer
347RETURN:  list (of polynomials)
348PURPOSE: compute the Casimir (central) elements of U_q(so_3) for the quantum parameter specialized at the n-th root of unity; if m!=0 is given, polynomials will be normalized
349ASSUME:    the basering must be U_q(so_3)
350SEE ALSO: makeQso3
351EXAMPLE: example Qso3Casimir; shows examples
352"{
353  if ( npars(basering) !=1 )
354  {
355    "Error: wrong algebra. U_q(so3) has only one parameter";
356    return(0);
357  }
358  if (n<1) { return(0); }
359  number Q = par(1);
360  int N=(n-1)/2;
361  int NV=nvars(basering);
362  number k1,k2;
363  poly p,rs,hlp;
364  list cp;
365  int j;
366  p=var(1);
367  for(j=0; j<=N; j++)
368  {
369    k1 = binomial(n-j,j,0);
370    k1=k1/(n-j);
371    k1=k1*((-1)^j);
372    k2=((Q^2)/(Q^4-1))^(2*j);
373    k2=k2*k1;
374    hlp=k2*(p)^(n-(2*j));
375    rs=rs+hlp;
376    hlp=0; k2=0; k1=0;
377  }
378  if (size(#)>0)
379  {
380    int m = int(#[1]);
381    if (m!=0)
382    {
383       rs = cleardenom(rs);
384    }
385  }
386  cp[1] = rs;
387  for(j=2; j<=NV; j++)
388  {
389    cp[j] = subst(rs,var(1),var(j));
390  }
391  return(cp);
392}
393example
394{ "EXAMPLE:"; echo = 2;
395   def R = makeQso3(5);
396   setring R;
397   list C = Qso3Casimir(5);
398   C;
399   list Cnorm = Qso3Casimir(5,1);
400   Cnorm;
401}
402
403///////////////////////////////////////////////////////////////////////////////
404proc makeQsl2(list #)
405"USAGE:   makeQsl2([n]), n an optional int
406RETURN:   ring
407PURPOSE:  define the U_q(sl_2) as a factor-ring of a ring V_q(sl_2) modulo the ideal @code{Qideal}
408NOTE:   the output consists of a ring, presenting V_q(sl_2) together with the ideal called @code{Qideal} in this ring
409@* activate this ring with the @code{setring} command
410@* in order to create the U_q(sl_2) from the output, execute the command like @code{qring Usl2q = Qideal;}
411@* If n is specified, the quantum parameter q will be specialized at the n-th root of unity
412SEE ALSO: makeUsl, makeQsl3, makeQso3
413EXAMPLE: example makeQsl2; shows examples
414"{
415  ring r=(0,q),(E,F,Ke,Kf),dp;
416  int @p = defInt(#);
417  if (@p >1)
418  {
419    minpoly = rootofUnity(@p);
420  }
421  matrix C = UpOneMatrix(4);;
422  matrix D[4][4];
423  C[1,3]=q^2;
424  C[2,3]=1/(q^2);
425  C[1,4]=1/(q^2);
426  C[2,4]=q^2;
427  D[1,2]=(1/(q-(1/q)))*(-Ke+Kf);
428  ncalgebra(C,D);
429  ideal Qideal = Ke*Kf-1;
430  Qideal = twostd(Qideal);
431  export Qideal;
432  return(r);
433}
434example
435{ "EXAMPLE:"; echo = 2;
436   def A = makeQsl2(3);
437   setring A;
438   Qideal;
439   qring Usl2q = Qideal;
440   Usl2q;
441}
442
443///////////////////////////////////////////////////////////////////////////////
444proc makeQsl3(list #)
445"USAGE:   makeQsl3([n]), n an optional int
446RETURN:   ring
447PURPOSE:  define the U_q(sl_3) as a factor-ring of a ring V_q(sl_3) modulo the ideal @code{Qideal}
448NOTE:   the output consists of a ring, presenting V_q(sl_3) together with the ideal called @code{Qideal} in this ring
449@* activate this ring with the @code{setring} command
450@* in order to create the U_q(sl_3) from the output, execute the command like @code{qring Usl3q = Qideal;}
451@* If n is specified, the quantum parameter q will be specialized at the n-th root of unity
452SEE ALSO: makeUsl, makeQsl2, makeQso3
453EXAMPLE: example makeQsl3; shows examples
454"{
455  int @p = defInt(#);
456  ring @@@rrr=(0, q), (f12, f13, f23, k1, k2, l1, l2, e12, e13, e23), wp(2, 3, 2, 1, 1, 1, 1, 2, 3, 2);
457  if (@p >1)
458  {
459    minpoly = rootofUnity(@p);
460  }
461  int @n = nvars(@@@rrr);
462  matrix C = UpOneMatrix(@n);
463  matrix D[@n][@n];
464  // some constants
465  number q1 =    1/q;
466  number Q  = (q )^2;
467  number Q1 = (q1)^2;
468  //   number QQ = Q - Q1; // q2 - 1/(q2)
469  number QQ1= 1 / (Q - Q1);
470  // relations:
471  C[1,2] = Q1;
472  C[2,3] = C[1,2];
473  C[8,9] = C[1,2];
474  C[9,10]= C[1,2];
475  C[1,3] = Q;
476  C[8,10]= C[1,3];
477
478  D[1,3] = -q*(f13);
479  D[8,10]= -q*(e13);
480  // V_q(sl_3)
481  D[1,8] = QQ1 * ( (k1) ^ 2 - (l1) ^ 2 );
482  D[3,10]= QQ1 * ( (k2) ^ 2 - (l2) ^ 2 );
483  D[2,9] = -QQ1 * ( ((k1)^2)*((k2)^2) - ((l1)^2)*((l2)^2) );
484  D[2, 8] =   q * (f23) * ((k1)^2);
485  D[3, 9] =   q * ((k2)^2) * (e12);
486  D[1, 9] = -q1 * ((l1)^2) * (e23);
487  D[2, 10]= -q1 * (f12) * ((l2)^2);
488  // k1
489  C[ 4, 8 ]= Q1;
490  C[ 4, 9 ]= q1;
491  C[ 4, 10]= q;
492  // l1
493  C[ 6, 8 ]= Q;
494  C[ 6, 9 ]= q;
495  C[ 6, 10]= q1;
496  // k2
497  C[ 5, 8 ]= q;
498  C[ 5, 9 ]= q1;
499  C[ 5, 10]= Q1;
500  // l2
501  C[ 7, 8 ]= q1;
502  C[ 7, 9 ]= q;
503  C[ 7, 10]= Q;
504  // k1
505  C[ 1, 4 ]= Q1;
506  C[ 2, 4 ]= q1;
507  C[ 3, 4 ]= q;
508  // l1
509  C[ 1, 6 ]= Q;
510  C[ 2, 6 ]= q;
511  C[ 3, 6 ]= q1;
512  // k2
513  C[ 1, 5 ]= q;
514  C[ 2, 5 ]= q1;
515  C[ 3, 5 ]= Q1;
516  // l2
517  C[ 1, 7 ]= q1;
518  C[ 2, 7 ]= q;
519  C[ 3, 7 ]= Q;
520  ncalgebra(C,D); // the V_q(makeUsl3) is done
521  ideal Qideal = k1*l1-1,  k2*l2-1;
522  Qideal = twostd(Qideal);
523  export Qideal;
524  return(@@@rrr);
525}
526example
527{ "EXAMPLE:"; echo = 2;
528   def B = makeQsl3(5);
529   setring B;
530   qring Usl3q = Qideal;
531   Usl3q;
532}
533
534proc GKZsystem(intmat A, string sord, string alg, list #)
535"USAGE:   GKZsystem(A, sord, alg, [,v]); A intmat, sord, alg string, v intvec
536RETURN:  ring
537PURPOSE: define a ring (Weyl algebra) and create a Gelfand-Kapranov-Zelevinsky (GKZ) system of equations in a ring from the following data:
538@*        @code{A}    is an intmat, defining the system,
539@*        @code{sord} is a string with desired term ordering,
540@*        @code{alg}  is a string, saying which algorithm to use (exactly like in toric_lib),
541@*        @code{v}    is an optional intvec.
542@* In addition, the ideal called @code{GKZid} containing actual equations is calculated and exported to the ring.
543NOTE:    activate the ring with the @code{setring} command. This procedure is elaborated by Oleksandr Yena
544ASSUME: This procedure uses toric_lib and therefore inherits its input requirements:
545@*        possible values for input variable @code{alg} are: \"ect\",\"pt\",\"blr\", \"hs\", \"du\".
546@*        As for the term ordering, it should be a string @code{sord} in Singular format like \"lp\",\"dp\", etc.
547@*        Please consult the toric_lib for allowed orderings and more details.
548SEE ALSO: toric_lib
549EXAMPLE: example GKZsystem; shows examples
550"{
551  int d = nrows(A);
552  int n = ncols(A);
553  execute("ring r1=0,(d(1..n)),"+sord+";");
554  ideal I0;
555  if (size(#)==0)
556  {
557    I0 = toric_ideal(A, alg);
558  }
559  else
560  {
561    if ( typeof(#[1]) == "intvec" )
562    {
563      intvec V = intvec(#[1]);
564      I0 = toric_ideal(A, alg, V);
565    }
566    else
567    {
568      "Wrong type of the optional argument. Intvec expected.";
569      return();
570    }
571  };
572  execute("ring GR = (0,b(1..d)),(x(1..n),d(1..n)),"+sord+";");
573  Weyl();
574  int i,j;
575  poly p;
576  ideal I;
577  for (i=1; i<=d; i++)
578  {
579    p = -b(i);
580    for (j=1; j<=n; j++)
581    {
582      p = p+ A[i,j]*x(j)*d(j);
583    }
584  I = I, p;
585  }
586  I = I, imap(r1,I0);
587  I = simplify(I,2);
588  ideal GKZid = I;
589  export GKZid;
590  return(GR);
591}
592example
593{"EXAMPLE:"; echo = 2;
594  // example 3.1.4 from the [SST] without vector w
595  intmat A[2][4]=3,2,1,0,0,1,2,3;
596  print(A);
597  def D1 = GKZsystem(A,"lp","ect");
598  setring D1;
599  D1;
600  print(GKZid);
601  // now, consider A with the vector w=1,1,1,1
602  intvec v=1,1,1,1;
603  def D2 = GKZsystem(A,"lp","blr",v);
604  setring D2;
605  print(GKZid);
606}
607// easier example: 3.1.1 from SST
608//   intmat A[2][3]=2,1,0,0,1,2;
609///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.