1 | ///////////////////////////////////////////////////////////////////////////// |
---|
2 | version="version bimodules.lib 4.0.0.0 Jun_2013 "; // $Id$ |
---|
3 | category="Noncommutative"; |
---|
4 | info=" |
---|
5 | LIBRARY: bimodules.lib Tools for handling bimodules |
---|
6 | AUTHORS: Ann Christina Foldenauer, Christina.Foldenauer@rwth-aachen.de |
---|
7 | @* Viktor Levandovskyy, levandov@math.rwth-aachen.de |
---|
8 | |
---|
9 | OVERVIEW: |
---|
10 | @* The main purpose of this library is the handling of bimodules |
---|
11 | @* which will help e.g. to determine weak normal forms of representation matrices |
---|
12 | @* and total divisors within non-commutative, non-simple G-algebras. |
---|
13 | @* We will use modules homomorphisms between a G-algebra and its enveloping algebra |
---|
14 | @* in order to work left Groebner basis theory on bimodules. |
---|
15 | @* Assume we have defined a (non-commutative) G-algebra A over the field K, and an (A,A)-bimodule M. |
---|
16 | @* Instead of working with M over A, we define the enveloping algebra A^{env} = A otimes_K A^{opp} |
---|
17 | @* (this can be done with command envelope(A)) and embed M into A^{env} via imap(). |
---|
18 | @* Thus we obtain the left A^{env}-module M otimes 1 in A^{env}. |
---|
19 | @* This has a lot of advantages, because left module theory has much more commands |
---|
20 | @* that are already implemented in SINGULAR:PLURAL. Two important procedures that we can use are std() |
---|
21 | @* which computes the left Groebner basis, and NF() which computes the left normal form. |
---|
22 | @* With the help of this method we are also able to determine the set of bisyzygies of a bimodule. |
---|
23 | @* |
---|
24 | @* A built-in command @code{twostd} in PLURAL computes the two-sided Groebner basis of an ideal |
---|
25 | @* by using the right completion algorithm of [2]. @code{bistd} from this library uses very different |
---|
26 | @* approach, which is often superior to the right completion. |
---|
27 | |
---|
28 | REFERENCES: |
---|
29 | @* The procedure bistd() is the implementation of an algorithm M. del Socorro Garcia Roman presented in [1](page 66-78). |
---|
30 | @* [1] Maria del Socorro Garcia Roman, Effective methods in Algebras with PBW bases: |
---|
31 | @* G-algebras and Yang-Baxter Algebras, Ph.D. thesis, Universidad de La Laguna, 2005. |
---|
32 | @* [2] Viktor Levandovskyy, Non-commutative Computer Algebra for polynomial Algebras: |
---|
33 | @* Groebner Bases, Applications and Implementations, Ph.D. thesis, Kaiserlautern, 2005. |
---|
34 | @* [3] N. Jacobson, The theory of rings, AMS, 1943. |
---|
35 | @* [4] P. M. Cohn, Free Rings and their Relations, Academic Press Inc. (London) Ltd., 1971. |
---|
36 | |
---|
37 | PROCEDURES: |
---|
38 | bistd(M); computes the two-sided Groebner bases of an ideal or module |
---|
39 | bitrinity(M); computes the trinity of M: Groebner basis, lift matrix and bisyzygies |
---|
40 | liftenvelope(M,g); computes the coefficients of an element g concerning the generators of a bimodule M in the enveloping algebra |
---|
41 | CompDecomp(p); returns an ideal which contains the component decomposition of a polynomial p in the enveloping algebra regarding the right side of the tensors |
---|
42 | isPureTensor(p); checks whether an element p in A^{env} is a pure tensor |
---|
43 | isTwoSidedGB(I); checks whether an ideal I is two-sided Groebner basis |
---|
44 | |
---|
45 | SEE ALSO: ncalg_lib; nctools_lib |
---|
46 | |
---|
47 | KEYWORDS: bimodules; bisyzygies; lift; enveloping algebra; pure tensor; total divisors; two-sided; two-sided Groebner basis; tensor |
---|
48 | |
---|
49 | "; |
---|
50 | |
---|
51 | LIB "ncalg.lib"; |
---|
52 | LIB "nctools.lib"; |
---|
53 | |
---|
54 | proc testbimoduleslib() |
---|
55 | { |
---|
56 | /* tests all procs for consistency */ |
---|
57 | "MAIN PROCEDURES:"; |
---|
58 | example bistd; |
---|
59 | example bitrinity; |
---|
60 | example liftenvelope; |
---|
61 | example isPureTensor; |
---|
62 | example isTwoSidedGB; |
---|
63 | "SECONDARY BIMODULES PROCEDURES:"; |
---|
64 | example enveltrinity; |
---|
65 | example CompDecomp; |
---|
66 | } |
---|
67 | |
---|
68 | proc bistdIdeal (ideal M) |
---|
69 | "does bistd directly for ideals |
---|
70 | " |
---|
71 | { |
---|
72 | intvec optionsave = option(get); |
---|
73 | option(redSB); |
---|
74 | option(redTail); |
---|
75 | def save = basering ; |
---|
76 | def saveenv = envelope(save); |
---|
77 | setring saveenv; |
---|
78 | ideal M = imap(save, M); |
---|
79 | int i; int n = nvars(save); |
---|
80 | ideal K; |
---|
81 | for (i=1; i <= n; i++) |
---|
82 | { |
---|
83 | K[i] = var(i)-var(2*n-i+1); |
---|
84 | } |
---|
85 | M = M+K; |
---|
86 | M = std(M); |
---|
87 | option(set,optionsave); |
---|
88 | setring save; |
---|
89 | list L = ringlist(save); |
---|
90 | if (size(ringlist(save)) > 4) |
---|
91 | { |
---|
92 | L = delete(L,6); |
---|
93 | L = delete(L,5);} |
---|
94 | def Scom = ring(L); |
---|
95 | setring Scom; |
---|
96 | ideal P; |
---|
97 | for (i= 1; i <= n; i++) |
---|
98 | { |
---|
99 | P[i] = var(i); |
---|
100 | P[2*n-i+1] = var(i); |
---|
101 | } |
---|
102 | map Pi = saveenv, P; |
---|
103 | ideal N = Pi(M) ; |
---|
104 | setring save; |
---|
105 | ideal MM = fetch(Scom,N); |
---|
106 | return(MM); |
---|
107 | } |
---|
108 | example |
---|
109 | { "EXAMPLE:"; echo = 2; |
---|
110 | ring w = 0,(x,s),Dp; |
---|
111 | def W=nc_algebra(1,s); // 1st shift algebra |
---|
112 | setring W; |
---|
113 | ideal I1 = s^3-x^2*s; |
---|
114 | print(matrix(bistd(I1))); // compare with twostd: |
---|
115 | print(matrix(twostd(I1))); |
---|
116 | ideal I2 = I1, x*s; |
---|
117 | print(matrix(bistd(I2))); // compare with twostd: |
---|
118 | print(matrix(twostd(I2))); |
---|
119 | } |
---|
120 | |
---|
121 | proc bistd (module M) |
---|
122 | "USAGE: bistd(M); M is (two-sided) ideal/module |
---|
123 | RETURN: ideal or module (same type as the argument) |
---|
124 | PURPOSE: Computes the two-sided Groebner basis of an ideal/module with the help the enveloping algebra of the basering, alternative to twostd() for ideals. |
---|
125 | EXAMPLE: example bistd; shows examples |
---|
126 | " |
---|
127 | { |
---|
128 | // VL: added simplify |
---|
129 | // commented out: Additionally you should use simplify(N,2+4+8) on the output N = bistd(M), where M denotes to the ideal/module in the argument. |
---|
130 | // NOTE: option(redSB), option(redTail) are used by the procedure. |
---|
131 | // intvec optionsave = option(get); |
---|
132 | // option(redSB); |
---|
133 | // option(redTail); |
---|
134 | int ROW = nrows(M); |
---|
135 | def save = basering ; |
---|
136 | def saveenv = envelope(save); |
---|
137 | setring saveenv; |
---|
138 | module M = imap(save, M); |
---|
139 | int i; int n = nvars(save); |
---|
140 | module B; |
---|
141 | for (i=1; i <= n; i++) |
---|
142 | { |
---|
143 | B[i] = var(i) - var(2*n-i+1); |
---|
144 | } |
---|
145 | module K ; int j;int m = 1; |
---|
146 | for (i=1; i <= n; i++) |
---|
147 | { |
---|
148 | for(j=1;j<=ROW;j++) |
---|
149 | { |
---|
150 | K[m]= B[i][1,1]*gen(j);m++; |
---|
151 | } |
---|
152 | } |
---|
153 | M = M+K; |
---|
154 | M = std(M); |
---|
155 | // option(set,optionsave); |
---|
156 | setring save; |
---|
157 | list L = ringlist(save); |
---|
158 | if (size(ringlist(save)) > 4) |
---|
159 | {L = delete(L,6);L = delete(L,5);} |
---|
160 | def Scom = ring(L); |
---|
161 | setring Scom; |
---|
162 | ideal P; |
---|
163 | for (i= 1; i <= n; i++) |
---|
164 | { |
---|
165 | P[i] = var(i) ; |
---|
166 | P[2*n-i+1] = var(i); |
---|
167 | } |
---|
168 | map Pi = saveenv, P; |
---|
169 | module N = Pi(M) ; |
---|
170 | setring save; |
---|
171 | module MM = fetch(Scom,N); |
---|
172 | if (nrows(MM)==1) |
---|
173 | { |
---|
174 | //i.e. MM is an ideal indeed |
---|
175 | ideal @M = ideal(MM); |
---|
176 | kill MM; |
---|
177 | ideal MM = @M; |
---|
178 | } |
---|
179 | MM = simplify(MM,2+4+8); |
---|
180 | return(MM); |
---|
181 | } |
---|
182 | example |
---|
183 | { "EXAMPLE:"; echo = 2; |
---|
184 | ring w = 0,(x,s),Dp; |
---|
185 | def W=nc_algebra(1,s); // 1st shift algebra |
---|
186 | setring W; |
---|
187 | matrix m[3][3]=[s^2,s+1,0],[s+1,0,s^3-x^2*s],[2*s+1, s^3+s^2, s^2]; |
---|
188 | print(m); |
---|
189 | module L = m; module M2 = bistd(L); |
---|
190 | print(M2); |
---|
191 | } |
---|
192 | |
---|
193 | proc enveltrinityIdeal(ideal f) |
---|
194 | " enveltrinity for an ideal directly" |
---|
195 | { |
---|
196 | // AUXILIARY PROCEDURES: Uses Zersubcols(matrix N, int l). |
---|
197 | intvec optionsave = option(get); |
---|
198 | def save = basering ; |
---|
199 | option(redSB); |
---|
200 | int i; int n = nvars(save); |
---|
201 | def saveenv = envelope(save); |
---|
202 | setring saveenv; |
---|
203 | def R = makeModElimRing(saveenv); setring R; |
---|
204 | ideal K; |
---|
205 | for (i=1; i <= n; i++) |
---|
206 | { K[i] = var(i)-var(2*n-i+1);} |
---|
207 | K = std(K); |
---|
208 | ideal f = imap(save, f); |
---|
209 | // now we compute the trinity (GB,Liftmatrix,Syzygy) |
---|
210 | // can do it with f but F=NF(f,kr), so the ideals are the same in R env |
---|
211 | ideal I = f, K; // ideal I = F, K; |
---|
212 | int l = ncols(I); |
---|
213 | int j = ncols(f); |
---|
214 | matrix M[j+1][l]; |
---|
215 | for (i = 1; i<= l;i++) |
---|
216 | { |
---|
217 | M[1,i] = I[i]; |
---|
218 | } |
---|
219 | for (i=1; i <= j;i++) |
---|
220 | { |
---|
221 | M[i+1,i] = 1; |
---|
222 | } |
---|
223 | matrix N = std(M); |
---|
224 | option(set,optionsave); |
---|
225 | int m = ncols(N); |
---|
226 | intvec sypos; |
---|
227 | for (i=1; i <= m; i++) |
---|
228 | { |
---|
229 | if (N[1,i] == 0) |
---|
230 | { |
---|
231 | sypos = sypos,i; |
---|
232 | } |
---|
233 | } |
---|
234 | intvec Nrows = 2..(j+1); |
---|
235 | matrix BS = submat(N,Nrows,sypos); // e.g. for each column (b_1,...,b_j) you get 0 = sum_i (b_i*f_i) |
---|
236 | module BSy = BS; |
---|
237 | setring saveenv; |
---|
238 | ideal K = imap(R,K); |
---|
239 | module BS = imap(R,BSy); |
---|
240 | matrix N = imap(R,N); |
---|
241 | kill R; |
---|
242 | export K; export BS; export N; |
---|
243 | return(saveenv); |
---|
244 | } |
---|
245 | |
---|
246 | static proc Zersubcols(matrix N, int l) |
---|
247 | { |
---|
248 | if (nrows(N) <= l) |
---|
249 | { |
---|
250 | string f = "Inputinteger ist zu gross. Muss kleiner sein als die Anzahl der Zeilen von der Inputmatrix."; return(f); |
---|
251 | } |
---|
252 | else |
---|
253 | { |
---|
254 | matrix O[l][1]; int m = ncols(N); |
---|
255 | matrix H = submat(N,1..l,1..m); |
---|
256 | int i; |
---|
257 | intvec s; |
---|
258 | intvec c; |
---|
259 | for(i=1; i<= m;i++) |
---|
260 | { |
---|
261 | if(H[i] != O[1]) {c = c,i;} |
---|
262 | else {s = s,i;} |
---|
263 | } |
---|
264 | list L = s,c; |
---|
265 | return(L); |
---|
266 | } |
---|
267 | } |
---|
268 | |
---|
269 | proc enveltrinity(module M) |
---|
270 | "USAGE: enveltrinity(M); M is (two-sided) ideal/module |
---|
271 | RETURN: ring, the enveloping algebra of the basering with objects K, N, BS in it. |
---|
272 | PURPOSE: compute two-sided Groebner basis, module of bisyzygies and the bitransformation matrix of M. |
---|
273 | THEORY: Assume R is a G-algebra generated by x_1, \dots x_k. Let psi_s be the epimorphism of left R (X) R^{opp} modules: |
---|
274 | @* psi_s (s (X)_K t) = smt := (s_1 m t_1, ... , s_s m t_s) = (\psi(s_1 (X) t_1) , ... , psi(s_s (X) t_s)) in R^s |
---|
275 | @* additionally we define for a given bimodule M = < f_1, ... , f_r > the matrix M' := [F, I_r], [K, 0] |
---|
276 | @* where I_r refers to the identity matrix in Mat(r,R), K is a matrix which columns are the generators of the kernel of psi_s. |
---|
277 | @* These have the form (x_i-X_i)e_j for j in {1,...,s}, i in {1,...,k}. |
---|
278 | @* The matrix F = (f_1 ... f_r), where the f_i's are the generators of M and 0 is the matrix with only entries that are zero. |
---|
279 | @* Enveltrinity() calculates the kernel K of psi_s and left normal form N of the matrix M' which also yields the bisyzygies of M |
---|
280 | @* and a coefficient matrix as submatrix of N which we need in the procedures bitrinity() and liftenevelope(). |
---|
281 | |
---|
282 | NOTE: In the output, |
---|
283 | @* ideal/module K is the kernel of psi_s above |
---|
284 | @* matrix N is the left Groebner basis of the matrix M' |
---|
285 | @* module BS corresponds to the set of bisyzygies of M. |
---|
286 | @* To get K,N or BS, use @code{def G = enveltrinity(M); setring G; K; N; BS;}. |
---|
287 | EXAMPLE: example enveltrinity; shows examples |
---|
288 | " |
---|
289 | { |
---|
290 | def save = basering ; |
---|
291 | intvec optionsave = option(get); |
---|
292 | option(redSB); |
---|
293 | int ROW = nrows(M); |
---|
294 | int i; int n = nvars(save); |
---|
295 | def saveenv = envelope(save); |
---|
296 | setring saveenv; |
---|
297 | def R = makeModElimRing(saveenv); setring R; |
---|
298 | module B; |
---|
299 | for (i=1; i <= n; i++) |
---|
300 | { B[i] = var(i) - var(2*n-i+1);} |
---|
301 | module K ; int t;int g = 1; |
---|
302 | for (i=1; i <= n; i++) |
---|
303 | { |
---|
304 | for(t=1;t<=ROW;t++) |
---|
305 | { |
---|
306 | K[g]= B[i][1,1]*gen(t);g++; |
---|
307 | } |
---|
308 | } |
---|
309 | K = std(K); |
---|
310 | module M = imap(save,M); |
---|
311 | module I = M,K; |
---|
312 | int l = ncols(I); |
---|
313 | int j = ncols(M); |
---|
314 | |
---|
315 | matrix NN[j+ROW][l]; |
---|
316 | for (t=1; t <= ROW; t++) |
---|
317 | { |
---|
318 | for (i = 1; i<= l;i++) |
---|
319 | { NN[t,i] = I[t,i];} |
---|
320 | } |
---|
321 | for (i=ROW+1; i <= j+ROW;i++) |
---|
322 | { NN[i,i-ROW] = 1;} |
---|
323 | // now we compute the trinity (GB,Liftmatrix,Syzygy) |
---|
324 | // can do it with f but F=NF(f,kr), so the ideals are the same in R env |
---|
325 | matrix N = std(NN); |
---|
326 | option(set,optionsave); |
---|
327 | intvec sypos = Zersubcols(N,ROW)[1]; |
---|
328 | sypos = sypos[2..nrows(sypos)]; |
---|
329 | intvec Nrows = (ROW+1)..(j+ROW); |
---|
330 | matrix BS = submat(N,Nrows,sypos); // e.g. for each column (b_1,...,b_j) you get 0 = sum_i (b_i*f_i) |
---|
331 | module BSy = BS; |
---|
332 | setring saveenv; |
---|
333 | matrix N = imap(R,N); module BS = imap(R,BSy); |
---|
334 | module K = imap(R,K); |
---|
335 | if (nrows(K)==1) |
---|
336 | { |
---|
337 | // i.e. K is an ideal |
---|
338 | ideal @K = ideal(K); |
---|
339 | kill K; |
---|
340 | ideal K = @K; |
---|
341 | } |
---|
342 | kill R; |
---|
343 | export K; |
---|
344 | export BS; |
---|
345 | export N; |
---|
346 | return(saveenv); |
---|
347 | } |
---|
348 | example |
---|
349 | {"EXAMPLE"; echo = 2; |
---|
350 | ring r = 0,(x,s),dp; |
---|
351 | def R = nc_algebra(1,s); setring R; |
---|
352 | poly f = x*s + s^2; |
---|
353 | ideal I = f; |
---|
354 | def G = enveltrinity(I); |
---|
355 | setring G; |
---|
356 | print(matrix(K)); // kernel of psi_s |
---|
357 | print(BS); // module of bisyzygies |
---|
358 | print(N); // bitransformation matrix |
---|
359 | } |
---|
360 | |
---|
361 | proc bitrinityIdeal(ideal f) |
---|
362 | "direct appl of bitrinity to ideal" |
---|
363 | { |
---|
364 | intvec optionsave = option(get); |
---|
365 | option(redSB); |
---|
366 | option(redTail); |
---|
367 | int j = ncols(f); |
---|
368 | def A = enveltrinity(f); |
---|
369 | setring A; // A = envelope(basering) |
---|
370 | int i; |
---|
371 | def R = makeModElimRing(A); setring R; |
---|
372 | ideal K = imap(A,K); K = std(K); |
---|
373 | option(set,optionsave); |
---|
374 | matrix N = imap(A,N); |
---|
375 | int m = ncols(N); |
---|
376 | //decomposition of N: Liftmatrix, Bisyzygymatrix: |
---|
377 | intvec cfpos; |
---|
378 | for (i=1; i <= m; i++) |
---|
379 | { if (N[1,i] != 0) |
---|
380 | {cfpos = cfpos,i;} |
---|
381 | } |
---|
382 | cfpos = cfpos[2..nrows(cfpos)]; |
---|
383 | matrix C = submat(N,1..(j+1),cfpos); |
---|
384 | module Coef; |
---|
385 | for(i=1;i<=ncols(C);i++) |
---|
386 | { |
---|
387 | poly p = NF(C[1,i],K); |
---|
388 | if( (p != 0) && (p == C[1,i])) |
---|
389 | { Coef = Coef,C[i];} |
---|
390 | } |
---|
391 | matrix Co = Coef; |
---|
392 | matrix Coe = submat(Co,1..nrows(Co),2..ncols(Co)); |
---|
393 | module CC = Coe; //e.g. i-th column is (a_i1,...,a_ij) (see top) |
---|
394 | setring A; |
---|
395 | matrix Coeff = imap(R,CC); matrix Bisyz = BS;// e.g. for each column (b_1,...,b_j) you get 0 = sum_i (b_i*f_i) |
---|
396 | kill R; |
---|
397 | list L = Coeff,Bisyz; |
---|
398 | // output is a Coefficient-Matrix Co and a Bisyzygy-Matriy BS such that (g1,...,gk) = (f1,...,fj)*Submat(Coeff,2..nrows(Coeff),1..ncols(Coeff)) and (0,...,0) = (f1,...,fj)*BiSyz |
---|
399 | export L; |
---|
400 | return(A); |
---|
401 | } |
---|
402 | |
---|
403 | proc bitrinity(module M) |
---|
404 | "USAGE: bitrinity(M); M is (two-sided) ideal/module |
---|
405 | RETURN: ring, the enveloping algebra of the basering, with objects in it. |
---|
406 | additionally it exports a list L = Coeff, Bisyz. |
---|
407 | THEORY: |
---|
408 | Let psi_s be the epimorphism of left R (X) R^{opp} modules: |
---|
409 | @* psi_s(s (X)_K t) = smt := (s_1 m t_1, ... , s_s m t_s) = (\psi(s_1 (X) t_1) , \dots , psi(s_s (X) t_s)) in R^s. |
---|
410 | @* Then psi_s(A) := (psi_s(a_{ij})) for every matrix A in Mat(n x m, R)$. |
---|
411 | @* For a two-sided ideal I = < f_1, ... , f_j> with Groebner basis G = {g_1, ... , g_k} in R, Coeff is the Coefficient-Matrix and |
---|
412 | BiSyz a bisyzygy matrix. |
---|
413 | @* Let C be the submatrix of Coeff, where C is Coeff without the first row. Then |
---|
414 | (g_1,...,g_k) = psi_s(C^T * (f_1 ... f_j)^T) and (0,...,0) = psi_s(BiSyz^T * (f_1 ... f_j)^T). |
---|
415 | @* The first row of Coeff (G_1 ... G_n)$ corresponds to the image of the Groebner basis of I: |
---|
416 | psi_s((G_1 ... G_n)) = G = {g_1 ... g_k }. |
---|
417 | @* For a (R,R)-bimodule M with Groebner basis G = {g_1, ... , g_k} in R^r, Coeff is the coefficient matrix and |
---|
418 | BiSyz a bisyzygy matrix. |
---|
419 | @* Let C be the submatrix of Coeff, where C is Coeff without the first r rows. Then |
---|
420 | (g_1 ... g_k) = psi_s(C^T * (f_1 ... f_j)^T) and (0 ... 0) = psi_s(BiSyz^T * (f_1 ... f_j)^T). |
---|
421 | @* The first r rows of Coeff = (G_1 ... G_n) (Here G_i denotes to the i-th column of the first r rows) corresponds to the image of the |
---|
422 | Groebner basis of M: psi_s((G_1 ... G_n)) = G = {g_1 ... g_k}. |
---|
423 | PURPOSE: This procedure returns a coefficient matrix in the enveloping algebra of the basering R, that gives implicitly the two-sided Groebner basis of a (R,R)-bimodule M |
---|
424 | and the coefficients that produce the Groebner basis with the help of the originally used generators of M. Additionally it calculates the bisyzygies of M as left-module of the enveloping algebra of R. |
---|
425 | AUXILIARY PROCEDURES: Uses the procedure enveltrinity(). |
---|
426 | NOTE: To get list L = Coeff, BiSyz, we set: def G = bitrinity(); setring G; L; or $L[1]; L[2];. |
---|
427 | EXAMPLE: example bitrinity; shows examples |
---|
428 | " |
---|
429 | { |
---|
430 | intvec optionsave = option(get); |
---|
431 | option(redSB); |
---|
432 | option(redTail); |
---|
433 | int ROW = nrows(M); int j = ncols(M); |
---|
434 | def A = enveltrinity(M); |
---|
435 | setring A; // A = envelope(basering) |
---|
436 | int i; |
---|
437 | def R = makeModElimRing(A); setring R; |
---|
438 | module K = imap(A,K); K = std(K); |
---|
439 | option(set,optionsave); |
---|
440 | matrix N = imap(A,N); |
---|
441 | int m = ncols(N); |
---|
442 | //decomposition of N: Liftmatrix, Bisyzygymatrix: |
---|
443 | intvec cfpos = Zersubcols(N,ROW)[2]; |
---|
444 | cfpos = cfpos[2..nrows(cfpos)]; |
---|
445 | matrix C1 = submat(N,1..nrows(N),cfpos); |
---|
446 | matrix C2 = submat(N,1..ROW,cfpos); |
---|
447 | module Coef; matrix O[ROW][1]; |
---|
448 | module p; |
---|
449 | for(i=1;i<=ncols(C2);i++) |
---|
450 | { |
---|
451 | p = NF(C2[i],K); |
---|
452 | if( (p[1] != O[1]) && (p[1] == C2[i])) |
---|
453 | { Coef = Coef,C1[i];} |
---|
454 | } |
---|
455 | matrix Co = Coef; |
---|
456 | matrix Coe = submat(Co,1..nrows(Co),2..ncols(Co)); |
---|
457 | module CC = Coe; |
---|
458 | setring A; |
---|
459 | matrix Coeff = imap(R,CC); matrix Bisyz = BS; |
---|
460 | kill R; |
---|
461 | list L = Coeff,Bisyz; |
---|
462 | export L; |
---|
463 | return(A); |
---|
464 | } |
---|
465 | example |
---|
466 | { |
---|
467 | "EXAMPLE:"; echo = 2; |
---|
468 | ring r = 0,(x,s),dp; |
---|
469 | def R = nc_algebra(1,s); setring R; // 1st shift algebra |
---|
470 | poly f = x*s + s^2; // only one generator |
---|
471 | ideal I = f; // note, two sided Groebner basis of I is xs, s^2 |
---|
472 | def G = bitrinity(I); |
---|
473 | setring G; |
---|
474 | print(L[1]); // Coeff |
---|
475 | //the first row shows the Groebnerbasis of I consists of |
---|
476 | // psi_s(SX) = xs , phi(S^2) = s^2: |
---|
477 | // remember phi(a (X) b - c (X) d) = psi_s(a (X) b) - phi(c (X) d) := ab - cd in R. |
---|
478 | // psi_s((-s+S+1)*(x*s + s^2)) = psi_s(-xs2-s3+xsS+xs+s2S) |
---|
479 | // = -xs^2-s^3+xs^2+xs+s^3 = xs |
---|
480 | // psi_s((s-S)*(x*s + s^2)) = psi_s(xs2+s3-xsS-s2S+s2) = s^2 |
---|
481 | print(L[2]); //Bisyzygies |
---|
482 | // e.g. psi_s((x2-2sS+s-X2+2S2+2X+S-1)(x*s + s^2)) |
---|
483 | // = psi_s(x3s+x2s2-2xs2S+xs2-2s3S+s3-xsX2+2xsS2+2xsX+xsS-xs-s2X2+2s2S2+2s2X-s2S) |
---|
484 | // = x^3s+x^2s^2-2xs^3+xs^2-2s^4+s^3-xsx^2+2xs^3+2xsx+xs^2-xs-s^2x^2+2s^4+2s^2x-s^3 |
---|
485 | // = 0 in R |
---|
486 | } |
---|
487 | |
---|
488 | proc liftenvelope(module I,poly g) |
---|
489 | "USAGE: liftenvelope(M,g); M ideal/module, g poly |
---|
490 | RETURN: ring, the enveloping algebra of the basering R. |
---|
491 | Given a two-sided ideal M in R and a polynomial g in R this procedure returns the enveloping algebra of R. |
---|
492 | Additionally it exports a list l = C, B; where B is the left Groebner basis of the left-syzygies of M \otimes 1 and C is a vector of coefficients in the enveloping algebra |
---|
493 | of R such that psi_s(C^T *(f_1 \dots f_n)) = g. |
---|
494 | @* psi_s is an epimorphism of left R (X) R^{opp} modules: |
---|
495 | @* psi_s (s (X)_K t) = smt := (s_1 m t_1, ... , s_s m t_s) = (\psi(s_1 (X) t_1) , \dots , psi(s_s (X) t_s)) in R^s. |
---|
496 | @* Then psi_s(A) := (psi_s(a_{ij})) for every matrix A in Mat(n x m, R)$. |
---|
497 | ASSUME: The second component has to be an element of the first component. |
---|
498 | PURPOSE: This procedure is used for computing total divisors. Let {f_1, ..., f_n} be the generators of the first component and let the second component be called g. Then |
---|
499 | the returned list l = C, B = (b_1, ..., b_n); defines an affine set A = C + sum_i a_i b_i with (a_1,..,a_n) in the enveloping algebra of the basering R such that |
---|
500 | psi_s(a^T * (f_1 ... f_n)) = g for all a in A. For certain rings R, we csn find pure tensors within this set A, |
---|
501 | and if we do, liftenvelope() helps us to decide whether f is a total divisor of g. |
---|
502 | NOTE: To get list l = C, B. we set: def G = liftenvelope(); setring G; l; or l[1]; l[2];. |
---|
503 | EXAMPLE: example liftenvelope; shows examples |
---|
504 | " |
---|
505 | { |
---|
506 | def save = basering; |
---|
507 | int m = ncols(I); |
---|
508 | intvec optionsave = option(get); |
---|
509 | option(redSB); |
---|
510 | option(redTail); |
---|
511 | def A = enveltrinity(I); |
---|
512 | setring A; // A = envelope(basering) |
---|
513 | int i; |
---|
514 | def R = makeModElimRing(A); setring R; |
---|
515 | module N = imap(A,N); N = std(N); |
---|
516 | //intvec Nrows = 2..(j+1); |
---|
517 | module g = imap(save,g); |
---|
518 | matrix G[nrows(N)][1]; |
---|
519 | for (i=2;i<=m;i++) |
---|
520 | { |
---|
521 | G[1,1] = g; |
---|
522 | G[i,1]=0; |
---|
523 | } |
---|
524 | module NFG = (-1)*NF(G,N); |
---|
525 | module C = submat(NFG,2..nrows(N),1); |
---|
526 | |
---|
527 | setring A; |
---|
528 | module C = imap(R,C); |
---|
529 | kill R; |
---|
530 | module B = std(BS); |
---|
531 | option(set,optionsave); |
---|
532 | list l = C,B; // transpose(C)*(f1,...,fn) = g |
---|
533 | export l; |
---|
534 | return(A); |
---|
535 | } |
---|
536 | example |
---|
537 | { "EXAMPLE:"; echo = 2; |
---|
538 | ring r = 0,(x,s),dp; |
---|
539 | def R = nc_algebra(1,s); setring R; |
---|
540 | ideal I = x*s; |
---|
541 | poly p = s*x*s*x; // = (s (x) x) * x*s = (sX) * x*s |
---|
542 | p; |
---|
543 | def J = liftenvelope(I,p); |
---|
544 | setring J; |
---|
545 | print(l[1]); |
---|
546 | //2s+SX = (2s (x) 1) + (1 (x) sx) |
---|
547 | print(l[2]); |
---|
548 | // Groebnerbasis of BiSyz(I) as LeftSyz in R^{env} |
---|
549 | // We get : 2s+SX + ( sX - 2s -SX) = sX - a pure tensor!!!! |
---|
550 | } |
---|
551 | |
---|
552 | static proc twoComp(poly q) |
---|
553 | "USAGE: twoComp(g); g poly |
---|
554 | NOTE: This procedure only works if the basering is an enveloping algebra A^{env} of a (non-commutative) ring A. Thus also the polynomial in the argument has to be in A^{env}. |
---|
555 | RETURN: Returns the second half of the leading exponent of a polynomial p in A^{env}: |
---|
556 | @* lm(p) = c x1^a1 x2^a2 ... xn^an (X) xn^bn * x(n-1)^b(n-1) * ... * x1^b1 |
---|
557 | such that lex(p) = [a1,..,an,bn,...,b1]. Then the procedure returns [bn,...,b1] (of lex(p)!). |
---|
558 | " |
---|
559 | { |
---|
560 | if (q == 0) {return(q);} |
---|
561 | def saveenv = basering; |
---|
562 | int n = nvars(saveenv); int k = n div 2; |
---|
563 | intvec v = leadexp(q); |
---|
564 | intvec w = v[k+1..2*k]; |
---|
565 | return(w); |
---|
566 | } |
---|
567 | |
---|
568 | static proc firstComp(poly q) |
---|
569 | "USAGE: firstComp(g); g poly |
---|
570 | NOTE: This procedure only works if the basering is an enveloping algebra A^{env} of a (non-commutative) ring A. Thus also the polynomial in the argument has to be in A^{env}. |
---|
571 | RETURN: Returns the first half of the leading exponent of a polynomial p in A^{env}: |
---|
572 | @* lm(p) = c x1^a1 x2^a2 ... xn^an (X) xn^bn * x(n-1)^b(n-1) * ... * x1^b1 |
---|
573 | such that lex(p) = [a1,..,an,bn,...,b1]. Then the procedure returns [a1,...,an] (of lex(p)!). |
---|
574 | " |
---|
575 | { |
---|
576 | if (q == 0) {return(q);} |
---|
577 | def saveenv = basering; |
---|
578 | int n = nvars(saveenv); int k = n div 2; |
---|
579 | intvec v = leadexp(q); |
---|
580 | intvec w = v[1..k]; |
---|
581 | return(w); |
---|
582 | } |
---|
583 | |
---|
584 | |
---|
585 | proc CompDecomp(poly p) |
---|
586 | "USAGE: CompDecomp(p); p poly |
---|
587 | NOTE: This procedure only works if the basering is an enveloping algebra A^{env} of a (non-commutative) ring A. Thus also the polynomial in the argument has to be in A^{env}. |
---|
588 | RETURN: Returns an ideal I in A^{env}, where the sum of all terms of the argument with the same right side (of the tensor summands) are stored as a generator of I. |
---|
589 | @* Let b != c, then for p = (a (X) b) + (c (X) b) + (a (X) c) the ideal I := CompDecomp(p) is given by: I[1] = (a (X) b) + (c (X) b); I[2] = a (X) c. |
---|
590 | PURPOSE: By decomposing the polynomial we can easily check whether the given polynomial is a pure tensor. |
---|
591 | EXAMPLE: example CompDecomp; shows examples |
---|
592 | " |
---|
593 | { |
---|
594 | poly s = p; |
---|
595 | ideal Q; |
---|
596 | int j = 0; poly t; poly w; |
---|
597 | while (s!= 0) |
---|
598 | { |
---|
599 | t = lead(s); |
---|
600 | w = s-t; |
---|
601 | s = s-t; |
---|
602 | j++; |
---|
603 | Q[j] = t; |
---|
604 | while(w !=0) |
---|
605 | { |
---|
606 | if (twoComp(w) == twoComp(t)) |
---|
607 | { |
---|
608 | Q[j] = Q[j]+lead(w); |
---|
609 | s = s-lead(w); |
---|
610 | } |
---|
611 | w = w-lead(w); |
---|
612 | } |
---|
613 | } |
---|
614 | return(Q); |
---|
615 | } |
---|
616 | example |
---|
617 | { |
---|
618 | "EXAMPLE:"; echo = 2; |
---|
619 | ring r = 0,(x,s),dp; |
---|
620 | def R = nc_algebra(1,s); setring R; //1st shift algebra |
---|
621 | def Re = envelope(R); setring Re; //basering is now R^{env} = R (X) R^{opp} |
---|
622 | poly f = X*S*x^2+5*x*S*X+S*X; f; |
---|
623 | ideal I = CompDecomp(f); |
---|
624 | print(matrix(I)); // what means that f = (x2+5x+1)*SX + x2*S |
---|
625 | poly p = x*S+X^2*S+2*s+x*X^2*s+5*x*s; p; |
---|
626 | ideal Q = CompDecomp(p); |
---|
627 | print(matrix(Q)); |
---|
628 | } |
---|
629 | |
---|
630 | proc getOneComp(poly p) |
---|
631 | "USAGE: getOneComp(p); p poly |
---|
632 | NOTE: This procedure only works if the basering is an enveloping algebra A^{env} of a (non-commutative) ring A. Thus also the polynomial in the argument has to be in A^{env}. |
---|
633 | ASSUME: The given polynomial has to be of the form sum_i a_i \otimes b = (sum_i a_i) (X) b. |
---|
634 | RETURN: Returns a polynomial in A^{env}, which is the sum of the left-side (of the tensor summands) of all terms of the argument. |
---|
635 | @* Let A be a G-algebra. For a given polynomial p in A^{env} of the form p = sum_i a_i (X) b = (sum_i a_i) (X) b this procedure returns |
---|
636 | g = (\sum_i a_i) (X) 1 written sum_i a_i in A^{env}. |
---|
637 | PURPOSE: This is an auxiliary procedure for isPureTensor(). |
---|
638 | EXAMPLE: example getOneComp; shows examples |
---|
639 | " |
---|
640 | { |
---|
641 | ideal I; |
---|
642 | int i; int m = size(p);poly f; |
---|
643 | if (size(p) == 0) {f = 1; return(f);} |
---|
644 | for(i=1;i<=m;i++) |
---|
645 | { I[i] = leadcoef(p[i])*monomial(firstComp(p[i]));} |
---|
646 | f = sum(I); |
---|
647 | return(f); |
---|
648 | } |
---|
649 | example |
---|
650 | { |
---|
651 | "EXAMPLE:"; echo = 2; |
---|
652 | ring r = 0,(x,s),dp; |
---|
653 | def R = nc_algebra(1,s); setring R; //1st shift algebra |
---|
654 | def Re = envelope(R); setring Re; //basering is now R^{env} = R (X) R^{opp} |
---|
655 | poly f = 5*x*s*S+x^2*S+s*S+3*x*S; // f = (x2+5xs+3x+s)*S |
---|
656 | getOneComp(f); |
---|
657 | } |
---|
658 | |
---|
659 | proc isPureTensor(poly g) |
---|
660 | "USAGE: isPureTensor(g); g poly |
---|
661 | NOTE: This procedure only works if the basering is an enveloping algebra A^{env} of a (non-commutative) ring A. Thus also the polynomial in the argument has to be in A^{env}. |
---|
662 | RETURN: Returns 0 if g is not a pure tensor and if g is a pure tensor then isPureTensor() returns a vector v with v = a*gen(1)+b*gen(2) = (a,b)^T with a (X) b = g. |
---|
663 | PURPOSE: Checks whether a given polynomial in $\A^{env}$ is a pure tensor. This is also an auxiliary procedure for checking total divisibility. |
---|
664 | EXAMPLE: example isPureTensor; shows examples |
---|
665 | " |
---|
666 | { |
---|
667 | ideal I = CompDecomp(g); |
---|
668 | ideal U;int i; int k = ncols(I); |
---|
669 | for (i = 1 ; i <= k; i++) |
---|
670 | { |
---|
671 | U[i] = getOneComp(I[i]); |
---|
672 | } |
---|
673 | poly q = normalize(U[1]); |
---|
674 | for (i=2; i<= k;i++) |
---|
675 | { |
---|
676 | if ( U[i] != leadcoef(U[i])*q) |
---|
677 | { |
---|
678 | return(0); |
---|
679 | } |
---|
680 | } |
---|
681 | def saveenv = basering; |
---|
682 | int n = nvars(saveenv); int l = n div 2; |
---|
683 | ideal P; intvec d = 0:l; |
---|
684 | intvec vv; |
---|
685 | for (i=1;i<=k;i++) |
---|
686 | { |
---|
687 | vv= d,twoComp(I[i]); |
---|
688 | P[i] = leadcoef(U[i])*monomial(vv); |
---|
689 | } |
---|
690 | poly w = sum(P); |
---|
691 | vector v = [q, w]; |
---|
692 | return(v); |
---|
693 | } |
---|
694 | example |
---|
695 | { |
---|
696 | "EXAMPLE:"; echo = 2; |
---|
697 | ring r = 0,(x,s),dp; |
---|
698 | def R = nc_algebra(1,s); setring R; //1st shift algebra |
---|
699 | def Re = envelope(R); setring Re; //basering is now R^{env} = R (X) R^{opp} |
---|
700 | poly p = x*(x*s)*x + s^2*x; p; |
---|
701 | // p is of the form q(X)1, a pure tensor indeed: |
---|
702 | isPureTensor(p); |
---|
703 | // v = transpose( x3s+x2s+xs2+2s2 1 ) i.e. p = x3s+x2s+xs2+2s2 (X) 1 |
---|
704 | poly g = S*X+ x*s*X+ S^2*x; |
---|
705 | g; |
---|
706 | isPureTensor(g); // indeed g is not a pure tensor |
---|
707 | poly d = x*X+s*X+x*S*X+s*S*X;d; |
---|
708 | isPureTensor(d); // d is a pure tensor indeed |
---|
709 | // v = transpose( x+s S*X+X ) i.e. d = x+s (X) s*x+x |
---|
710 | // remember that * denotes to the opposite mulitiplication s*x = xs in R. |
---|
711 | } |
---|
712 | |
---|
713 | proc isTwoSidedGB(ideal I) |
---|
714 | "USAGE: isTwoSidedGB(I); I ideal |
---|
715 | RETURN: Returns 0 if the generators of a given ideal are not two-sided, 1 if they are.\\ |
---|
716 | NOTE: This procedure should only be used for non-commutative rings, as every element is two-sided in a commutative ring. |
---|
717 | PURPOSE: Auxiliary procedure for diagonal forms. Let R be a non-commutative ring (e.g. G-algebra), and p in R, this program checks whether p is two-sided i.e. Rp = pR. |
---|
718 | EXAMPLE: example isTwoSidedGB; shows examples |
---|
719 | " |
---|
720 | { |
---|
721 | int i; int n = nvars(basering); |
---|
722 | ideal J; |
---|
723 | // determine whether I is a left Groebner basis |
---|
724 | if (attrib(I,"isSB") == 1) |
---|
725 | { |
---|
726 | J = I; |
---|
727 | J = simplify(J,1+2+4+8); |
---|
728 | attrib(J,"isSB",1); |
---|
729 | } |
---|
730 | else |
---|
731 | { |
---|
732 | intvec optionsave = option(get); |
---|
733 | option(redSB); |
---|
734 | option(redTail); |
---|
735 | J = std(I); |
---|
736 | J = simplify(J,1+2+4+8); |
---|
737 | attrib(J,"isSB",1); |
---|
738 | I = interred(I); |
---|
739 | I = simplify(I,1+2+4+8); |
---|
740 | if ( size(J) != size(I)) |
---|
741 | { |
---|
742 | option(set,optionsave); |
---|
743 | return(int(0)); |
---|
744 | } |
---|
745 | for(i = 1; i <= size(I); i++) |
---|
746 | { |
---|
747 | if (I[i] != J[i]) |
---|
748 | { |
---|
749 | option(set,optionsave); |
---|
750 | return(int(0)); |
---|
751 | } |
---|
752 | } |
---|
753 | } |
---|
754 | // I = simplify(I,1+2+4+8); |
---|
755 | // now, we check whether J is right complete |
---|
756 | for(i = 1; i <= n; i++) |
---|
757 | { |
---|
758 | if ( simplify( NF(J*var(i),J), 2) != 0 ) |
---|
759 | { |
---|
760 | return(int(0)); |
---|
761 | } |
---|
762 | } |
---|
763 | return(int(1)); |
---|
764 | } |
---|
765 | example |
---|
766 | { |
---|
767 | "EXAMPLE:"; echo = 2; |
---|
768 | ring r = 0,(x,s),dp; |
---|
769 | def R = nc_algebra(1,s); setring R; //1st shift algebra |
---|
770 | ideal I = s^2, x*s, s^2 + 3*x*s; |
---|
771 | isTwoSidedGB(I); // I is two-sided |
---|
772 | ideal J = s^2+x; |
---|
773 | isTwoSidedGB(J); // J is not two-sided; twostd(J) = s,x; |
---|
774 | } |
---|