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