Artifact 4fcc473289381707a77cf5070b70ce94df4776b928b761409048e14b2a57b086:
- File
r36/xlog/GROEBNER.LOG
— part of check-in
[152fb3bdbb]
at
2011-10-17 17:58:33
on branch master
— svn:eol-style, svn:executable and line endings for files
in historical/r36 treegit-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1480 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: schoepf@users.sourceforge.net, size: 24945) [annotate] [blame] [check-ins using] [more...]
REDUCE 3.6, 15-Jul-95, patched to 6 Mar 96 ... % Examples of use of Groebner code. % In the Examples 1 - 3 the polynomial ring for the ideal operations % (variable sequence, term order mode) is defined globally in advance. % Example 1, Linz 85. torder ({q1,q2,q3,q4,q5,q6},lex)$ groebner {q1, q2**2 + q3**2 + q4**2, q4*q3*q2, q3**2*q2**2 + q4**2*q2**2 + q4**2*q3**2, q6**2 + 1/3*q5**2, q6**3 - q5**2*q6, 2*q2**2*q6 - q3**2*q6 - q4**2*q6 + q3**2*q5 - q4**2*q5, 2*q2**2*q6**2 - q3**2*q6**2 - q4**2*q6**2 - 2*q3**2*q5*q6 + 2*q4**2*q5*q6 - 2/3*q2**2*q5**2 + 1/3*q3**2*q5**2 + 1/3*q4**2*q5**2, - q3**2*q2**2*q6 - q4**2*q2**2*q6 + 2*q4**2*q3**2*q6 - q3**2*q2**2*q5 + q4**2*q2**2*q5, - q3**2*q2**2*q6**2 - q4**2*q2**2*q6**2 + 2*q4**2*q3**2*q6**2 + 2*q3**2*q2**2*q5*q6 - 2*q4**2*q2**2*q5*q6 + 1/3*q3**2*q2**2 *q5**2 + 1/3*q4**2*q2**2*q5**2 - 2/3*q4**2*q3**2*q5**2, - 3*q3**2*q2**4*q5*q6**2 + 3*q4**2*q2**4*q5*q6**2 + 3*q3**4*q2**2*q5*q6**2 - 3*q4**4*q2**2*q5*q6**2 - 3*q4**2*q3**4*q5*q6**2 + 3*q4**4*q3**2*q5*q6**2 + 1/3*q3**2*q2**4*q5**3 - 1/3*q4**2*q2**4*q5**3 - 1/3*q3**4*q2**2*q5**3 + 1/3*q4**4*q2**2*q5**3 + 1/3*q4**2 *q3**4*q5**3 - 1/3*q4**4*q3**2*q5**3}; {q1, 2 2 2 q2 + q3 + q4 , q2*q3*q4, 4 q2*q4 *q6, 3 3 q2*q4 *q5 + 3*q2*q4 *q6, 3 2 q2*q4 *q6 , 4 2 2 4 q3 + q3 *q4 + q4 , 3 3 q3 *q4 + q3*q4 , 2 2 q3 *q4 *q6, 2 2 2 2 q3 *q5 - 3*q3 *q6 - q4 *q5 - 3*q4 *q6, 2 2 2 2 q3 *q6 + q4 *q6 , 4 q3*q4 *q6, 3 q3*q4 *q5, 3 2 q3*q4 *q6 , 5 q4 , 4 4 q4 *q5 + q4 *q6, 4 2 q4 *q6 , 2 2 2 q4 *q5*q6 - q4 *q6 , 2 2 q5 + 3*q6 , 3 q6 } % Example 2. (Little) Trinks problem with 7 polynomials in 6 variables. trinkspolys := {45*p + 35*s - 165*b - 36, 35*p + 40*z + 25*t - 27*s, 15*w + 25*p*s + 30*z - 18*t - 165*b**2, - 9*w + 15*p*t + 20*z*s, w*p + 2*z*t - 11*b**3, 99*w - 11*s*b + 3*b**2, b**2 + 33/50*b + 2673/10000}$ trinksvars := {w,p,z,t,s,b}$ torder(trinksvars,lex)$ groebner trinkspolys; {60000*w + 9500*b + 3969, 1800*p - 3100*b - 1377, 18000*z + 24500*b + 10287, 750*t - 1850*b + 81, 200*s - 500*b - 9, 2 10000*b + 6600*b + 2673} groesolve ws; 3*(4*sqrt(11)*i - 11) {{b=-----------------------, 100 62*sqrt(11)*i + 59 p=--------------------, 300 3*(5*sqrt(11)*i - 13) s=-----------------------, 50 148*sqrt(11)*i - 461 t=----------------------, 500 - 190*sqrt(11)*i - 139 w=-------------------------, 10000 - 490*sqrt(11)*i - 367 z=-------------------------}, 3000 3*( - 4*sqrt(11)*i - 11) {b=--------------------------, 100 - 62*sqrt(11)*i + 59 p=-----------------------, 300 3*( - 5*sqrt(11)*i - 13) s=--------------------------, 50 - 148*sqrt(11)*i - 461 t=-------------------------, 500 190*sqrt(11)*i - 139 w=----------------------, 10000 490*sqrt(11)*i - 367 z=----------------------}} 3000 % Example 3. Hairer, Runge-Kutta 1, 6 polynomials 8 variables. torder({c2,c3,b3,b2,b1,a21,a32,a31},lex); {{w,p,z,t,s,b},lex} groebnerf {c2 - a21, c3 - a31 - a32, b1 + b2 + b3 - 1, b2*c2 + b3*c3 - 1/2, b2*c2**2 + b3*c3**2 - 1/3, b3*a32*c2 - 1/6}; {{c2 - a21, c3 - a32 - a31, b3 + b2 + b1 - 1, 2 2 2 2 2 2 96*b2*b1*a31 - 96*b2*a31 + 96*b2*a31 - 32*b2 - 72*b1 *a32 *a31 - 48*b1 *a32 2 2 2 2 3 2 - 144*b1 *a32*a31 - 144*b1 *a32*a31 - 72*b1 *a31 + 198*b1*a32 *a31 2 2 3 + 60*b1*a32 + 396*b1*a32*a31 + 72*b1*a32*a31 - 144*b1*a32 + 198*b1*a31 2 2 - 108*b1*a31 - 24*b1*a31 - 81*a21*a32*a31 + 54*a21*a32 - 126*a32 *a31 2 2 3 2 - 12*a32 - 252*a32*a31 + 126*a32*a31 + 36*a32 - 126*a31 + 162*a31 - 30*a31 - 12, 2 2 8*b2*a21 - 8*b2*a31 + 6*b1*a32 + 12*b1*a32*a31 + 4*b1*a32 + 6*b1*a31 2 2 - 4*b1*a31 - 9*a21*a32 - 6*a32 - 12*a32*a31 + 8*a32 - 6*a31 + 10*a31 - 2, 2 2 8*b2*a32 + 6*b1*a32 + 12*b1*a32*a31 + 12*b1*a32 + 6*b1*a31 + 4*b1*a31 2 2 - 9*a21*a32 - 6*a32 - 12*a32*a31 - 6*a31 + 2*a31 + 2, 2 2 2 12*b1*a21*a32 - 6*b1*a32 - 12*b1*a32*a31 - 6*b1*a31 - 3*a21*a32 + 6*a32 2 + 12*a32*a31 - 6*a32 + 6*a31 - 6*a31 + 2, 2 2 4*b1*a21*a31 + 2*b1*a32 + 4*b1*a32*a31 + 2*b1*a31 - 3*a21*a32 - 4*a21*a31 2 2 + 2*a21 - 2*a32 - 4*a32*a31 + 4*a32 - 2*a31 + 4*a31 - 2, 3 2 2 3 2 6*b1*a32 + 18*b1*a32 *a31 + 18*b1*a32*a31 + 6*b1*a31 - 9*a21*a32 3 2 2 2 - 9*a21*a32*a31 + 6*a21*a32 - 6*a32 - 18*a32 *a31 + 12*a32 - 18*a32*a31 3 2 + 18*a32*a31 - 6*a32 - 6*a31 + 6*a31 - 2*a31, 2 2 2 3*a21 *a32 - 3*a21*a32 - a21*a31 + a32 + 2*a32*a31 + a31 }} % The examples 4 and 5 use automatic variable extraction. % Example 4. torder gradlex$ g4 := groebner({b + e + f - 1, c + d + 2*e - 3, b + d + 2*f - 1, a - b - c - d - e - f, d*e*a**2 - 1569/31250*b*c**3, c*f - 587/15625*b*d}); 5 g4 := {144534461790680056924571742971580442350868*f 4 - 644899801559202566371326081182412388593750*f 2 - 5642454222593591361522253644740080176968509*e*f 3 + 1026970650200404602876625225711718032483739*f + 60671378319336814425425106786936647125250*e*f 2 + 12135463840178290842421221291430776956948795*f + 82342665293813692270756265387326300721851*e - 6546572608747272255841866021042619274525791*f - 455593441982762135422235490670177670637, 3 4 8282838608877853969*e*f - 2667985333760708531*f 2 3 - 315490964385538173*e*f - 8319462093247392142*f - 25594942638053*e*f 2 + 318993777538462620*f + 33851175608089*e + 34163367871142*f - 8568425233089, 2 2 587*e - 46875*e*f + 15038*f - 587*e + 47462*f, a + 2*e - 4, b + e + f - 1, c + 3*e - f - 3, d - e + f} hilbertpolynomial g4; 8 glexconvert(g4,gvarslast,newvars={e},maxdeg=8); 8 7 {8724935291855297898986*e - 82886885272625330040367*e 6 5 + 304980377204235125220384*e - 524915947547338451201596*e 4 3 + 362375013966993813907616*e + 52719473339686639067952*e 2 - 154986762992209058701440*e + 27347344067139574366944*e + 430203494102932512 } % Example 5. torder({u0,u2,u3,u1},lex)$ groesolve({u0**2 - u0 + 2*u1**2 + 2*u2**2 + 2*u3**2, 2*u0*u1 + 2*u1*u2 + 2*u2*u3 - u1, 2*u0*u2 + u1**2 + 2*u1*u3 - u2, u0 + 2*u1 + 2*u2 + 2*u3 - 1}, {u0,u2,u3,u1}); 1 1 {{u3=---,u0=---,u2=0,u1=0}, 3 3 {u3=0,u0=1,u2=0,u1=0}, {u3 5 4 3 2 - 35588322*u1 + 7102080*u1 + 3462372*u1 - 522672*u1 - 98665*u1 + 11905 =----------------------------------------------------------------------------- 10987 , 5 4 3 2 u0=(85796172*u1 - 47481552*u1 - 10265256*u1 + 4828462*u1 + 414200*u1 - 24707)/164805, 5 4 3 2 u2=(490926744*u1 - 82790424*u1 - 46802952*u1 + 5425849*u1 + 1108070*u1 - 83819)/164805, 6 5 4 3 2 u1=root_of(24948*u1_ - 8424*u1_ - 1908*u1_ + 736*u1_ + 24*u1_ - 18*u1_ + 1,u1_,tag_1)}} % Example 6. (Big) Trinks problem with 6 polynomials in 6 variables. torder(trinksvars,lex)$ btbas := groebner {45*p + 35*s - 165*b - 36, 35*p + 40*z + 25*t - 27*s, 15*w + 25*p*s + 30*z - 18*t - 165*b**2, -9*w + 15*p*t + 20*z*s, w*p + 2*z*t - 11*b**3, 99*w - 11*b*s + 3*b**2}; btbas := {17766149161458472422166115589155691471353640232570952361584640*w 9 + 3032932981764169411024286535087872715152793150994240000000000000*b + 11886822444254795859791802829918904596379497649520730600000000000 8 *b + 7 18842475008351431516615767365088235858572104823839818660000000000*b + 6 18478618789454571665641479626067848900525899492180377333740000000*b 5 + 11752365113063961011548983119538614396423298749092231098450400000*b 4 + 5110161259755495688253057699488605142801193206234091633443430000*b 3 + 1496961750963944475883560598484727796781670457510019079125319720*b 2 + 288690575257721822668492218552623049380964882774348400629792405*b + 36675221781192845731725910375461662443650512572339688148737880*b + 1576363174251807401047861085627012261518448811764870474808048, 1079293561558602199646591522041208256884733644128685355966266880*p + 9 3268477702530974927415861070452491173139572636038856000000000000000*b + 12885633343818230635528913313274512975854362843839764665000000000000 8 *b + 20548731096300848092222002490748474767709483225818633322500000000000 7 *b + 20182049540868333737979937480097593847242554499522522583343500000000 6 *b + 12840592651209104850152262711039251760751322701157046861979660000000 5 *b + 4 5569707184558884260455460870514004047533638259197462099687709750000*b + 1626104523905067336734029117969017435050069455164231436772691393000 3 *b + 2 317837165064133808425156860561547977935248864650364953213370433325*b + 38814916107963233682867824475195786374043607759221055124383464600*b + 1271557117681971715777755868970298734422034654142333039426477936, 79947671226563125899747520151200611621091381046569285627130880*z - 9 207000360174268878618253807286221414267374039050881600000000000000*b - 816930976846005632807581869594187232031930825060787069000000000000 8 *b - 7 1304191848597021137419209873493260430019068809677834324500000000000*b - 1281648951757969533154633755921969360988365079018184794999100000000 6 *b - 5 816111850476984294981540451378918253659030380648143145999676000000*b - 354123157925898223808181474698490366723104830470028121053590350000 4 *b - 3 103524414072393919562685172085266423030522292688870620316927889800*b 2 - 20314259597530323830287024948271996904872237353588201428371308545*b - 2537917907646239051588678539186026277776904294491429226344955896*b - 101754994043218022355542895254001231074817584410141704072917808, 53964678077930109982329576102060412844236682206434267798313344*t - 9 232158787821822686686268803096828213303267879649894080000000000000*b - 914339994087255788035842922803409884324637299732580010200000000000 8 *b - 7 1456553024942306848445635398194494646048613632462079804220000000000*b - 1429773468085320579659912540829309032262384742022357855878580000000 6 *b - 5 908944691139155009098308941935669674404431611232759364790656800000*b - 394123305458525780887811122985868682566594060374758630590008810000 4 *b - 3 114919063563435384108358931167592408356874179358918284670595993240*b 2 - 22376181506466478409426169614162075694852682500804198791108921475*b - 2945714266609139709176973289117451707834537151497408879223183208*b - 127343046946408668687682889109197718306724189305639804298381200, 23984301367968937769924256045360183486327414313970785688139264*s - 9 93385077215170712211881744870071176375416361029681600000000000000*b - 8 368160952680520875300826094664986085024410366966850419000000000000*b - 587106602751452802634914356878527850505985235023389523500000000000 7 *b - 6 576629986881952392513712499431359824206930128557786359524100000000*b - 366874075748831567147207506029692907450037791461629910342276000000 5 *b - 4 159134490987396693155870310586114401358103950262784631419648850000*b 3 - 46460129254430495335257974799114783858573413004692326764934039800*b 2 - 9081061858975251669290196016044227941007110418581855806096298095*b - 1222066452390803097568723620648006189979646603457892421797898376*b - 60999770483681527871286545331521866855137759127008037834271184, 10 9 43808000000000000000*b + 189995300000000000000*b 8 7 + 343169730200000000000*b + 377900184178000000000*b 6 5 + 277427432368460000000*b + 141636786601439800000*b 4 3 + 50921375336016834000*b + 12792266529459977340*b 2 + 2215667232541084905*b + 237653554658069880*b + 8984801833047216} % The above system has dimension zero. Therefore its Hilbert polynomial % is a constant which is the number of zero points (including complex % zeros and multipliticities); hilbertpolynomial ws; 10 % Example of Groebner with numerical postprocessing. on rounded; groesolve(trinkspolys,trinksvars); {{b= - 0.397994974843*i - 0.33, p= - 0.685435790007*i + 0.196666666667, s= - 0.994987437107*i - 0.78, t= - 0.981720937945*i - 0.922, w=0.0630158710168*i - 0.0139, z=0.541715382425*i - 0.122333333333}, {b=0.397994974843*i - 0.33, p=0.685435790007*i + 0.196666666667, s=0.994987437107*i - 0.78, t=0.981720937945*i - 0.922, w= - 0.0630158710168*i - 0.0139, z= - 0.541715382425*i - 0.122333333333}} off rounded; % Additional groebner operators. % Reduce one polynomial wrt the basis of big Trinks. The result 0 % is a proof for the ideal membership of the polynomial. torder(trinksvars,lex)$ preduce(45*p + 35*s - 165*b - 36,btbas); 0 % The following examples show how to work with the distributive % form of polynomials. torder({u0,u1,u2,u3},gradlex)$ gsplit(2*u0*u2 + u1**2 + 2*u1*u3 - u2,{u0,u1,u2,u3}); 2 {2*u0*u2,u1 + 2*u1*u3 - u2} torder(trinksvars,lex)$ gsort trinkspolys; 3 {w*p + 2*z*t - 11*b , 2 99*w - 11*s*b + 3*b , - 9*w + 15*p*t + 20*z*s, 2 15*w + 25*p*s + 30*z - 18*t - 165*b , 35*p + 40*z + 25*t - 27*s, 45*p + 35*s - 165*b - 36, 2 33 2673 b + ----*b + -------} 50 10000 gspoly(first trinkspolys, second trinkspolys); 360*z + 225*t - 488*s + 1155*b + 252 gvars trinkspolys; {w,p,z,t,s,b} % Tagged basis and reduction trace. A tagged basis is a basis where % each polynomial is equated to a linear combination of the input % set. A tagged reduction shows how the result is computed by using % the basis polynomials. % First example for tagged polynomials: show how a polynomial is % represented as linear combination of the basis polynomials. % First I set up an environment for the computation. torder(trinksvars,lex)$ % Then I compute an ordinary Groebner basis. bas := groebner trinkspolys$ % Next I assign a tag to each basis polynomial. taggedbas := for i:= 1:length bas collect mkid(p,i) = part(bas,i); taggedbas := {p1=9500*b + 60000*w + 3969, p2= - 3100*b + 1800*p - 1377, p3=24500*b + 18000*z + 10287, p4= - 1850*b + 750*t + 81, p5= - 500*b + 200*s - 9, 2 p6=10000*b + 6600*b + 2673} % And finally I reduce a (tagged) polynomial wrt the tagged basis. preducet(new=w*p + 2*z*t - 11*b**3,taggedbas); 3 2 857375000000*p*w + 1714750000000*t*z + 2376000000000000*w + 471517200000000*w 2 + 31190862780000*w + 687758524299=992750000*b *p1 - 6270000000*b*p1*w 2 - 414760500*b*p1 + 857375000000*new + 39600000000*p1*w + 5239080000*p1*w + 173282571*p1 % Second example for tagged polynomials: representing a Groebner basis % as a combination of the input polynomials, here in a simple geometric % problem. torder({x,y},lex)$ groebnert {circle=x**2 + y**2 - r**2,line = a*x + b*y}; { - a*x - b*y= - line, 2 2 2 2 2 2 (a + b )*y - a *r =a *circle - a*line*x + b*line*y} % In the third example I enter two polynomials that have no common zero. % Consequently the basis is {1}. The tagged computation gives me a proof % for the inconsistency of the system which is independent of the % Groebner formalism. groebnert {circle1=x**2 + y**2 - 10,circle2=x**2 + y**2 - 2}; - circle1 + circle2 {1=----------------------} 8 % Solve a special elimination task by using a blockwise elimination % order defined by a matrix. The equation set goes back to A.M.H. % Levelt (Nijmegen). The question is whether there is a member in the % ideal which depends only on two variables. Here we select x4 and y1. % The existence of such a polynomial proves that the system has exactly % one degree of freedom. % The first two rows of the term order matrix define the groupwise % elimination. The remaining lines define a secondary local % lexicographical behavior which is needed to construct an admissible % ordering. f1 := y1^2 + z1^2 -1; 2 2 f1 := y1 + z1 - 1 f2 := x2^2 + y2^2 + z2^2 -1; 2 2 2 f2 := x2 + y2 + z2 - 1 f3 := x3^2 + y3^2 + z3^2 -1; 2 2 2 f3 := x3 + y3 + z3 - 1 f4 := x4^2 + z4^2 -1; 2 2 f4 := x4 + z4 - 1 f5 := y1*y2 + z1*z2; f5 := y1*y2 + z1*z2 f6 := x2*x3 + y2*y3 + z2*z3; f6 := x2*x3 + y2*y3 + z2*z3 f7 := x3*x4 + z3*z4; f7 := x3*x4 + z3*z4 f8 := x2 + x3 + x4 + 1; f8 := x2 + x3 + x4 + 1 f9 := y1 + y2 + y3 - 1; f9 := y1 + y2 + y3 - 1 f10:= z1 + z2 + z3 + z4; f10 := z1 + z2 + z3 + z4 eqns := {f1,f2,f3,f4,f5,f6,f7,f8,f9,f10}$ vars := {x2,x3,y2,y3,z1,z2,z3,z4,x4,y1}$ torder(vars,matrix, mat( (1,1,1,1,1,1,1,1,0,0), (0,0,0,0,0,0,0,0,1,1), (1,0,0,0,0,0,0,0,0,0), (0,1,0,0,0,0,0,0,0,0), (0,0,1,0,0,0,0,0,0,0), (0,0,0,1,0,0,0,0,0,0), (0,0,0,0,1,0,0,0,0,0), (0,0,0,0,0,1,0,0,0,0), (0,0,0,0,0,0,1,0,0,0), (0,0,0,0,0,0,0,0,1,0))); {{x,y},lex} first reverse groebner(eqns,vars); 2 2 2 2 x4 *y1 - 2*x4 + 2*x4*y1 - 2*x4 - 2*y1 + 2*y1 % For a faster execution we convert the matrix into a % proper machine code routine. This step can be taken only % if there is access to a compiler. on comp; torder_compile(levelt,mat( (1,1,1,1,1,1,1,1,0,0), (0,0,0,0,0,0,0,0,1,1), (1,0,0,0,0,0,0,0,0,0), (0,1,0,0,0,0,0,0,0,0), (0,0,1,0,0,0,0,0,0,0), (0,0,0,1,0,0,0,0,0,0), (0,0,0,0,1,0,0,0,0,0), (0,0,0,0,0,1,0,0,0,0), (0,0,0,0,0,0,1,0,0,0), (0,0,0,0,0,0,0,0,1,0))); +++ levelt compiled, 304 + 16 bytes levelt torder(vars,levelt)$ first reverse groebner(eqns,vars); 2 2 2 2 x4 *y1 - 2*x4 + 2*x4*y1 - 2*x4 - 2*y1 + 2*y1 % For a homogeneous polynomial set we compute a graded Groebner % basis with grade limits. We use the graded term order with lex % as following order. As the grade vector has no zeros, this ordering % is functionally equivalent to a weighted ordering. torder({x,y,z},graded,{1,1,2},lex); {{x2,x3,y2,y3,z1,z2,z3,z4,x4,y1},levelt} dd_groebner(0,10,{x^10*y + y*z^5, x*y^12 + y*z^6}); 12 6 10 5 {x*y + y*z ,x *y + y*z } dd_groebner(0,50,{x^10*y + y*z^5, x*y^12 + y*z^6}); 7 18 34 5 {x *y*z - y *z , 8 12 23 5 x *y*z + y *z , 9 6 12 5 x *y*z - y *z , 12 6 x*y + y*z , 10 5 x *y + y*z } dd_groebner(0,infinity,{x^10*y + y*z^5, x*y^12 + y*z^6}); 111 5 60 {y *z + y*z , 54 100 5 x*y*z - y *z , 2 48 89 5 x *y*z + y *z , 3 42 78 5 x *y*z - y *z , 4 36 67 5 x *y*z + y *z , 5 30 56 5 x *y*z - y *z , 6 24 45 5 x *y*z + y *z , 7 18 34 5 x *y*z - y *z , 8 12 23 5 x *y*z + y *z , 9 6 12 5 x *y*z - y *z , 12 6 x*y + y*z , 10 5 x *y + y*z } end; (TIME: groebner 12249 13339)