1% Author H.-G. Graebe | Univ. Leipzig | Version 28.6.1995 2% graebe@informatik.uni-leipzig.de 3 4COMMENT 5 6This is an example session demonstrating and testing the facilities 7offered by the commutative algebra package CALI. 8 9END COMMENT; 10 11algebraic; 12on echo; 13off nat; % To make it easier to compare differing output. 14showtime; 15 16comment 17 18 #################################### 19 ### ### 20 ### Introductory Examples ### 21 ### ### 22 #################################### 23 24end comment; 25 26% Example 1 : Generating ideals of affine and projective points. 27 28 29 vars:={t,x,y,z}; 30 setring(vars,degreeorder vars,revlex); 31 mm:=mat((1,1,1,1),(3,2,3,1),(2,1,3,2)); 32 33 % The ideal with zero set at the point in A^4 with coordinates 34 % equal to the row vectors of mm : 35 36 setideal(m1,affine_points mm); 37 38 % All parameters are as they should be : 39 40 dim m1; 41 degree m1; 42 groebfactor m1; 43 resolve m1$ 44 bettinumbers m1; 45 46 % The ideal with zero set at the point in P^3 with homogeneous 47 % coordinates equal to the row vectors of mm : 48 49 setideal(m2,proj_points mm); 50 51 % All parameters as they should be ? 52 53 dim m2; 54 degree m2; 55 groebfactor m2; 56 57 % It seems to be prime ? 58 59 isprime m2; 60 61 % Not, of course, but it is known to be unmixed. 62 % Hence we can use 63 64 easyprimarydecomposition m2; 65 66% Example 2 : 67% The affine monomial curve with generic point (t^7,t^9,t^10). 68 69 setideal(m,affine_monomial_curve({7,9,10},{x,y,z})); 70 71 % The base ring was changed as side effect : 72 73 getring(); 74 vars:=first getring m; 75 76 % Some advanced commutative algebra : 77 78 % The analytic spread of m. 79 80 analytic_spread m; 81 82 % The Rees ring Rees_R(vars) over R=S/m. 83 84 rees:=blowup(m,vars,{u,v,w}); 85 86 % It is multihomogeneous wrt. the degree vectors, constructed during 87 % blow up. Lets compute weighted Hilbert series : 88 89 setideal(rees,rees)$ 90 weights:=second getring(); 91 weightedhilbertseries(gbasis rees,weights); 92 93 % gr_R(vars), the associated graded ring of the irrelevant ideal 94 % over R. The short way. 95 96 interreduce sub(x=0,y=0,z=0,rees); 97 98 % The long (and more general) way. Gives the result in another 99 % embedding. 100 101 % Restore the base ring, since it was changed by blowup as a side 102 % effect. 103 setring getring m$ 104 assgrad(m,vars,{u,v,w}); 105 106 % Comparing the Rees algebra and the symmetric algebra of M : 107 108 setring getring m$ 109 setideal(rees,blowup({},m,{a,b,c})); 110 111 % Lets test weighted Hilbert series once more : 112 113 weights:=second getring(); 114 weightedhilbertseries(gbasis rees,weights); 115 116 % The symmetric algebra : 117 118 setring getring m$ 119 setideal(sym,sym(m,{a,b,c})); 120 modequalp(rees,sym); 121 122 % Symbolic powers : 123 124 setring getring m$ 125 setideal(m2,idealpower(m,2)); 126 127 % Let's compute a second symbolic power : 128 129 setideal(m3,symbolic_power(m,2)); 130 131 % It is different from the ordinary second power. 132 % Hence m2 has a trivial component. 133 134 modequalp(m2,m3); 135 136 % Test x for non zero divisor property : 137 138 nzdp(x,m2); 139 nzdp(x,m3); 140 141 % Here is the primary decomposition : 142 143 pd:=primarydecomposition m2; 144 145 % Compare the result with m2 : 146 147 setideal(m4,matintersect(first first pd, first second pd)); 148 modequalp(m2,m4); 149 150 % Compare the result with m3 : 151 152 setideal(m4,first first pd)$ 153 modequalp(m3,m4); 154 155 % The trivial component can also be removed with a stable 156 % quotient computation : 157 158 setideal(m5,matstabquot(m2,vars))$ 159 modequalp(m3,m5); 160 161 162% Example 3 : The Macaulay curve. 163 164 setideal(m,proj_monomial_curve({0,1,3,4},{w,x,y,z})); 165 vars:=first getring(); 166 gbasis m; 167 168 % Test whether m is prime : 169 170 isprime m; 171 172 % A resolution of m : 173 174 resolve m; 175 176 % m has depth = 1 as can be seen from the 177 178 gradedbettinumbers m; 179 180 % Another way to see the non perfectness of m : 181 182 hilbertseries m; 183 184 % Just a third approach. Divide out a parameter system : 185 186 ps:=for i:=1:2 collect random_linear_form(vars,1000); 187 setideal(m1,matsum(m,ps))$ 188 189 % dim should be zero and degree > degree m = 4. 190 % A Gbasis for m1 is computed automatically. 191 192 dim m1; 193 degree m1; 194 195 % The projections of m on the coord. hyperplanes. 196 197 for each x in vars collect eliminate(m,{x}); 198 199% Example 4 : Two submodules of S^4. 200 201 % Get the stored result of the earlier computation. 202 203 r:=resolve m$ 204 205 % See whether cali!=degrees contains a relict from earlier 206 % computations. 207 208 getdegrees(); 209 210 % Introduce the 2nd and 3rd syzygy module as new modules. 211 % Both are submodules in S^4. 212 213 setmodule(m1,second r)$ setmodule(m2,third r)$ 214 215 % The second is already a gbasis. 216 217 setgbasis m2; 218 getleadterms m1; getleadterms m2; 219 220 % Since rk(F/M)=rk(F/in(M)), they have ranks 1 resp. 3. 221 222 dim m1; 223 indepvarsets m1; 224 225 % Its intersection is zero : 226 227 matintersect(m1,m2); 228 229 % Its sum : 230 231 setmodule(m3,matsum(m1,m2)); 232 dim m3; 233 234 % Hence it has a nontrivial annihilator : 235 236 annihilator m3; 237 238 % One can compute isolated primes and primary decomposition also for 239 % modules. Let's do it, although being trivial here: 240 241 isolatedprimes m3; 242 243 primarydecomposition m3; 244 245 % To get a meaningful Hilbert series make m1 homogeneous : 246 247 setdegrees {1,x,x,x}; 248 249 % Reevaluate m1 with the new column degrees. 250 251 setmodule(m1,m1)$ 252 hilbertseries m1; 253 254% Example 5 : From the MACAULAY manual (D.Bayer, M.Stillman). 255% An elliptic curve on the Veronese in P^5. 256 257 rvars:={x,y,z}$ svars:={a,b,c,d,e,f}$ 258 r:=setring(rvars,degreeorder rvars,revlex)$ 259 s:=setring(svars,{for each x in svars collect 2},revlex)$ 260 map:={s,r,{a=x^2,b=x*y,c=x*z,d=y^2,e=y*z,f=z^2}}; 261 preimage({y^2z-x^3-x*z^2},map); 262 263% Example 6 : The preimage under a rational map. 264 265 r:=setring({x,y},{},lex)$ s:=setring({t},{},lex)$ 266 map:={r,s,{x=2t/(t^2+1),y=(t^2-1)/(t^2+1)}}; 267 268 % The preimage of (0) is the equation of the circle : 269 270 ratpreimage({},map); 271 272 % The preimage of the point (t=3/2) : 273 274 ratpreimage({2t-3},map); 275 276 277% Example 7 : A zerodimensional ideal. 278 279 setring({x,y,z},{},lex)$ 280 setideal(n,{x**2 + y + z - 3,x + y**2 + z - 3,x + y + z**2 - 3}); 281 282 % The groebner algorithm with factorization : 283 284 groebfactor n; 285 286 % Change the term order and reevaluate n : 287 288 setring({x,y,z},{{1,1,1}},revlex)$ 289 setideal(n,n); 290 291 % its primes : 292 293 zeroprimes n; 294 295 % a vector space basis of S/n : 296 297 getkbase n; 298 299% Example 8 : A modular computation. Since REDUCE has no multivariate 300% factorizer, factorprimes has to be turned off ! 301 302 on modular$ off factorprimes$ 303 setmod 181; setideal(n1,n); zeroprimes n1; 304 setmod 7; setideal(n1,n); zeroprimes n1; 305 306 % Hence some of the primes glue together mod 7. 307 308 zeroprimarydecomposition n1; 309 off modular$ on factorprimes$ 310 311% Example 9 : Independent sets once more. 312 313 n:=10$ 314 vars:=for i:=1:(2*n) collect mkid(x,i)$ 315 setring(vars,{},lex)$ 316 setideal(m,for j:=0:n collect 317 for i:=(j+1):(j+n) product mkid(x,i)); 318 setgbasis m$ 319 indepvarsets m; 320 dim m; 321 degree m; 322 323 324comment 325 326 #################################### 327 ### ### 328 ### Local Standard Bases ### 329 ### ### 330 #################################### 331 332end comment; 333 334 335% Example 10 : An example from [ Alonso, Mora, Raimondo ] 336 337 vars := {z,x,y}$ 338 r:=setring(vars,{},lex)$ 339 setideal(m,{x^3+(x^2-y^2)*z+z^4,y^3+(x^2-y^2)*z-z^4}); 340 dim m; 341 degree m; 342 343 % 2 = codim m is the codimension of the curve m. The defining 344 % equations of the singular locus with their nilpotent structure : 345 346 singular_locus(m,2); 347 groebfactor ws; 348 349 % Hence this curve has two singular points : 350 % (x=y=z=0) and (y=-x=256/81,z=64/27) 351 % Let's find the brances of the curve through the origin. 352 % The first critical tropism is (-1,-1,-1). 353 354 off noetherian$ 355 setring(vars,{{-1,-1,-1}},lex)$ 356 setideal(m,m); 357 % Let's first test two different approaches, not fully 358 % integrated into the algebraic interface : 359 setideal(m1,homstbasis m); 360 setideal(m2,lazystbasis m); 361 setgbasis m1$ setgbasis m2$ 362 modequalp(m1,m2); 363 gbasis m; 364 modequalp(m,m1); 365 dim m; 366 degree m; 367 368 % Find the tangent directions not in z-direction : 369 370 tangentcone m; 371 setideal(n,sub(z=1,ws)); 372 setring r$ on noetherian$ setideal(n,n)$ 373 degree n; 374 375 % The points of n outside the origin. 376 377 matstabquot(n,{x,y}); 378 379 % Hence there are two branches x=z'*(a-3+x'),y=z'*(a+y'),z=z' 380 % with the algebraic number a : a^2-3a+3=0 381 % and the new equations for (z',x',y') : 382 383 setrules {a^2=>3a-3}; 384 sub(x=z*(a-3+x),y=z*(a+y),m); 385 setideal(m1,matqquot(ws,z)); 386 387 % This defines a loc. smooth system at the origin, since the 388 % jacobian at the origin of the gbasis is nonsingular : 389 390 off noetherian$ 391 setring getring m; 392 setideal(m1,m1); 393 gbasis m1; 394 395 % clear the rules previously set. 396 397 setrules {}; 398 399 400% Example 11 : The standard basis of another example. 401 402 % Comparing different approaches. 403 404 vars:={x,y}$ 405 setring(vars,localorder vars,lex); 406 ff:=x^5+y^11+(x+x^3)*y^9; 407 setideal(p1,mat2list matjac({ff},vars)); 408 gbasis p1; 409 410 gbtestversion 2$ 411 setideal(p2,p1); 412 gbasis p2; 413 414 gbtestversion 3$ 415 setideal(p3,p1); 416 gbasis p3; 417 418 gbtestversion 1$ 419 modequalp(p1,p2); 420 modequalp(p1,p3); 421 dim p1; 422 degree p1; 423 424% Example 12 : A local intersection wrt. a non inflimited term order. 425 426 setring({x,y,z},{},revlex); 427 m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2}); 428 429 % Delete polynomial units post factum : 430 431 deleteunits ws; 432 433 % Detecting polynomial units early : 434 435 on detectunits; 436 m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2}); 437 off detectunits; 438 439 440comment 441 442 #################################### 443 ### ### 444 ### More Advanced Computations ### 445 ### ### 446 #################################### 447 448end comment; 449 450 % Return to a noetherian term order: 451 452 vars:={x,y,z}$ 453 setring(vars,degreeorder vars,revlex); 454 on noetherian; 455 456% Example 13 : Use of "mod". 457 458 % Polynomials modulo ideals : 459 460 setideal(m,{2x^2+y+5,3y^2+z+7,7z^2+x+1}); 461 x^2*y^2*z^2 mod m; 462 463 % Lists of polynomials modulo ideals : 464 465 {x^3,y^3,z^3} mod gbasis m; 466 467 % Matrices modulo modules : 468 469 mm:=mat((x^4,y^4,z^4)); 470 mm1:=tp<< ideal2mat m>>; 471 mm mod mm1; 472 473% Example 14 : Powersums through elementary symmetric functions. 474 475 vars:={a,b,c,d,e1,e2,e3,e4}$ 476 setring(vars,{},lex)$ 477 m:=interreduce {a+b+c+d-e1, 478 a*b+a*c+a*d+b*c+b*d+c*d-e2, 479 a*b*c+a*b*d+a*c*d+b*c*d-e3, 480 a*b*c*d-e4}; 481 482 for n:=1:5 collect a^n+b^n+c^n+d^n mod m; 483 484% Example 15 : The setrules mechanism. 485 486 setring({x,y,z},{},lex)$ 487 setrules {aa^3=>aa+1}; 488 setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa}); 489 gbasis m; 490 491 % Clear the rules previously set. 492 493 setrules {}; 494 495% Example 16 : The same example with advanced coefficient domains. 496 497 load_package arnum; 498 defpoly aa^3-aa-1; 499 setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa}); 500 gbasis m; 501 502 % The following needs some more time since factorization of 503 % arnum's is not so easy : 504 505 groebfactor m; 506 off arnum; 507 off rational; 508 509 510comment 511 512 #################################### 513 ### ### 514 ### Using Advanced Scripts in ### 515 ### a Complex Example ### 516 ### ### 517 #################################### 518 519end comment; 520 521 522% Example 17 : The square of the 2-minors of a symmetric 3x3-matrix. 523 524 vars:=for i:=1:6 collect mkid(x,i); 525 setring(vars,degreeorder vars,revlex); 526 527 % Generating the ideal : 528 529 mm:=mat((x1,x2,x3),(x2,x4,x5),(x3,x5,x6)); 530 m:=ideal_of_minors(mm,2); 531 setideal(n,idealpower(m,2)); 532 533 % The ideal itself : 534 535 gbasis n; 536 length n; 537 dim n; 538 degree n; 539 540 % Its radical. 541 542 radical n; 543 544 % Its unmixed radical. 545 546 unmixedradical n; 547 548 % Its equidimensional hull : 549 550 n1:=eqhull n; 551 length n1; 552 setideal(n1,n1)$ 553 submodulep(n,n1); 554 submodulep(n1,n); 555 556 % Hence there is an embedded component. Let's find it making 557 % an excursion to symbolic mode. Of course, this can be done 558 % also algebraically. 559 560 symbolic; 561 n:=get('n,'basis); 562 563 % This needs even more time than the eqhull, of course. 564 565 u:=primarydecomposition!* n; 566 for each x in u collect easydim!* cadr x; 567 for each x in u collect degree!* car x; 568 569 % Hence the embedded component is a trivial one. Let's divide 570 % it out by a stable ideal quotient calculation : 571 572 algebraic; 573 setideal(n2,matstabquot(n,vars)); 574 modequalp(n1,n2); 575 576 577comment 578 579 ######################################## 580 ### ### 581 ### Test Examples for New Features ### 582 ### ### 583 ######################################## 584 585end comment; 586 587 588% ==> Testing the different zerodimensional solver 589 590 vars:={x,y,z}$ 591 setring(vars,degreeorder vars,revlex); 592 setideal(m,{x^3+y+z-3,y^3+x+z-3,z^3+x+y-3}); 593 zerosolve1 m; 594 zerosolve2 m; 595 setring(vars,{},lex)$ setideal(m,m)$ m1:=gbasis m$ 596 zerosolve m1; 597 zerosolve1 m1; 598 zerosolve2 m1; 599 600% ==> Testing groebfactor, extendedgroebfactor, extendedgroebfactor1 601 602 % Gerdt et al. : Seventh order KdV type equation. 603 604A1:=-2*L1**2+L1*L2+2*L1*L3-L2**2-7*L5+21*L6$ 605A2:=7*L7-2*L1*L4+3/7*L1**3$ 606B1:=L1*(5*L1-3*L2+L3)$ 607B2:=L1*(2*L6-4*L4)$ 608B3:=L1*L7/2$ 609P1:=L1*(L4-L5/2+L6)$ 610P2:=(2/7*L1**2-L4)*(-10*L1+5*L2-L3)$ 611P3:=(2/7*L1**2-L4)*(3*L4-L5+L6)$ 612P4:=A1*(-3*L1+2*L2)+21*A2$ 613P5:=A1*(2*L4-2*L5)+A2*(-45*L1+15*L2-3*L3)$ 614P6:=2*A1*L7+A2*(12*L4-3*L5+2*L6)$ 615P7:=B1*(2*L2-L1)+7*B2$ 616P8:=B1*L3+7*B2$ 617P9:=B1*(-2*L4-2*L5)+B2*(2*L2-8*L1)+84*B3$ 618P10:=B1*(8/3*L5+6*L6)+B2*(11*L1-17/3*L2+5/3*L3)-168*B3$ 619P11:=15*B1*L7+B2*(5*L4-2*L5)+B3*(-120*L1+30*L2-6*L3)$ 620P12:=-3*B1*L7+B2*(-L4/2+L5/4-L6/2)+B3*(24*L1-6*L2)$ 621P13:=3*B2*L7+B3*(40*L4-8*L5+4*L6)$ 622 623polys:={P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13}; 624vars:={L7,L6,L5,L4,L3,L2,L1}; 625clear a1,a2,b1,b2,b3$ 626 627 off lexefgb; 628 setring(vars,{},lex); 629 630 % The factorized Groebner algorithm. 631 groebfactor polys; 632 633 % The extended Groebner factorizer, producing triangular sets. 634 extendedgroebfactor polys; 635 636 % The extended Groebner factorizer with subproblem removal check. 637 extendedgroebfactor1 polys; 638 639 % Gonnet's example (ACM SIGSAM Bulletin 17 (1983), 48 - 49) 640 641vars:={a0,a2,a3,a4,a5,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5}; 642polys:={a4*b4, 643a5*b1+b5+a4*b3+a3*b4, 644a2*b2,a5*b5, 645(a0+1+a4)*b2+a2*(b0+b1+b4)+c2, 646(a0+1+a4)*(b0+b1+b4)+(a3+a5)*b2+a2*(b3+b5)+c0+c1+c4, 647(a3+a5)*(b0+b1+b4)+(b3+b5)*(a0+1+a4)+c3+c5-1, 648(a3+a5)*(b3+b5), 649a5*(b3+b5)+b5*(a3+a5), 650b5*(a0+1+2*a4)+a5*(b0+b1+2*b4)+a3*b4+a4*b3+c5, 651a4*(b0+b1+2*b4)+a2*b5+a5*b2+(a0+1)*b4+c4, 652a2*b4+a4*b2, 653a4*b5+a5*b4, 6542*a3*b3+a3*b5+a5*b3, 655c3+b3*(a0+2+a4)+a3*(b0+2*b1+b4)+b5+a5*b1, 656c1+(a0+2+a4)*b1+a2*b3+a3*b2+(b0+b4), 657a2*b1+b2, 658a5*b3+a3*b5, 659b4+a4*b1}; 660 661 on lexefgb; % Switching back to the default. 662 setring(vars,{},lex); 663 groebfactor polys; 664 extendedgroebfactor polys; 665 extendedgroebfactor1 polys; 666 667 % Schwarz' example s5 668 669vars:=for k:=1:5 collect mkid(x,k); 670 671s5:={ 672x1**2+x1+2*x2*x5+2*x3*x4, 6732*x1*x2+x2+2*x3*x5+x4**2, 6742*x1*x3+x2**2+x3+2*x4*x5, 6752*x1*x4+2*x2*x3+x4+x5**2, 6762*x1*x5+2*x2*x4+x3**2+x5}; 677 678 setring(vars,degreeorder vars,revlex); 679 m:=groebfactor s5; 680 681 % Recompute a list of problems with listgroebfactor for another term 682 % order. 683 setring(vars,{},lex); 684 listgroebfactor m; 685 686 687% ==> Testing the linear algebra package 688 689 % Find the ideal of points in affine and projective space. 690 691 vars:=for k:=1:6 collect mkid(x,k); 692 setring(vars,degreeorder vars,revlex); 693 matrix mm(10,6); 694 on rounded; 695 for k:=1:6 do for l:=1:10 do mm(l,k):=floor(exp((k+l)/4)); 696 off rounded; 697 mm; 698 setideal(u,affine_points mm); setgbasis u$ dim u; degree u; 699 setideal(u,proj_points mm); setgbasis u$ dim u; degree u; 700 701 % Change the term order to pure lex in dimension zero. 702 % Test both approaches, with and without precomputed borderbasis. 703 704 vars:=for k:=1:6 collect mkid(x,k); 705 r1:=setring(vars,{},lex); 706 r2:=setring(vars,degreeorder vars,revlex); 707 setideal(m,{x1**2+x1+2*x2*x6+2*x3*x5+x4**2, 708 2*x1*x2+x2+2*x3*x6+2*x4*x5, 709 2*x1*x3+x2**2+x3+2*x4*x6+x5**2, 710 2*x1*x4+2*x2*x3+x4+2*x5*x6, 711 2*x1*x5+2*x2*x4+x3**2+x5+x6**2, 712 2*x1*x6+2*x2*x5+2*x3*x4+x6}); 713 gbasis m; 714 m1:=change_termorder(m,r1); 715 setring r2$ m2:=change_termorder1(m,r1); 716 setideal(m1,m1)$ setideal(m2,m2)$ 717 setgbasis m1$ setgbasis m2$ modequalp(m1,m2); 718 719% ==> Different hilbert series driver 720 721 setideal(m,proj_monomial_curve(w1:={0,2,5,9},{w,x,y,z})); 722 weights:={{1,1,1,1},w1}; 723 hftestversion 2; 724 f1:=weightedhilbertseries(gbasis m,weights); 725 sub(x=1,ws); % The ordinary Hilbert series. 726 hftestversion 1; % The default. 727 f2:=weightedhilbertseries(gbasis m,weights); 728 sub(x=1,ws); 729 f1-f2; 730 731% ==> Different primary decomposition approaches. The example is due 732 % to Shimoyama Takeshi. CALI 2.2. produced auxiliary embedded 733 % primes on it. 734 735 vars:={dx,dy,x,y}; 736 setring(vars,degreeorder vars,revlex); 737 f3:={DY*( - X*DX + Y**2*DY - Y*DY),DX*(X**2*DX - X*DX - Y*DY)}$ 738 primarydecomposition f3; 739 740showtime; 741 742end; 743