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