source: git/Singular/LIB/ncpreim.lib @ 1b2216

spielwiese
Last change on this file since 1b2216 was 1e1ec4, checked in by Oleksandr Motsak <motsak@…>, 11 years ago
Updated LIBs according to master add: new LIBs from master fix: updated LIBs due to minpoly/(de)numerator changes fix: -> $Id$ fix: Fixing wrong rebase of SW on master (LIBs)
  • Property mode set to 100644
File size: 20.2 KB
Line 
1//////////////////////////////////////////////////////////////////////
2version="$Id$";
3category="Noncommutative";
4info="
5LIBRARY: ncpreim.lib    Non-commutative elimination and preimage computations
6AUTHOR:  Daniel Andres, daniel.andres@math.rwth-aachen.de
7
8Support: DFG Graduiertenkolleg 1632 `Experimentelle und konstruktive Algebra'
9
10
11OVERVIEW:
12In G-algebras, elimination of variables is more involved than in the
13commutative case.
14One, not every subset of variables generates an algebra, which is again a
15G-algebra.
16Two, even if the subset of variables in question generates an admissible
17subalgebra, there might be no admissible elimination ordering, i.e. an
18elimination ordering which also satisfies the ordering condition for
19G-algebras.
20
21The difference between the procedure @code{eliminateNC} provided in this
22library and the procedure @code{eliminate (plural)} from the kernel is that
23eliminateNC will always find an admissible elimination if such one exists.
24Moreover, the use of @code{slimgb} for performing Groebner basis computations
25is possible.
26
27As an application of the theory of elimination, the procedure @code{preimageNC}
28is provided, which computes the preimage of an ideal under a homomorphism
29f: A -> B between G-algebras A and B. In contrast to the kernel procedure
30@code{preimage (plural)}, the assumption that A is commutative is not required.
31
32
33REFERENCES:
34   (BGL) J.L. Bueso, J. Gomez-Torrecillas, F.J. Lobillo:
35         `Re-filtering and exactness of the Gelfand-Kirillov dimension',
36         Bull. Sci. math. 125, 8, 689-715, 2001.
37@* (GML) J.I. Garcia Garcia, J. Garcia Miranda, F.J. Lobillo:
38         `Elimination orderings and localization in PBW algebras',
39         Linear Algebra and its Applications 430(8-9), 2133-2148, 2009.
40@* (Lev) V. Levandovskyy: `Intersection of ideals with non-commutative
41         subalgebras', ISSAC'06, 212-219, ACM, 2006.
42
43
44PROCEDURES:
45eliminateNC(I,v,eng);      elimination in G-algebras
46preimageNC(A,f,J[,P,eng]); preimage of ideals under homomorphisms of G-algebras
47admissibleSub(v);          checks whether subalgebra is admissible
48isUpperTriangular(M,k);    checks whether matrix is (strictly) upper triangular
49appendWeight2Ord(w);       appends weight to ordering
50elimWeight(v);             computes elimination weight
51extendedTensor(A,I);       tensor product of rings with additional relations
52
53
54KEYWORDS: preimage; elimination
55
56
57SEE ALSO: elim_lib, preimage (plural)
58";
59
60
61LIB "elim.lib";    // for nselect
62LIB "nctools.lib"; // for makeWeyl etc.
63LIB "dmodapp.lib"; // for sortIntvec
64LIB "ncalg.lib";   // for makeUgl
65LIB "dmodloc.lib"; // for commRing
66
67
68/*
69CHANGELOG
7011.12.12: docu, typos, fixed variable names in extendedTensor,
71 moved commRing to dmodloc.lib
7212.12.12: typos
7317.12.12: docu
74*/
75
76
77// -- Testing for consistency of the library ---------------
78
79static proc testncpreimlib()
80{
81  example admissibleSub;
82  example isUpperTriangular;
83  example appendWeight2Ord;
84  example elimWeight;
85  example eliminateNC;
86  example extendedTensor;
87  example preimageNC;
88}
89
90
91// -- Tools ------------------------------------------------
92
93
94proc admissibleSub (intvec v)
95"
96USAGE:    admissibleSub(v);  v intvec
97ASSUME:   The entries of v are in the range 1..nvars(basering).
98RETURN:   int, 1 if the variables indexed by the entries of v form an
99          admissible subalgebra, 0 otherwise
100EXAMPLE:  example admissibleSub; shows examples
101"
102{
103  v = checkIntvec(v);
104  int i,j;
105  list RL = ringlist(basering);
106  if (size(RL) == 4)
107  {
108    return(int(1));
109  }
110  matrix D = RL[6];
111  ideal I;
112  for (i=1; i<=size(v); i++)
113  {
114    for (j=i+1; j<=size(v); j++)
115    {
116      I[size(I)+1] = D[v[j],v[i]];
117    }
118  }
119  ideal M = maxideal(1);
120  ideal J = M[v];
121  attrib(J,"isSB",1);
122  M = NF(M,J);
123  M = simplify(M,2); // get rid of double entries in v
124  intvec opt = option(get);
125  attrib(M,"isSB",1);
126  option("redSB");
127  J = NF(I,M);
128  option(set,opt);
129  for (i=1; i<=ncols(I); i++)
130  {
131    if (J[i]<>I[i])
132    {
133      return(int(0));
134    }
135  }
136  return(int(1));
137}
138example
139{
140  "EXAMPLE:"; echo = 2;
141  ring r = 0,(e,f,h),dp;
142  matrix d[3][3];
143  d[1,2] = -h; d[1,3] = 2*e; d[2,3] = -2*f;
144  def A = nc_algebra(1,d);
145  setring A; A; // A is U(sl_2)
146  // the subalgebra generated by e,f is not admissible since [e,f]=h
147  admissibleSub(1..2);
148  // but the subalgebra generated by f,h is admissible since [f,h]=2f
149  admissibleSub(2..3);
150}
151
152
153proc isUpperTriangular(matrix M, list #)
154"
155USAGE:    isUpperTriangular(M[,k]);  M a matrix, k an optional int
156RETURN:   int, 1 if the given matrix is upper triangular,
157          0 otherwise.
158NOTE:     If k<>0 is given, it is checked whether M is strictly upper
159          triangular.
160EXAMPLE:  example isUpperTriangular; shows examples
161"
162{
163  int strict;
164  if (size(#)>0)
165  {
166    if ((typeof(#[1])=="int") || (typeof(#[1])=="number"))
167    {
168      strict = (0<>int(#[1]));
169    }
170  }
171  int m = Min(intvec(nrows(M),ncols(M)));
172  int j;
173  ideal I;
174  for (j=1; j<=m; j++)
175  {
176    I = M[j..nrows(M),j];
177    if (!strict)
178    {
179      I[1] = 0;
180    }
181    if (size(I)>0)
182    {
183      return(int(0));
184    }
185  }
186  return(int(1));
187}
188example
189{
190  "EXAMPLE:"; echo = 2;
191  ring r = 0,x,dp;
192  matrix M[2][3] =
193    0,1,2,
194    0,0,3;
195  isUpperTriangular(M);
196  isUpperTriangular(M,1);
197  M[2,2] = 4;
198  isUpperTriangular(M);
199  isUpperTriangular(M,1);
200}
201
202
203proc appendWeight2Ord (intvec w)
204"
205USAGE:    appendWeight2Ord(w);  w an intvec
206RETURN:   ring, the basering equipped with the ordering (a(w),<), where < is
207          the ordering of the basering.
208EXAMPLE:  example appendWeight2Ord; shows examples
209"
210{
211  list RL = ringlist(basering);
212  RL[3] = insert(RL[3],list("a",w),0);
213  def A = ring(RL);
214  return(A);
215}
216example
217{
218  "EXAMPLE:"; echo = 2;
219  ring r = 0,(a,b,x,d),Dp;
220  intvec w = 1,2,3,4;
221  def r2 = appendWeight2Ord(w); // for a commutative ring
222  r2;
223  matrix D[4][4];
224  D[1,2] = 3*a;  D[1,4] = 3*x^2;  D[2,3] = -x;
225  D[2,4] = d;    D[3,4] = 1;
226  def A = nc_algebra(1,D);
227  setring A; A;
228  w = 2,1,1,1;
229  def B = appendWeight2Ord(w);  // for a non-commutative ring
230  setring B; B;
231}
232
233
234static proc checkIntvec (intvec v)
235"
236USAGE:    checkIntvec(v);  v intvec
237RETURN:   intvec consisting of entries of v in ascending order
238NOTE:     Purpose of this proc: check if all entries of v are in the range
239          1..nvars(basering).
240"
241{
242  if (size(v)>1)
243  {
244    v = sortIntvec(v)[1];
245  }
246  int n = nvars(basering);
247  if ( (v[1]<1) || v[size(v)]>n)
248  {
249    ERROR("Entries of intvec must be in the range 1.." + string(n));
250  }
251  return(v);
252}
253
254
255
256// -- Elimination ------------------------------------------
257
258
259/*
260// this is the same as Gweights@nctools.lib
261//
262// proc orderingCondition (matrix D)
263// "
264// USAGE:    orderingCondition(D);  D a matrix
265// ASSUME:   The matrix D is a strictly upper triangular square matrix.
266// RETURN:   intvec, say w, such that the ordering (a(w),<), where < is
267//           any global ordering, satisfies the ordering condition for
268//           all G-algebras induced by D.
269// NOTE:     If no such ordering exists, the zero intvec is returned.
270// REMARK:   Reference: (BGL)
271// EXAMPLE:  example orderingCondition; shows examples
272// "
273// {
274//   if (ncols(D) <> nrows(D))
275//   {
276//     ERROR("Expected square matrix.");
277//   }
278//   if (isUpperTriangular(D,1)==0)
279//   {
280//     ERROR("Expected strictly upper triangular matrix.");
281//   }
282//   intvec v = 1..nvars(basering);
283//   intvec w = orderingConditionEngine(D,v,0);
284//   return(w);
285// }
286// example
287// {
288//   "EXAMPLE:"; echo = 2;
289//   // (Lev): Example 2
290//   ring r = 0,(a,b,x,d),dp;
291//   matrix D[4][4];
292//   D[1,2] = 3*a;  D[1,4] = 3*x^2;  D[2,3] = -x;
293//   D[2,4] = d;    D[3,4] = 1;
294//   // To create a G-algebra, the ordering condition implies
295//   // that x^2<a*d must hold (see D[1,4]), which is not fulfilled:
296//   x^2 < a*d;
297//   // Hence, we look for an appropriate weight vector
298//   intwec w = orderingCondition(D); w;
299//   // and use it accordingly.
300//   ring r2 = 0,(a,b,x,d),(a(w),dp);
301//   x^2 < a*d;
302//   matrix D = imap(r,D);
303//   def A = nc_algebra(1,D);
304//   setring A; A;
305// }
306*/
307
308
309proc elimWeight (intvec v)
310"
311USAGE:    elimWeight(v);  v an intvec
312ASSUME:   The basering is a G-algebra.
313@*        The entries of v are in the range 1..nvars(basering) and the
314          corresponding variables generate an admissible subalgebra.
315RETURN:   intvec, say w, such that the ordering (a(w),<), where < is
316          any admissible global ordering, is an elimination ordering
317          for the subalgebra generated by the variables indexed by the
318          entries of the given intvec.
319NOTE:     If no such ordering exists, the zero intvec is returned.
320REMARK:   Reference: (BGL), (GML)
321EXAMPLE:  example elimWeight; shows examples
322"
323{
324  list RL = ringlist(basering);
325  if (size(RL)==4)
326  {
327    ERROR("Expected non-commutative basering.");
328  }
329  matrix D = RL[6];
330  intvec w = orderingConditionEngine(D,v,1);
331  return(w);
332}
333example
334{
335  "EXAMPLE:"; echo = 2;
336  // (Lev): Example 2
337  ring r = 0,(a,b,x,d),Dp;
338  matrix D[4][4];
339  D[1,2] = 3*a;  D[1,4] = 3*x^2;  D[2,3] = -x;
340  D[2,4] = d;    D[3,4] = 1;
341  def A = nc_algebra(1,D);
342  setring A; A;
343  // Since d*a-a*d = 3*x^2, any admissible ordering has to satisfy
344  // x^2 < a*d, while any elimination ordering for {x,d} additionally
345  // has to fulfil a << x and a << d.
346  // Hence neither a block ordering with weights
347  // (1,1,1,1) nor a weighted ordering with weight (0,0,1,1) will do.
348  intvec v = 3,4;
349  elimWeight(v);
350}
351
352
353static proc orderingConditionEngine (matrix D, intvec v, int elimweight)
354{
355  // algorithm from (BGL) and (GML), respectively
356  // solving an LPP via simplex
357  int ppl = printlevel - voice + 1;
358  def save = basering;
359  int n = nvars(save);
360  ideal EV = maxideal(1);
361  EV = EV[v]; // also assumption check for v
362  attrib(EV,"isSB",1);
363  ideal NEV = maxideal(1);
364  NEV = NF(NEV,EV);
365  intmat V1[n-size(NEV)][n+1];
366  if (elimweight)
367  {
368    intmat V2[size(NEV)][n+1];
369  }
370  int rowV1,rowV2;
371  intmat M[1][n];
372  intmat M2,oldM;
373  int i,j,k;
374  for (i=1; i<=n; i++)
375  {
376    if (elimweight)
377    {
378      if (NEV[i]<>0)
379      {
380        V2[rowV2+1,i+1] = 1; // xj == 0
381        rowV2++;
382      }
383      else
384      {
385        V1[rowV1+1,1] = 1; // 1-xi <= 0
386        V1[rowV1+1,i+1] = -1;
387        rowV1++;
388      }
389    }
390    else
391    {
392      V1[i,1] = 1; // 1-xi <= 0
393      V1[i,i+1] = -1;
394      rowV1++;
395    }
396    for (j=i+1; j<=n; j++)
397    {
398      if (deg(D[i,j])>0)
399      {
400        M2 = newtonDiag(D[i,j]);
401        for (k=1; k<=nrows(M2); k++)
402        {
403          M2[k,i] = M2[k,i] - 1; // <beta,x> >= 0
404          M2[k,j] = M2[k,j] - 1;
405        }
406        oldM = M;
407        M = intmat(M,nrows(M)+nrows(M2),n);
408        M = oldM,M2;
409      }
410    }
411  }
412  intvec eq = 0,(-1:n);
413  ring r = 0,x,dp; // to avoid problems with pars or char>0
414  module MM = module(transpose(matrix(M)));
415  MM = simplify(MM,2+4);
416  matrix A;
417  if (MM[1]<>0)
418  {
419    if (elimweight)
420    {
421      MM = 0,transpose(MM);
422    }
423    else
424    {
425      MM = module(matrix(1:ncols(MM)))[1],transpose(MM);
426    }
427    A = transpose(concat(matrix(eq),transpose(-MM)));
428  }
429  else
430  {
431    A = transpose(eq);
432  }
433  A = transpose(concat(transpose(A),matrix(transpose(V1))));
434  if (elimweight)
435  {
436    A = transpose(concat(transpose(A),matrix(transpose(V2))));
437  }
438  int m = nrows(A)-1;
439  ring realr = (real,10),x,lp;
440  matrix A = imap(r,A);
441  dbprint(ppl,"// Calling simplex...");
442  dbprint(ppl-1,"// with the matrix " + print(A));
443  dbprint(ppl-1,"// and parameters "
444          + string(intvec(m,n,m-rowV1-rowV2,rowV1,rowV2)));
445  list L = simplex(A,m,n,m-rowV1-rowV2,rowV1,rowV2);
446  int se = L[2];
447  if (se==-2)
448  {
449    ERROR("simplex yielded an error. Please inform the authors.");
450  }
451  intvec w = 0:n;
452  if (se==0)
453  {
454    matrix S = L[1];
455    intvec s = L[3];
456    for (i=2; i<=nrows(S); i++)
457    {
458      if (s[i-1]<=n)
459      {
460        w[s[i-1]] = int(S[i,1]);
461      }
462    }
463  }
464  setring save;
465  return(w);
466}
467
468
469proc eliminateNC (ideal I, intvec v, list #)
470"
471USAGE:    eliminateNC(I,v,eng);  I ideal, v intvec, eng optional int
472RETURN:   ideal, I intersected with the subring defined by the variables not
473          index by the entries of v
474ASSUME:   The entries of v are in the range 1..nvars(basering) and the
475          corresponding variables generate an admissible subalgebra.
476REMARKS:  In order to determine the required elimination ordering, a linear
477          programming problem is solved with the simplex algorithm.
478@*        Reference: (GML)
479@*        Unlike eliminate, this procedure will always find an elimination
480          ordering, if such exists.
481NOTE:     If eng<>0, @code{std} is used for Groebner basis computations,
482          otherwise (and by default) @code{slimgb} is used.
483@*        If printlevel=1, progress debug messages will be printed,
484          if printlevel>=2, all the debug messages will be printed.
485SEE ALSO: eliminate (plural)
486EXAMPLE:  example eliminateNC; shows examples
487"
488{
489  int ppl = printlevel - voice + 2;
490  v = checkIntvec(v);
491  if (!admissibleSub(v))
492  {
493    ERROR("Subalgebra is not admissible: no elimination is possible.");
494  }
495  dbprint(ppl,"// Subalgebra is admissible.");
496  int eng;
497  if (size(#)>0)
498  {
499    if (typeof(#[1])=="int" || typeof(#[1])=="number")
500    {
501      eng = int(#[1]);
502    }
503  }
504  def save = basering;
505  int n = nvars(save);
506  dbprint(ppl,"// Computing elimination weight...");
507  intvec w = elimWeight(v);
508  if (w==(0:n))
509  {
510    ERROR("No elimination ordering exists.");
511  }
512  dbprint(ppl,"// ...done.");
513  dbprint(ppl-1,"// Using elimination weight " + string(w) + ".");
514  def r = appendWeight2Ord(w);
515  setring r;
516  ideal I = imap(save,I);
517  dbprint(ppl,"// Computing Groebner basis with engine " + string(eng)+"...");
518  I = engine(I,eng);
519  dbprint(ppl,"// ...done.");
520  dbprint(ppl-1,string(I));
521  I = nselect(I,v);
522  setring save;
523  I = imap(r,I);
524  return(I);
525}
526example
527{
528  "EXAMPLE:"; echo = 2;
529  // (Lev): Example 2
530  ring r = 0,(a,b,x,d),Dp;
531  matrix D[4][4];
532  D[1,2] = 3*a; D[1,4] = 3*x^2;
533  D[2,3] = -x;  D[2,4] = d;     D[3,4] = 1;
534  def A = nc_algebra(1,D);
535  setring A; A;
536  ideal I = a,x;
537  // Since d*a-a*d = 3*x^2, any admissible ordering has to satisfy
538  // x^2 < a*d, while any elimination ordering for {x,d} additionally
539  // has to fulfil a << x and a << d.
540  // Hence, the weight (0,0,1,1) is not an elimination weight for
541  // (x,d) and the call eliminate(I,x*d); will produce an error.
542  eliminateNC(I,3..4);
543  // This call uses the elimination weight (0,0,1,2), which works.
544}
545
546
547
548// -- Preimages ------------------------------------------------
549
550// TODO A or B commutative
551proc extendedTensor(def A, ideal I)
552"
553USAGE:    extendedTensor(A,I);  A ring, I ideal
554RETURN:   ring, A+B (where B denotes the basering) extended with non-
555          commutative relations between the vars of A and B, which arise from
556          the homomorphism A -> B induced by I in the usual sense, i.e. if the
557          vars of A are named x(i) and the vars of B y(j), then putting
558          q(i)(j) = leadcoef(y(j)*I[i])/leadcoef(I[i]*y(j)) and
559          r(i)(j) = y(j)*I[i] - q(i)(j)*I[i]*y(j) yields the relation
560          y(j)*x(i) = q(i)(j)*x(i)*y(j)+r(i)(j).
561REMARK:   Reference: (Lev)
562EXAMPLE:  example extendedTensor; shows examples
563"
564{
565  def B = basering;
566  setring A;
567  int nA = nvars(A);
568  string varA = "," + charstr(A) + "," + varstr(A) + ",";
569  setring B;
570  int nB = nvars(B);
571  list RL = ringlist(B);
572  list L = RL[2];
573  string vB;
574  int i,j;
575  for (i=1; i<=nB; i++)
576  {
577    vB = "," + L[i] + ",";
578    while (find(varA,vB)<>0)
579    {
580      vB[1] = "@";
581      vB = "," + vB;
582    }
583    vB = vB[2..size(vB)-1];
584    L[i] = vB;
585  }
586  RL[2] = L;
587  def @B = ring(RL);
588  kill L,RL;
589  setring @B;
590  ideal I = fetch(B,I);
591  def E = A+@B;
592  setring E;
593  ideal I = imap(@B,I);
594  matrix C = ringlist(E)[5];
595  matrix D = ringlist(E)[6];
596  poly p,q;
597  for (i=1; i<=nA; i++)
598  {
599    for (j=nA+1; j<=nA+nB; j++)
600    {
601      // upper right block: new relations
602      p = var(j)*I[i];
603      q = I[i]*var(j);
604      C[i,j] = leadcoef(p)/leadcoef(q);
605      D[i,j] = p - C[i,j]*q;
606    }
607  }
608  def @EE = commRing();
609  setring @EE;
610  matrix C = imap(E,C);
611  matrix D = imap(E,D);
612  def EE = nc_algebra(C,D);
613  setring B;
614  return(EE);
615}
616example
617{
618  "EXAMPLE:"; echo = 2;
619  def A = makeWeyl(2);
620  setring A; A;
621  def B = makeUgl(2);
622  setring B; B;
623  ideal I = var(1)*var(3), var(1)*var(4), var(2)*var(3), var(2)*var(4);
624  I;
625  def C = extendedTensor(A,I);
626  setring C; C;
627}
628
629
630proc preimageNC (list #)
631"
632USAGE:    preimageNC(A,f,J[,P,eng]);  A ring, f map or ideal, J ideal,
633                                      P optional string, eng optional int
634ASSUME:   f defines a map from A to the basering.
635RETURN:   nothing, instead exports an object `preim' of type ideal to ring A,
636          being the preimage of J under f.
637NOTE:     If P is given and not equal to the empty string, the preimage is
638          exported to A under the name specified by P.
639          Otherwise (and by default), P is set to `preim'.
640@*        If eng<>0, @code{std} is used for Groebner basis computations,
641          otherwise (and by default) @code{slimgb} is used.
642@*        If printlevel=1, progress debug messages will be printed,
643          if printlevel>=2, all the debug messages will be printed.
644REMARK:   Reference: (Lev)
645SEE ALSO: preimage (plural)
646EXAMPLE:  example preimageNC; shows examples
647"
648{
649  int ppl = printlevel - voice + 2;
650  if (size(#) <3)
651  {
652    ERROR("Expected 3 arguments.")
653  }
654  def B = basering;
655  if (typeof(#[1])<>"ring")
656  {
657    ERROR("First argument must be a ring.");
658  }
659  def A = #[1];
660  setring A;
661  ideal mm = maxideal(1);
662  setring B;
663  if (typeof(#[2])=="map")
664  {
665    map phi = #[2];
666  }
667  else
668  {
669    if (typeof(#[2])=="ideal")
670    {
671      map phi = A,#[2];
672    }
673    else
674    {
675      ERROR("Second argument must define a map from the specified ring to the basering.");
676    }
677  }
678  if (typeof(#[3])<>"ideal")
679  {
680    ERROR("Third argument must be an ideal in the specified ring");
681  }
682  ideal J = #[3];
683  string str = "preim";
684  int eng;
685  if (size(#)>3)
686  {
687    if (typeof(#[4])=="string")
688    {
689      if (#[4]<>"")
690      {
691        str = #[4];
692      }
693    }
694    if (size(#)>4)
695    {
696      if (typeof(#[5])=="int")
697      {
698        eng = #[5];
699      }
700    }
701  }
702  setring B;
703  ideal I = phi(mm);
704  def E = extendedTensor(A,I);
705  setring E;
706  dbprint(ppl,"// Computing in ring");
707  dbprint(ppl,E);
708  int nA = nvars(A);
709  int nB = nvars(B);
710  ideal @B2E = maxideal(1);
711  @B2E = @B2E[(nA+1)..(nA+nB)];
712  map B2E = B,@B2E;
713  ideal I = B2E(I);
714  ideal Iphi;
715  int i,j;
716  for (i=1; i<=nA; i++)
717  {
718    Iphi[size(Iphi)+1] = var(i) - I[i];
719  }
720  dbprint(ppl,"// I_{phi} is  " + string(Iphi));
721  ideal J = imap(B,J);
722  J = J + Iphi;
723  intvec v = (nA+1)..(nA+nB);
724  dbprint(ppl,"// Starting elimination...");
725  dbprint(ppl-1,string(J));
726  J = eliminateNC(J,v,eng);
727  dbprint(ppl,"// ...done.");
728  dbprint(ppl-1,string(J));
729  J = nselect(J,v);
730  attrib(J,"isSB",1);
731  setring A;
732  dbprint(ppl,"// Writing output to specified ring under the name `"
733          + str + "'.");
734  str = "ideal " + str + " = imap(E,J); export(" + str + ");";
735  execute(str);
736  setring B;
737  return();
738}
739example
740{
741  "EXAMPLE:"; echo = 2;
742  def A = makeUgl(3); setring A; A; // universal enveloping algebra of gl_3
743  ring r3 = 0,(x,y,z,Dx,Dy,Dz),dp;
744  def B = Weyl(); setring B; B;     // third Weyl algebra
745  ideal ff = x*Dx,x*Dy,x*Dz,y*Dx,y*Dy,y*Dz,z*Dx,z*Dy,z*Dz;
746  map f = A,ff;                     // f: A -> B, e(i,j) |-> x(i)D(j)
747  ideal J = 0;
748  preimageNC(A,f,J,"K");            // compute K := ker(f)
749  setring A;
750  K;
751}
752
753
754// -- Examples ---------------------------------------------
755
756static proc ex1 ()
757{
758  ring r1 = 0,(a,b),dp;
759  int t = 7;
760  def St = nc_algebra(1,t*a);
761  ring r2 = 0,(x,D),dp;
762  def W = nc_algebra(1,1); // W is the first Weyl algebra
763  setring W;
764  map psit = St, x^t,x*D+t;
765  int p = 3;
766  ideal Ip = x^p, x*D+p;
767  preimageNC(St,psit,Ip);
768  setring St; preim;
769}
770
771
772static proc ex2 ()
773{
774  ring r1 = 0,(e,f,h),dp;
775  matrix D1[3][3]; D1[1,2] = -h; D1[1,3] = 2*e; D1[2,3] = -2*f;
776  def U = nc_algebra(1,D1); // D is U(sl_2)
777  ring r2 = 0,(x,D),dp;
778  def W = nc_algebra(1,1); // W is the first Weyl algebra
779  setring W;
780  ideal tau = x,-x*D^2,2*x*D;
781  def E = extendedTensor(U,tau);
782  setring E; E;
783  elimWeight(4..5);
784  // zero, since there is no elimination ordering for x,D in E
785}
786
787
788static proc ex3 ()
789{
790  ring r1 = 0,(x,d,s),dp;
791  matrix D1[3][3]; D1[1,2] = 1;
792  def A = nc_algebra(1,D1);
793  ring r2 = 0,(X,DX,T,DT),dp;
794  matrix D2[4][4]; D2[1,2] = 1; D2[3,4] = 1;
795  def B = nc_algebra(1,D2);
796  setring B;
797  map phi = A, X,DX,-DT*T;
798  ideal J = T-X^2, DX+2*X*DT;
799  preimageNC(A,phi,J);
800  setring A;
801  preim;
802}
Note: See TracBrowser for help on using the repository browser.