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