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
11
12algebraic;
13
14
15on echo;
16
17
18off nat;
19
20 % To make it easier to compare differing output.
21showtime;
22
23
24
25
26comment
27
28	####################################
29	###				 ###
30	###	Introductory Examples    ###
31	###				 ###
32	####################################
33
34end comment;
35
36
37% Example 1 : Generating ideals of affine and projective points.
38
39
40    vars:={t,x,y,z};
41
42
43vars := {t,x,y,z}$
44
45    setring(vars,degreeorder vars,revlex);
46
47
48{{t,x,y,z},{{1,1,1,1}},revlex,{1,1,1,1}}$
49
50    mm:=mat((1,1,1,1),(3,2,3,1),(2,1,3,2));
51
52
53mm := mat((1,1,1,1),(3,2,3,1),(2,1,3,2))$
54
55
56  % The ideal with zero set at the point in A^4 with coordinates
57  % equal to the row vectors of mm :
58
59    setideal(m1,affine_points mm);
60
61
62{y**2 - 4*y + 3,
63z**2 - 3*z + 2,
64y*z - y - 3*z + 3,
65t - y + z - 1,
662*x - y + 2*z - 3}$
67
68
69	% All parameters are as they should be :
70
71    dim m1;
72
73
740$
75
76    degree m1;
77
78
793$
80
81    groebfactor m1;
82
83
84{{y - 3,z - 2,t - 2,x - 1},
85{y - 3,z - 1,t - 3,x - 2},
86{z - 1,y - 1,t - 1,x - 1}}$
87
88    resolve m1$
89
90
91    bettinumbers m1;
92
93
94{1,5,9,7,2}$
95
96
97  % The ideal with zero set at the point in P^3 with homogeneous
98  % coordinates equal to the row vectors of mm :
99
100    setideal(m2,proj_points mm);
101
102
103{2*x**2 - 4*x*z - y*z + 3*z**2,
1042*y**2 - 2*x*z - 7*y*z + 7*z**2,
1053*t - 2*x - 2*y + z,
1062*x*y - 4*x*z - 3*y*z + 5*z**2}$
107
108
109	% All parameters as they should be ?
110
111    dim m2;
112
113
1141$
115
116    degree m2;
117
118
1193$
120
121    groebfactor m2;
122
123
124{{2*x**2 - 4*x*z - y*z + 3*z**2,
1252*y**2 - 2*x*z - 7*y*z + 7*z**2,
1263*t - 2*x - 2*y + z,
1272*x*y - 4*x*z - 3*y*z + 5*z**2}}$
128
129
130	% It seems to be prime ?
131
132    isprime m2;
133
134
135no$
136
137
138	% Not, of course, but it is known to be unmixed.
139	% Hence we can use
140
141    easyprimarydecomposition m2;
142
143
144{{{x - 2*z,y - 3*z,t - 3*z},
145{y - 3*z,x - 2*z,t - 3*z}},
146{{x - z,y - z,t - z},
147{y - z,x - z,t - z}},
148{{2*x - z,2*y - 3*z,t - z},
149{2*y - 3*z,2*x - z,t - z}}}$
150
151
152% Example 2 :
153% The affine monomial curve with generic point (t^7,t^9,t^10).
154
155    setideal(m,affine_monomial_curve({7,9,10},{x,y,z}));
156
157
158{x**3*y - z**3,
159x**4 - y**2*z,
160y**3 - x*z**2}$
161
162
163	% The base ring was changed as side effect :
164
165    getring();
166
167
168{{x,y,z},{{7,9,10}},revlex,{7,9,10}}$
169
170    vars:=first getring m;
171
172
173vars := {x,y,z}$
174
175
176  % Some advanced commutative algebra :
177
178  % The analytic spread of m.
179
180    analytic_spread m;
181
182
1833$
184
185
186  % The Rees ring Rees_R(vars) over R=S/m.
187
188    rees:=blowup(m,vars,{u,v,w});
189
190
191rees := {u**2*v*x - w**3,
192u*v*x**2 - w**2*z,
193v*x**3 - w*z**2,
194u**3*x - v**2*w,
195u**2*x**2 - v*w*y,
196u*x**3 - w*y**2,
197 - u*w**2 + v**3,
198v**2*y - w**2*x,
199v*y**2 - w*x*z,
200v*z - w*y,
201u*z - w*x,
202u*y - v*x,
203x**3*y - z**3,
204x**4 - y**2*z,
205 - x*z**2 + y**3}$
206
207
208  % It is multihomogeneous wrt. the degree vectors, constructed during
209  % blow up. Lets compute weighted Hilbert series :
210
211    setideal(rees,rees)$
212
213
214    weights:=second getring();
215
216
217weights := {{0,0,0,7,9,10},{7,9,10,0,0,0}}$
218
219    weightedhilbertseries(gbasis rees,weights);
220
221
222( - x**29*y + x**29 - x**20*y + x**20 - x**19*y**11 + x**19*y**10 - x**19*y + x
223**19 - x**18*y + x**18 - x**10*y**11 + x**10*y**10 - x**10*y + x**10 - x**9*y**
22421 + x**9*y**20 - x**9*y**11 + x**9*y**9 - x**9*y + x**9 + y**23 - y**22 + y**16
225 - y**15 + y**14 - y**11 + y**9 - y**8 + y**7 - y + 1)/(x**7*y - x**7 - y + 1)$
226
227
228  % gr_R(vars), the associated graded ring of the irrelevant ideal
229  % over R. The short way.
230
231    interreduce sub(x=0,y=0,z=0,rees);
232
233
234{w**3,v**2*w, - u*w**2 + v**3}$
235
236
237  % The long (and more general) way. Gives the result in another
238  % embedding.
239
240    % Restore the base ring, since it was changed by blowup as a side
241    % effect.
242    setring getring m$
243
244
245    assgrad(m,vars,{u,v,w});
246
247
248{x,
249y,
250z,
251w**3,
252v**2*w,
253 - u*w**2 + v**3}$
254
255
256  % Comparing the Rees algebra and the symmetric algebra of M :
257
258    setring getring m$
259
260
261    setideal(rees,blowup({},m,{a,b,c}));
262
263
264{ - y**2*a + z**2*b + x**3*c,
265x*a - y*b - z*c,
266 - y**2*a**2 + z**2*a*b + x**2*y*b*c + x**2*z*c**2,
267 - y**2*a**3 + z**2*a**2*b + x*y**2*b**2*c + 2*x*y*z*b*c**2 + x*z**2*c**3,
268 - y**2*a**4 + z**2*a**3*b + y**3*b**3*c + 3*y**2*z*b**2*c**2 + 3*y*z**2*b*c**3
269+ z**3*c**4}$
270
271
272	% Lets test weighted Hilbert series once more :
273
274    weights:=second getring();
275
276
277weights := {{0,0,0,30,28,27},{7,9,10,0,0,0}}$
278
279    weightedhilbertseries(gbasis rees,weights);
280
281
282(x**58*y**27 + x**30*y**25 - x**30*y**18 - x**30*y**7 - x**28*y**27 + 1)/(x**85*
283y**26 - x**85*y**19 - x**85*y**17 - x**85*y**16 + x**85*y**10 + x**85*y**9 + x**
28485*y**7 - x**85 - x**58*y**26 + x**58*y**19 + x**58*y**17 + x**58*y**16 - x**58*
285y**10 - x**58*y**9 - x**58*y**7 + x**58 - x**57*y**26 + x**57*y**19 + x**57*y**
28617 + x**57*y**16 - x**57*y**10 - x**57*y**9 - x**57*y**7 + x**57 - x**55*y**26 +
287 x**55*y**19 + x**55*y**17 + x**55*y**16 - x**55*y**10 - x**55*y**9 - x**55*y**7
288 + x**55 + x**30*y**26 - x**30*y**19 - x**30*y**17 - x**30*y**16 + x**30*y**10 +
289 x**30*y**9 + x**30*y**7 - x**30 + x**28*y**26 - x**28*y**19 - x**28*y**17 - x**
29028*y**16 + x**28*y**10 + x**28*y**9 + x**28*y**7 - x**28 + x**27*y**26 - x**27*y
291**19 - x**27*y**17 - x**27*y**16 + x**27*y**10 + x**27*y**9 + x**27*y**7 - x**27
292 - y**26 + y**19 + y**17 + y**16 - y**10 - y**9 - y**7 + 1)$
293
294
295	% The symmetric algebra :
296
297    setring getring m$
298
299
300    setideal(sym,sym(m,{a,b,c}));
301
302
303{y**2*a - z**2*b - x**3*c,
304x*a - y*b - z*c}$
305
306    modequalp(rees,sym);
307
308
309yes$
310
311
312  % Symbolic powers :
313
314    setring getring m$
315
316
317    setideal(m2,idealpower(m,2));
318
319
320{x**6*y**2 - 2*x**3*y*z**3 + z**6,
321x**8 - 2*x**4*y**2*z + y**4*z**2,
322y**6 - 2*x*y**3*z**2 + x**2*z**4,
323x**7*y - x**3*y**3*z - x**4*z**3 + y**2*z**4,
324x**3*y**4 - x**4*y*z**2 - y**3*z**3 + x*z**5,
325x**4*y**3 - y**5*z - x**5*z**2 + x*y**2*z**3}$
326
327
328	% Let's compute a second symbolic power :
329
330    setideal(m3,symbolic_power(m,2));
331
332
333{x**6*y**2 - 2*x**3*y*z**3 + z**6,
334x**8 - 2*x**4*y**2*z + y**4*z**2,
335y**6 - 2*x*y**3*z**2 + x**2*z**4,
336x**2*y**5 + x**7*z - 3*x**3*y**2*z**2 + y*z**5,
337x**7*y - x**3*y**3*z - x**4*z**3 + y**2*z**4,
338x**3*y**4 - x**4*y*z**2 - y**3*z**3 + x*z**5,
339x**4*y**3 - y**5*z - x**5*z**2 + x*y**2*z**3}$
340
341
342	% It is different from the ordinary second power.
343	% Hence m2 has a trivial component.
344
345    modequalp(m2,m3);
346
347
348no$
349
350
351	% Test x for non zero divisor property :
352
353    nzdp(x,m2);
354
355
356no$
357
358    nzdp(x,m3);
359
360
361yes$
362
363
364	% Here is the primary decomposition :
365
366    pd:=primarydecomposition m2;
367
368
369pd := {{{x**8 - 2*x**4*y**2*z + y**4*z**2,
370x**6*y**2 - 2*x**3*y*z**3 + z**6,
371x**2*z**4 - 2*x*y**3*z**2 + y**6,
372x**7*z - 3*x**3*y**2*z**2 + x**2*y**5 + y*z**5,
373x**7*y - x**4*z**3 - x**3*y**3*z + y**2*z**4,
374 - x**4*y*z**2 + x**3*y**4 + x*z**5 - y**3*z**3,
375 - x**5*z**2 + x**4*y**3 + x*y**2*z**3 - y**5*z},
376{ - x*z**2 + y**3,
377x**4 - y**2*z,
378x**3*y - z**3}},
379{{z**2,
380x**6*y**2,
381y**6,
382x**2*y**5*z,
383x**3*y**4,
384x**4*(x**4 - 2*y**2*z),
385x**3*y*(x**4 - y**2*z),
386y**3*(x**4 - y**2*z)},
387{x,z,y}}}$
388
389
390	% Compare the result with m2 :
391
392    setideal(m4,matintersect(first first pd, first second pd));
393
394
395{y**6 - 2*x*y**3*z**2 + x**2*z**4,
396x**6*y**2 - 2*x**3*y*z**3 + z**6,
397x**8 - 2*x**4*y**2*z + y**4*z**2,
398x**2*y**5*z + x**7*z**2 - 3*x**3*y**2*z**3 + y*z**6,
399x**4*y**3 - y**5*z - x**5*z**2 + x*y**2*z**3,
400x**3*y**4 - x**4*y*z**2 - y**3*z**3 + x*z**5,
401x**7*y - x**3*y**3*z - x**4*z**3 + y**2*z**4}$
402
403    modequalp(m2,m4);
404
405
406yes$
407
408
409	% Compare the result with m3 :
410
411    setideal(m4,first first pd)$
412
413
414    modequalp(m3,m4);
415
416
417yes$
418
419
420	% The trivial component can also be removed with a stable
421	% quotient computation :
422
423    setideal(m5,matstabquot(m2,vars))$
424
425
426    modequalp(m3,m5);
427
428
429yes$
430
431
432
433% Example 3 : The Macaulay curve.
434
435    setideal(m,proj_monomial_curve({0,1,3,4},{w,x,y,z}));
436
437
438{x**3 - w**2*y,
439w*y**2 - x**2*z,
440y**3 - x*z**2,
441x*y - w*z}$
442
443    vars:=first getring();
444
445
446vars := {w,x,y,z}$
447
448    gbasis m;
449
450
451{x**3 - w**2*y,
452w*y**2 - x**2*z,
453y**3 - x*z**2,
454x*y - w*z}$
455
456
457  % Test whether m is prime :
458
459    isprime m;
460
461
462yes$
463
464
465  % A resolution of m :
466
467    resolve m;
468
469
470{
471mat((x**3 - w**2*y),(w*y**2 - x**2*z),(y**3 - x*z**2),(x*y - w*z))$
472,
473
474mat((y,w,0, - x**2),(z,x,0, - w*y),(0, - y,w, - x*z),(0, - z,x, - y**2))$
475,
476
477mat((z, - y, - x,w))$
478,
479
480mat((0))$
481}$
482
483
484  % m has depth = 1 as can be seen from the
485
486    gradedbettinumbers m;
487
488
489{{0},{2,3,3,3},{4,4,4,4},{5}}$
490
491
492  % Another way to see the non perfectness of m :
493
494    hilbertseries m;
495
496
497( - w**3 + 2*w**2 + 2*w + 1)/(w**2 - 2*w + 1)$
498
499
500  % Just a third approach. Divide out a parameter system :
501
502    ps:=for i:=1:2 collect random_linear_form(vars,1000);
503
504
505ps := {2*(197*w - 89*x + 15*y + 96*z), - 91*w + 12*x - 700*y - 585*z}$
506
507    setideal(m1,matsum(m,ps))$
508
509
510
511	% dim should be zero and degree > degree m = 4.
512	% A Gbasis for m1 is computed automatically.
513
514    dim m1;
515
516
5170$
518
519    degree m1;
520
521
5225$
523
524
525  % The projections of m on the coord. hyperplanes.
526
527    for each x in vars collect eliminate(m,{x});
528
529
530{{ - x*z**2 + y**3},
531{ - w*z**3 + y**4},
532{ - w**3*z + x**4},
533{ - w**2*y + x**3}}$
534
535
536% Example 4 : Two submodules of S^4.
537
538	% Get the stored result of the earlier computation.
539
540    r:=resolve m$
541
542
543
544  % See whether cali!=degrees contains a relict from earlier
545  % computations.
546
547    getdegrees();
548
549
550{}$
551
552
553  % Introduce the 2nd and 3rd syzygy module as new modules.
554  % Both are submodules in S^4.
555
556    setmodule(m1,second r)$
557
558 setmodule(m2,third r)$
559
560
561
562  % The second is already a gbasis.
563
564    setgbasis m2;
565
566
567mat((z, - y, - x,w))$
568
569    getleadterms m1;
570
571
572mat((0,x**3,0,0),(0,0,x**3,0),(0,0,w**2*y,0),(0,0,w*y**2,0),(0,0,w*x,0),(0,0,0,x
573**2),(0,0,0,w*y),(0,0,0,x*z),(0,0,0,y**2))$
574 getleadterms m2;
575
576
577mat((0,0,0,w))$
578
579
580  % Since rk(F/M)=rk(F/in(M)), they have ranks 1 resp. 3.
581
582    dim m1;
583
584
5854$
586
587    indepvarsets m1;
588
589
590{{w,x,y,z}}$
591
592
593  % Its intersection is zero :
594
595    matintersect(m1,m2);
596
597
598mat((0,0,0,0))$
599
600
601  % Its sum :
602
603    setmodule(m3,matsum(m1,m2));
604
605
606mat(( - y, - w,0,x**2),(0,y, - w,x*z),(0,z, - x,y**2),(z, - y, - x,w),( - y*z -
607z,y**2 - x,x*y,0))$
608
609    dim m3;
610
611
6123$
613
614
615  % Hence it has a nontrivial annihilator :
616
617    annihilator m3;
618
619
620{w**2*y*z + w**2*z - w*x*y + w*y**3 - x**3*z - x**2*y*z - x**2*z**2 + x*y**3}$
621
622
623  % One can compute isolated primes and primary decomposition also for
624  % modules. Let's do it, although being trivial here:
625
626    isolatedprimes m3;
627
628
629{{w**2*y*z + w**2*z - w*x*y + w*y**3 - x**3*z - x**2*y*z - x**2*z**2 + x*y**3}}$
630
631
632    primarydecomposition m3;
633
634
635{{
636mat((z*( - w*x*z - w*y*z + w*y - w*z + x**2*z + x*y*z - y**3 + y**2*z),w**2*y +
637w**2*z + w*x*y*z + w*x*z**2 - w*x*z + w*y*z**2 - x**2*z**2 + x*y**2*z, - w**3,0)
638,(z*( - w*y - w - x*z + y**2), - w*x + w*y*z - x**2*z + x*y**2,w**2*y,0),( - x*z
639**2,w*y + x*y*z + x*z**2 - y**3,w*( - w + y**2),0),( - x*z**2,y*(w + x*z), - w**
6402 + x**2*z,0),( - y*z, - (w*z + x*y),w*x,0),( - w*y**2 + x**2*z, - w**2*y + x**3
641,0,0),(w*y*z - w*y + w*z - x**2*z + y**3 - y**2*z, - w**2 + w*x - w*y*z + x**2*y
642 + x**2*z - x*y**2,0,0),( - w*y*z - w*z - y**3 + y**2*z, - w*x + w*y*z - x**2*z
643+ x*y**2,x**3,0),(z*( - w*y - w + y**2), - w*x + w*y**2 + w*y*z + x*y**2,0,0),(
644- z*(y + 1), - x + y**2,x*y,0),(z, - y, - x,w),(w**2*y*z + w**2*z - w*x*y + w*y
645**3 - x**3*z - x**2*y*z - x**2*z**2 + x*y**3,0,0,0),( - y, - w,0,x**2),(0,y, - w
646,x*z),(0,z, - x,y**2))$
647,
648{w**2*y*z + w**2*z - w*x*y + w*y**3 - x**3*z - x**2*y*z - x**2*z**2 + x*y**3}}}$
649
650
651  % To get a meaningful Hilbert series make m1 homogeneous :
652
653    setdegrees {1,x,x,x};
654
655
656{1,x,x,x}$
657
658
659  % Reevaluate m1 with the new column degrees.
660
661    setmodule(m1,m1)$
662
663
664    hilbertseries m1;
665
666
667(w**7 - 5*w**6 + 8*w**5 - 2*w**4 - 5*w**3 + 3*w + 1)/(w**4 - 4*w**3 + 6*w**2 - 4
668*w + 1)$
669
670
671% Example 5 : From the MACAULAY manual (D.Bayer, M.Stillman).
672% An elliptic curve on the Veronese in P^5.
673
674    rvars:={x,y,z}$
675
676 svars:={a,b,c,d,e,f}$
677
678
679    r:=setring(rvars,degreeorder rvars,revlex)$
680
681
682    s:=setring(svars,{for each x in svars collect 2},revlex)$
683
684
685    map:={s,r,{a=x^2,b=x*y,c=x*z,d=y^2,e=y*z,f=z^2}};
686
687
688map := {{{a,
689b,
690c,
691d,
692e,
693f},
694{{2,2,2,2,2,2}},
695revlex,
696{1,1,1,1,1,1}},
697{{x,y,z},
698{{1,1,1}},
699revlex,
700{1,1,1}},
701{a=x**2,
702b=x*y,
703c=x*z,
704d=y**2,
705e=y*z,
706f=z**2}}$
707
708    preimage({y^2z-x^3-x*z^2},map);
709
710
711{ - a*d + b**2,
712 - a*e + b*c,
713 - b*e + c*d,
714 - a*f + c**2,
715 - b*f + c*e,
716 - d*f + e**2,
717a**2 + a*f - b*e,
718a*b + b*f - d*e,
719a*c + c*f - d*f}$
720
721
722% Example 6 : The preimage under a rational map.
723
724    r:=setring({x,y},{},lex)$
725
726 s:=setring({t},{},lex)$
727
728
729    map:={r,s,{x=2t/(t^2+1),y=(t^2-1)/(t^2+1)}};
730
731
732map := {{{x,y},{},lex,{1,1}},
733{{t},{},lex,{1}},
734{x=(2*t)/(t**2 + 1),y=(t**2 - 1)/(t**2 + 1)}}$
735
736
737  % The preimage of (0) is the equation of the circle :
738
739    ratpreimage({},map);
740
741
742{x**2 + y**2 - 1}$
743
744
745  % The preimage of the point (t=3/2) :
746
747    ratpreimage({2t-3},map);
748
749
750{13*x - 12,13*y - 5}$
751
752
753
754% Example 7 : A zerodimensional ideal.
755
756    setring({x,y,z},{},lex)$
757
758
759    setideal(n,{x**2 + y + z - 3,x + y**2 + z - 3,x + y + z**2 - 3});
760
761
762{x**2 + y + z - 3,x + y**2 + z - 3,x + y + z**2 - 3}$
763
764
765  % The groebner algorithm with factorization :
766
767    groebfactor n;
768
769
770{{y - 1,z - 1,x - 1},
771{y + 3,z + 3,x + 3},
772{y - z,z**2 - 2,x + z - 1},
773{z**2 - 2,x - z,y + z - 1},
774{y + z - 1,z**2 - 2*z - 1,x + z - 1}}$
775
776
777  % Change the term order and reevaluate n :
778
779    setring({x,y,z},{{1,1,1}},revlex)$
780
781
782    setideal(n,n);
783
784
785{x**2 + y + z - 3,y**2 + x + z - 3,z**2 + x + y - 3}$
786
787
788  % its primes :
789
790    zeroprimes n;
791
792
793{{x - z,z**2 - 2,y + z - 1},
794{x + z - 1,y + z - 1,z**2 - 2*z - 1},
795{z - 1,x - 1,y - 1},
796{z + 3,x + 3,y + 3},
797{y - z,z**2 - 2,x + z - 1}}$
798
799
800  % a vector space basis of S/n :
801
802    getkbase n;
803
804
805{1,x,x*y,x*y*z,x*z,y,y*z,z}$
806
807
808% Example 8 : A modular computation. Since REDUCE has no multivariate
809% factorizer, factorprimes has to be turned off !
810
811    on modular$
812
813 off factorprimes$
814
815
816    setmod 181;
817
818
8191$
820 setideal(n1,n);
821
822
823{x**2 + y + z + 178,y**2 + x + z + 178,z**2 + x + y + 178}$
824 zeroprimes n1;
825
826
827{{y + 180*z,z**2 + 179,x + z + 180},
828{x + z + 180,y + z + 180,z**2 + 179*z + 180},
829{x + 180*z,z**2 + 179,y + z + 180},
830{z + 180,x + 180,y + 180},
831{z + 3,x + 3,y + 3}}$
832
833    setmod 7;
834
835
836181$
837 setideal(n1,n);
838
839
840{x**2 + y + z + 4,y**2 + x + z + 4,z**2 + x + y + 4}$
841 zeroprimes n1;
842
843
844{{z + 6,x + 6,y + 6},
845{x + 4,z + 4,y + 2},
846{x + 4,z + 2,y + 4},
847{z + 4,x + 2,y + 4},
848{x + 3,z + 3,y + 3}}$
849
850
851	% Hence some of the primes glue together mod 7.
852
853    zeroprimarydecomposition n1;
854
855
856{{{z + 6,x + 6,y + 6},
857{z + 6,x + 6,y + 6}},
858{{z + 4,y + 2,x + 4},
859{x + 4,z + 4,y + 2}},
860{{z + 2,y + 4,x + 4},
861{x + 4,z + 2,y + 4}},
862{{z + 4,x + 2,y + 4},
863{z + 4,x + 2,y + 4}},
864{{x**2 + y + z + 4,
865x + y**2 + z + 4,
866x + y + z**2 + 4,
8673*(x + 5*y*z + 2*y + 2*z + 5),
868x*z + 6*x + 3*y + 6*z + 1,
869x*y + 6*x + 6*y + 3*z + 1},
870{x + 3,z + 3,y + 3}}}$
871
872    off modular$
873
874 on factorprimes$
875
876
877
878% Example 9 : Independent sets once more.
879
880    n:=10$
881
882
883    vars:=for i:=1:(2*n) collect mkid(x,i)$
884
885
886    setring(vars,{},lex)$
887
888
889    setideal(m,for j:=0:n collect
890            for i:=(j+1):(j+n) product mkid(x,i));
891
892
893{x1*x2*x3*x4*x5*x6*x7*x8*x9*x10,
894x2*x3*x4*x5*x6*x7*x8*x9*x10*x11,
895x3*x4*x5*x6*x7*x8*x9*x10*x11*x12,
896x4*x5*x6*x7*x8*x9*x10*x11*x12*x13,
897x5*x6*x7*x8*x9*x10*x11*x12*x13*x14,
898x6*x7*x8*x9*x10*x11*x12*x13*x14*x15,
899x7*x8*x9*x10*x11*x12*x13*x14*x15*x16,
900x8*x9*x10*x11*x12*x13*x14*x15*x16*x17,
901x9*x10*x11*x12*x13*x14*x15*x16*x17*x18,
902x10*x11*x12*x13*x14*x15*x16*x17*x18*x19,
903x11*x12*x13*x14*x15*x16*x17*x18*x19*x20}$
904
905    setgbasis m$
906
907
908    indepvarsets m;
909
910
911{{x2,x3,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
912{x1,x3,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
913{x1,x2,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
914{x1,x2,x3,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
915{x1,x2,x3,x4,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
916{x1,x2,x3,x4,x5,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
917{x1,x2,x3,x4,x5,x6,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
918{x1,x2,x3,x4,x5,x6,x7,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
919{x1,x2,x3,x4,x5,x6,x7,x8,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},
920{x1,x2,x3,x4,x5,x6,x7,x8,x9,x12,x13,x14,x15,x16,x17,x18,x19,x20},
921{x1,x3,x4,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
922{x1,x2,x4,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
923{x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
924{x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
925{x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
926{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
927{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
928{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},
929{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x13,x14,x15,x16,x17,x18,x19,x20},
930{x1,x2,x4,x5,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
931{x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
932{x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
933{x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
934{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
935{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
936{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},
937{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x14,x15,x16,x17,x18,x19,x20},
938{x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
939{x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
940{x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
941{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
942{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
943{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},
944{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x15,x16,x17,x18,x19,x20},
945{x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},
946{x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},
947{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},
948{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},
949{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},
950{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x16,x17,x18,x19,x20},
951{x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},
952{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},
953{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},
954{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},
955{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x17,x18,x19,x20},
956{x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},
957{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},
958{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},
959{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x18,x19,x20},
960{x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x16,x17,x19,x20},
961{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x17,x19,x20},
962{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x19,x20},
963{x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x17,x18,x20},
964{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x18,x20},
965{x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x18,x19}}$
966
967    dim m;
968
969
97018$
971
972    degree m;
973
974
97555$
976
977
978
979comment
980
981	####################################
982	###				 ###
983	###     Local Standard Bases     ###
984	###				 ###
985	####################################
986
987end comment;
988
989
990
991% Example 10 : An example from [ Alonso, Mora, Raimondo ]
992
993    vars := {z,x,y}$
994
995
996    r:=setring(vars,{},lex)$
997
998
999    setideal(m,{x^3+(x^2-y^2)*z+z^4,y^3+(x^2-y^2)*z-z^4});
1000
1001
1002{z**4 + z*x**2 - z*y**2 + x**3,
1003 - z**4 + z*x**2 - z*y**2 + y**3}$
1004
1005    dim m;
1006
1007
10081$
1009
1010    degree m;
1011
1012
101312$
1014
1015
1016  % 2 = codim m is the codimension of the curve m. The defining
1017  % equations of the singular locus with their nilpotent structure :
1018
1019    singular_locus(m,2);
1020
1021
1022{x**3 - y**3 + 2*z**4,
1023x**3 + 2*x**2*z + y**3 - 2*y**2*z,
1024y*(8*x**3 + 3*x**2*y - 11*y**3 + 12*y*z**3),
1025y*(x**3 + 3*x**2*y + 2*x*y*z + y**3 - 2*y**2*z),
10263*x**5 + 3*x**4*y + 22*x**4 + 18*x**3*y**2 + 16*x**3*y + 21*x**2*y**3 + 3*x*y**4
1027 - 16*x*y**3 + 18*y**5 - 42*y**4*z - 22*y**4 + 24*y**3*z**2}$
1028
1029    groebfactor ws;
1030
1031
1032{{y,x,z},{81*x + 256,27*z - 64,81*y - 256}}$
1033
1034
1035  % Hence this curve has two singular points :
1036  % (x=y=z=0) and (y=-x=256/81,z=64/27)
1037  % Let's find the brances of the curve through the origin.
1038  % The first critical tropism is (-1,-1,-1).
1039
1040    off noetherian$
1041
1042
1043    setring(vars,{{-1,-1,-1}},lex)$
1044
1045
1046    setideal(m,m);
1047
1048
1049{z*x**2 - z*y**2 + x**3 + z**4,
1050z*x**2 - z*y**2 + y**3 - z**4}$
1051
1052	% Let's first test two different approaches, not fully
1053	% integrated into the algebraic interface :
1054    setideal(m1,homstbasis m);
1055
1056
1057{x**3 - y**3 + 2*z**4,
1058z*x**2 - z*y**2 + y**3 - z**4,
1059z*x*y**2 - z*y**3 - x*y**3 + 2*z**5 + z**4*x,
1060x**2*y**3 + x*y**4 + y**5 - 2*z**5*x - 2*z**5*y - z**4*x**2 - z**4*x*y - z**4*y
1061**2,
10626*z*y**5 + 2*x*y**5 - 2*y**6 - 4*z**6*x - 4*z**6*y - 2*z**5*x*y - 8*z**5*y**2 +
1063z**4*x**3 - 2*z**4*x*y**2 + 3*z**4*y**3}$
1064
1065    setideal(m2,lazystbasis m);
1066
1067
1068{x**3 - y**3 + 2*z**4,
1069z*x**2 - z*y**2 + y**3 - z**4,
1070z*x*y**2 - z*y**3 - x*y**3 + 2*z**5 + z**4*x,
1071x**2*y**3 + x*y**4 + y**5 - 2*z**5*x - 2*z**5*y - z**4*x**2 - z**4*x*y - z**4*y
1072**2,
10733*z*y**5 + x*y**5 - y**6 - 2*z**6*x - 2*z**6*y - z**5*x**2 - z**5*x*y - 3*z**5*y
1074**2 - z**4*x*y**2 + z**4*y**3}$
1075
1076    setgbasis m1$
1077
1078 setgbasis m2$
1079
1080
1081    modequalp(m1,m2);
1082
1083
1084yes$
1085
1086    gbasis m;
1087
1088
1089{x**3 - y**3 + 2*z**4,
1090z*x**2 - z*y**2 + y**3 - z**4,
1091z*x*y**2 - z*y**3 - x*y**3 + 2*z**5 + z**4*x,
1092x**2*y**3 + x*y**4 + y**5 - 2*z**5*x - 2*z**5*y - z**4*x**2 - z**4*x*y - z**4*y
1093**2,
10943*z*y**5 + x*y**5 - y**6 - 2*z**6*x - 2*z**6*y - z**5*x**2 - z**5*x*y - 3*z**5*y
1095**2 - z**4*x*y**2 + z**4*y**3}$
1096
1097    modequalp(m,m1);
1098
1099
1100yes$
1101
1102    dim m;
1103
1104
11051$
1106
1107    degree m;
1108
1109
11109$
1111
1112
1113  % Find the tangent directions not in z-direction :
1114
1115    tangentcone m;
1116
1117
1118{x**3 - y**3,
1119z*x**2 - z*y**2 + y**3,
1120z*x*y**2 - z*y**3 - x*y**3,
1121x**2*y**3 + x*y**4 + y**5,
11223*z*y**5 + x*y**5 - y**6}$
1123
1124    setideal(n,sub(z=1,ws));
1125
1126
1127{x**3 - y**3,
1128x**2 - y**2 + y**3,
1129x*y**2 - y**3 - x*y**3,
1130x**2*y**3 + x*y**4 + y**5,
11313*y**5 + x*y**5 - y**6}$
1132
1133    setring r$
1134
1135 on noetherian$
1136
1137 setideal(n,n)$
1138
1139
1140    degree n;
1141
1142
11439$
1144
1145
1146  % The points of n outside the origin.
1147
1148    matstabquot(n,{x,y});
1149
1150
1151{y**2 - 3*y + 3,x - y + 3}$
1152
1153
1154  % Hence there are two branches x=z'*(a-3+x'),y=z'*(a+y'),z=z'
1155  % with the algebraic number a : a^2-3a+3=0
1156  % and the new equations for (z',x',y') :
1157
1158    setrules {a^2=>3a-3};
1159
1160
1161{a**2 => 3*a - 3}$
1162
1163    sub(x=z*(a-3+x),y=z*(a+y),m);
1164
1165
1166{z**3*(a**3 + 3*a**2*x - 9*a**2 + 3*a*x**2 - 16*a*x - 2*a*y + 21*a + x**3 - 8*x
1167**2 + 21*x - y**2 + z - 18),
1168z**3*(a**3 + 3*a**2*y + 2*a*x + 3*a*y**2 - 2*a*y - 6*a + x**2 - 6*x + y**3 - y**
11692 - z + 9)}$
1170
1171    setideal(m1,matqquot(ws,z));
1172
1173
1174{x**3 + (3*a - 7)*x**2 - (5*a - 6)*x + y**3 + (3*a - 2)*y**2 + (5*a - 9)*y,
1175z - x**2 - (2*a - 6)*x - y**3 - (3*a - 1)*y**2 - (7*a - 9)*y}$
1176
1177
1178  % This defines a loc. smooth system at the origin, since the
1179  % jacobian at the origin of the gbasis is nonsingular :
1180
1181    off noetherian$
1182
1183
1184    setring getring m;
1185
1186
1187{{z,x,y},{{-1,-1,-1}},lex,{1,1,1}}$
1188
1189    setideal(m1,m1);
1190
1191
1192{ - (5*a - 6)*x + (5*a - 9)*y + (3*a - 7)*x**2 + (3*a - 2)*y**2 + x**3 + y**3,
1193z - (2*a - 6)*x - (7*a - 9)*y - x**2 - (3*a - 1)*y**2 - y**3}$
1194
1195    gbasis m1;
1196
1197
1198{(5*a - 6)*x - (5*a - 9)*y - (3*a - 7)*x**2 - (3*a - 2)*y**2 - x**3 - y**3,
1199(5*a - 6)*z + 27*y + (9*a - 18)*x**2 - (18*a - 45)*y**2 - (2*a - 6)*x**3 - (7*a
1200- 12)*y**3}$
1201
1202
1203	% clear the rules previously set.
1204
1205    setrules {};
1206
1207
1208{}$
1209
1210
1211
1212% Example 11 : The standard basis of another example.
1213
1214	% Comparing different approaches.
1215
1216    vars:={x,y}$
1217
1218
1219    setring(vars,localorder vars,lex);
1220
1221
1222{{x,y},{{-1,-1}},lex,{1,1}}$
1223
1224    ff:=x^5+y^11+(x+x^3)*y^9;
1225
1226
1227ff := x**5 + x**3*y**9 + x*y**9 + y**11$
1228
1229    setideal(p1,mat2list matjac({ff},vars));
1230
1231
1232{5*x**4 + y**9 + 3*x**2*y**9,
12339*x*y**8 + 11*y**10 + 9*x**3*y**8}$
1234
1235    gbasis p1;
1236
1237
1238{5*x**4 + y**9 + 3*x**2*y**9,
12399*x*y**8 + 11*y**10 + 9*x**3*y**8,
124073205*y**16 + 6561*y**17 - 32805*x**10*y**8 + 294030*x**6*y**12 - 292820*x**2*y
1241**16 + 120285*x**9*y**10 - 239580*x**5*y**14 + 19683*x**2*y**17}$
1242
1243
1244    gbtestversion 2$
1245
1246
1247    setideal(p2,p1);
1248
1249
1250{5*x**4 + y**9 + 3*x**2*y**9,
12519*x*y**8 + 11*y**10 + 9*x**3*y**8}$
1252
1253    gbasis p2;
1254
1255
1256{5*x**4 + y**9 + 3*x**2*y**9,
12579*x*y**8 + 11*y**10 + 9*x**3*y**8,
125873205*y**16 + 6561*y**17 - 32805*x**10*y**8 + 294030*x**6*y**12 - 292820*x**2*y
1259**16 + 120285*x**9*y**10 - 239580*x**5*y**14 + 19683*x**2*y**17}$
1260
1261
1262    gbtestversion 3$
1263
1264
1265    setideal(p3,p1);
1266
1267
1268{5*x**4 + y**9 + 3*x**2*y**9,
12699*x*y**8 + 11*y**10 + 9*x**3*y**8}$
1270
1271    gbasis p3;
1272
1273
1274{5*x**4 + y**9 + 3*x**2*y**9,
12759*x*y**8 + 11*y**10 + 9*x**3*y**8,
127673205*y**16 + 6561*y**17 - 32805*x**10*y**8 + 294030*x**6*y**12 - 292820*x**2*y
1277**16 + 120285*x**9*y**10 - 239580*x**5*y**14 + 19683*x**2*y**17}$
1278
1279
1280    gbtestversion 1$
1281
1282
1283    modequalp(p1,p2);
1284
1285
1286yes$
1287
1288    modequalp(p1,p3);
1289
1290
1291yes$
1292
1293    dim p1;
1294
1295
12960$
1297
1298    degree p1;
1299
1300
130140$
1302
1303
1304% Example 12 : A local intersection wrt. a non inflimited term order.
1305
1306    setring({x,y,z},{},revlex);
1307
1308
1309{{x,y,z},{},revlex,{1,1,1}}$
1310
1311    m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2});
1312
1313
1314m1 := {y*z - x**3*y*z - x*y*z**2 + x**4*y*z**2 - y**2*z**2 + x**3*y**2*z**2 + x*
1315y**2*z**3 - x**4*y**2*z**3,
1316x*z - x**2*y*z - x**2*z**2 - x*y*z**2 + x**3*y*z**2 + x**2*y**2*z**2 + x**2*y*z
1317**3 - x**3*y**2*z**3,
1318x*y - x**2*y**2 - x**2*y*z - x*y**2*z + x**3*y**2*z + x**2*y**3*z + x**2*y**2*z
1319**2 - x**3*y**3*z**2}$
1320
1321
1322	% Delete polynomial units post factum :
1323
1324    deleteunits ws;
1325
1326
1327{y*z,x*z,x*y}$
1328
1329
1330	% Detecting polynomial units early :
1331
1332    on detectunits;
1333
1334
1335    m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2});
1336
1337
1338m1 := {y*z,x*z,x*y}$
1339
1340    off detectunits;
1341
1342
1343
1344
1345comment
1346
1347	####################################
1348	###				 ###
1349	###  More Advanced Computations  ###
1350	###				 ###
1351	####################################
1352
1353end comment;
1354
1355
1356  % Return to a noetherian term order:
1357
1358    vars:={x,y,z}$
1359
1360
1361    setring(vars,degreeorder vars,revlex);
1362
1363
1364{{x,y,z},{{1,1,1}},revlex,{1,1,1}}$
1365
1366    on noetherian;
1367
1368
1369
1370% Example 13 : Use of "mod".
1371
1372  % Polynomials modulo ideals :
1373
1374    setideal(m,{2x^2+y+5,3y^2+z+7,7z^2+x+1});
1375
1376
1377{2*x**2 + y + 5,3*y**2 + z + 7,7*z**2 + x + 1}$
1378
1379    x^2*y^2*z^2 mod m;
1380
1381
1382( - x*y*z - 7*x*y - 5*x*z - 35*x - y*z - 7*y - 5*z - 35)/42$
1383
1384
1385  % Lists of polynomials modulo ideals :
1386
1387    {x^3,y^3,z^3} mod gbasis m;
1388
1389
1390{(x*( - y - 5))/2,(y*( - z - 7))/3,( - z*(x + 1))/7}$
1391
1392
1393  % Matrices modulo modules :
1394
1395    mm:=mat((x^4,y^4,z^4));
1396
1397
1398mm := mat((x**4,y**4,z**4))$
1399
1400    mm1:=tp<< ideal2mat m>>;
1401
1402
1403mm1 := mat((2*x**2 + y + 5,3*y**2 + z + 7,x + 7*z**2 + 1))$
1404
1405    mm mod mm1;
1406
1407
1408mat(((y**2 + 10*y + 25)/4,( - 6*x**2*y**2 - 2*x**2*z - 14*x**2 + 4*y**4 + 3*y**3
1409 + 15*y**2 + y*z + 7*y + 5*z + 35)/4,( - 2*x**3 - 14*x**2*z**2 - 2*x**2 + x*y +
14105*x + 7*y*z**2 + y + 4*z**4 + 35*z**2 + 5)/4))$
1411
1412
1413% Example 14 : Powersums through elementary symmetric functions.
1414
1415    vars:={a,b,c,d,e1,e2,e3,e4}$
1416
1417
1418    setring(vars,{},lex)$
1419
1420
1421    m:=interreduce {a+b+c+d-e1,
1422        a*b+a*c+a*d+b*c+b*d+c*d-e2,
1423        a*b*c+a*b*d+a*c*d+b*c*d-e3,
1424        a*b*c*d-e4};
1425
1426
1427m := {d**4 - d**3*e1 + d**2*e2 - d*e3 + e4,
1428a + b + c + d - e1,
1429c**3 + c**2*d - c**2*e1 + c*d**2 - c*d*e1 + c*e2 + d**3 - d**2*e1 + d*e2 - e3,
1430b**2 + b*c + b*d - b*e1 + c**2 + c*d - c*e1 + d**2 - d*e1 + e2}$
1431
1432
1433    for n:=1:5 collect a^n+b^n+c^n+d^n mod m;
1434
1435
1436{e1,
1437e1**2 - 2*e2,
1438e1**3 - 3*e1*e2 + 3*e3,
1439e1**4 - 4*e1**2*e2 + 4*e1*e3 + 2*e2**2 - 4*e4,
1440e1**5 - 5*e1**3*e2 + 5*e1**2*e3 + 5*e1*e2**2 - 5*e1*e4 - 5*e2*e3}$
1441
1442
1443% Example 15 : The setrules mechanism.
1444
1445    setring({x,y,z},{},lex)$
1446
1447
1448    setrules {aa^3=>aa+1};
1449
1450
1451{aa**3 => aa + 1}$
1452
1453    setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa});
1454
1455
1456{x**2 + y + z - aa,x + y**2 + z - aa,x + y + z**2 - aa}$
1457
1458    gbasis m;
1459
1460
1461{y**2 - y - z**2 + z,
1462x + y + z**2 - aa,
14632*y*z**2 - (2*aa - 2)*y + z**4 - (2*aa - 1)*z**2 + (aa**2 - aa),
1464z**6 - (3*aa + 1)*z**4 + 4*z**3 + (3*aa**2 - 2*aa - 2)*z**2 - (4*aa - 4)*z + (3*
1465aa**2 - 3*aa - 1)}$
1466
1467
1468	% Clear the rules previously set.
1469
1470    setrules {};
1471
1472
1473{}$
1474
1475
1476% Example 16 : The same example with advanced coefficient domains.
1477
1478    load_package arnum;
1479
1480
1481    defpoly aa^3-aa-1;
1482
1483
1484    setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa});
1485
1486
1487{x**2 + y + z - aa,x + y**2 + z - aa,x + y + z**2 - aa}$
1488
1489    gbasis m;
1490
1491
1492{y**2 - y - z**2 + z,
1493x + y + z**2 - aa,
1494y*z**2 - (aa - 1)*y + 1/2*z**4 - (aa - 1/2)*z**2 + (1/2*aa**2 - 1/2*aa),
1495z**6 - (3*aa + 1)*z**4 + 4*z**3 + (3*aa**2 - 2*aa - 2)*z**2 - (4*aa - 4)*z + (3*
1496aa**2 - 3*aa - 1)}$
1497
1498
1499	% The following needs some more time since factorization of
1500	% arnum's is not so easy :
1501
1502    groebfactor m;
1503
1504
1505{{y - (aa**2 - aa - 1),
1506z - (aa**2 - aa - 1),
1507x + (aa**2 - aa - 2)},
1508{y + (aa**2 - aa - 1),
1509z + (aa**2 - aa - 1),
1510x - (aa**2 - aa)},
1511{y - z,x - z,z**2 + 2*z - aa},
1512{z - (aa**2 - aa),
1513y + (aa**2 - aa - 1),
1514x + (aa**2 - aa - 1)},
1515{z - (aa**2 - aa - 1),
1516y + (aa**2 - aa - 2),
1517x - (aa**2 - aa - 1)},
1518{z + (aa**2 - aa - 2),
1519y - (aa**2 - aa - 1),
1520x - (aa**2 - aa - 1)},
1521{z + (aa**2 - aa - 1),
1522y - (aa**2 - aa),
1523x + (aa**2 - aa - 1)}}$
1524
1525    off arnum;
1526
1527
1528    off rational;
1529
1530
1531
1532
1533comment
1534
1535	####################################
1536	###				 ###
1537	###  Using Advanced Scripts in   ###
1538	###	a Complex Example	 ###
1539	###				 ###
1540	####################################
1541
1542end comment;
1543
1544
1545
1546% Example 17 : The square of the 2-minors of a symmetric 3x3-matrix.
1547
1548    vars:=for i:=1:6 collect mkid(x,i);
1549
1550
1551vars := {x1,
1552x2,
1553x3,
1554x4,
1555x5,
1556x6}$
1557
1558    setring(vars,degreeorder vars,revlex);
1559
1560
1561{{x1,x2,x3,x4,x5,x6},{{1,1,1,1,1,1}},revlex,{1,1,1,1,1,1}}$
1562
1563
1564	% Generating the ideal :
1565
1566    mm:=mat((x1,x2,x3),(x2,x4,x5),(x3,x5,x6));
1567
1568
1569mm := mat((x1,x2,x3),(x2,x4,x5),(x3,x5,x6))$
1570
1571    m:=ideal_of_minors(mm,2);
1572
1573
1574m := { - x1*x4 + x2**2,
1575 - x1*x5 + x2*x3,
1576 - x1*x6 + x3**2,
1577 - x2*x5 + x3*x4,
1578 - x2*x6 + x3*x5,
1579 - x4*x6 + x5**2}$
1580
1581    setideal(n,idealpower(m,2));
1582
1583
1584{x2**4 - 2*x1*x2**2*x4 + x1**2*x4**2,
1585x3**4 - 2*x1*x3**2*x6 + x1**2*x6**2,
1586x5**4 - 2*x4*x5**2*x6 + x4**2*x6**2,
1587x2**2*x3**2 - 2*x1*x2*x3*x5 + x1**2*x5**2,
1588x3**2*x5**2 - 2*x2*x3*x5*x6 + x2**2*x6**2,
1589x2**3*x3 - x1*x2*x3*x4 - x1*x2**2*x5 + x1**2*x4*x5,
1590x2*x3**3 - x1*x3**2*x5 - x1*x2*x3*x6 + x1**2*x5*x6,
1591x2**2*x3*x4 - x1*x3*x4**2 - x2**3*x5 + x1*x2*x4*x5,
1592x2**2*x3*x5 - x1*x3*x4*x5 - x2**3*x6 + x1*x2*x4*x6,
1593x2*x3**2*x5 - x1*x3*x5**2 - x2**2*x3*x6 + x1*x2*x5*x6,
1594x3**3*x5 - x2*x3**2*x6 - x1*x3*x5*x6 + x1*x2*x6**2,
1595x2**2*x5**2 - x1*x4*x5**2 - x2**2*x4*x6 + x1*x4**2*x6,
1596x2*x3*x5**2 - x1*x5**3 - x2*x3*x4*x6 + x1*x4*x5*x6,
1597x3*x4*x5**2 - x2*x5**3 - x3*x4**2*x6 + x2*x4*x5*x6,
1598x3*x5**3 - x3*x4*x5*x6 - x2*x5**2*x6 + x2*x4*x6**2,
1599x3**2*x4**2 - 2*x2*x3*x4*x5 + x1*x4*x5**2 + x2**2*x4*x6 - x1*x4**2*x6,
1600x2*x3**2*x4 - 2*x1*x3*x4*x5 + x1*x2*x5**2 - x2**3*x6 + x1*x2*x4*x6,
1601x3**3*x4 - x1*x3*x5**2 - x2**2*x3*x6 - x1*x3*x4*x6 + 2*x1*x2*x5*x6,
1602x3**2*x4*x5 - x1*x5**3 - 2*x2*x3*x4*x6 + x2**2*x5*x6 + x1*x4*x5*x6,
1603x3**2*x4*x6 - 2*x2*x3*x5*x6 + x1*x5**2*x6 + x2**2*x6**2 - x1*x4*x6**2,
1604x1*x3**2*x4 - 2*x1*x2*x3*x5 + x1**2*x5**2 + x1*x2**2*x6 - x1**2*x4*x6}$
1605
1606
1607	% The ideal itself :
1608
1609    gbasis n;
1610
1611
1612{x2**4 - 2*x1*x2**2*x4 + x1**2*x4**2,
1613x3**4 - 2*x1*x3**2*x6 + x1**2*x6**2,
1614x5**4 - 2*x4*x5**2*x6 + x4**2*x6**2,
1615x2**2*x3**2 - 2*x1*x2*x3*x5 + x1**2*x5**2,
1616x3**2*x5**2 - 2*x2*x3*x5*x6 + x2**2*x6**2,
1617x2**3*x3 - x1*x2*x3*x4 - x1*x2**2*x5 + x1**2*x4*x5,
1618x2*x3**3 - x1*x3**2*x5 - x1*x2*x3*x6 + x1**2*x5*x6,
1619x2**2*x3*x4 - x1*x3*x4**2 - x2**3*x5 + x1*x2*x4*x5,
1620x2**2*x3*x5 - x1*x3*x4*x5 - x2**3*x6 + x1*x2*x4*x6,
1621x2*x3**2*x5 - x1*x3*x5**2 - x2**2*x3*x6 + x1*x2*x5*x6,
1622x3**3*x5 - x2*x3**2*x6 - x1*x3*x5*x6 + x1*x2*x6**2,
1623x2**2*x5**2 - x1*x4*x5**2 - x2**2*x4*x6 + x1*x4**2*x6,
1624x2*x3*x5**2 - x1*x5**3 - x2*x3*x4*x6 + x1*x4*x5*x6,
1625x3*x4*x5**2 - x2*x5**3 - x3*x4**2*x6 + x2*x4*x5*x6,
1626x3*x5**3 - x3*x4*x5*x6 - x2*x5**2*x6 + x2*x4*x6**2,
1627x3**2*x4**2 - 2*x2*x3*x4*x5 + x1*x4*x5**2 + x2**2*x4*x6 - x1*x4**2*x6,
1628x2*x3**2*x4 - 2*x1*x3*x4*x5 + x1*x2*x5**2 - x2**3*x6 + x1*x2*x4*x6,
1629x3**3*x4 - x1*x3*x5**2 - x2**2*x3*x6 - x1*x3*x4*x6 + 2*x1*x2*x5*x6,
1630x3**2*x4*x5 - x1*x5**3 - 2*x2*x3*x4*x6 + x2**2*x5*x6 + x1*x4*x5*x6,
1631x3**2*x4*x6 - 2*x2*x3*x5*x6 + x1*x5**2*x6 + x2**2*x6**2 - x1*x4*x6**2,
1632x1*x3**2*x4 - 2*x1*x2*x3*x5 + x1**2*x5**2 + x1*x2**2*x6 - x1**2*x4*x6}$
1633
1634    length n;
1635
1636
163721$
1638
1639    dim n;
1640
1641
16423$
1643
1644    degree n;
1645
1646
164716$
1648
1649
1650	% Its radical.
1651
1652    radical n;
1653
1654
1655{ - x1*x5 + x2*x3,
1656 - x2*x5 + x3*x4,
1657 - x2*x6 + x3*x5,
1658 - x1*x4 + x2**2,
1659 - x1*x6 + x3**2,
1660 - x4*x6 + x5**2}$
1661
1662
1663	% Its unmixed radical.
1664
1665    unmixedradical n;
1666
1667
1668{ - x1*x5 + x2*x3,
1669x2*x5 - x3*x4,
1670 - x2*x6 + x3*x5,
1671 - x1*x4 + x2**2,
1672 - x1*x6 + x3**2,
1673 - x4*x6 + x5**2}$
1674
1675
1676	% Its equidimensional hull :
1677
1678    n1:=eqhull n;
1679
1680
1681n1 := {x1**2*x4**2 - 2*x1*x2**2*x4 + x2**4,
1682x1**2*x6**2 - 2*x1*x3**2*x6 + x3**4,
1683x4**2*x6**2 - 2*x4*x5**2*x6 + x5**4,
1684x1**2*x5**2 - 2*x1*x2*x3*x5 + x2**2*x3**2,
1685x2**2*x6**2 - 2*x2*x3*x5*x6 + x3**2*x5**2,
1686x1**2*x4*x5 - x1*x2**2*x5 - x1*x2*x3*x4 + x2**3*x3,
1687x1**2*x5*x6 - x1*x2*x3*x6 - x1*x3**2*x5 + x2*x3**3,
1688x1*x2*x4*x5 - x1*x3*x4**2 - x2**3*x5 + x2**2*x3*x4,
1689x1*x2*x4*x6 - x1*x3*x4*x5 - x2**3*x6 + x2**2*x3*x5,
1690x1*x2*x5*x6 - x1*x3*x5**2 - x2**2*x3*x6 + x2*x3**2*x5,
1691x1*x2*x6**2 - x1*x3*x5*x6 - x2*x3**2*x6 + x3**3*x5,
1692x1*x4**2*x6 - x1*x4*x5**2 - x2**2*x4*x6 + x2**2*x5**2,
1693x1*x4*x5*x6 - x1*x5**3 - x2*x3*x4*x6 + x2*x3*x5**2,
1694x2*x4*x5*x6 - x2*x5**3 - x3*x4**2*x6 + x3*x4*x5**2,
1695x2*x4*x6**2 - x2*x5**2*x6 - x3*x4*x5*x6 + x3*x5**3,
1696 - x1*x4*x6 + x1*x5**2 + x2**2*x6 - 2*x2*x3*x5 + x3**2*x4}$
1697
1698    length n1;
1699
1700
170116$
1702
1703    setideal(n1,n1)$
1704
1705
1706    submodulep(n,n1);
1707
1708
1709yes$
1710
1711    submodulep(n1,n);
1712
1713
1714no$
1715
1716
1717	% Hence there is an embedded component. Let's find it making
1718	% an excursion to symbolic mode. Of course, this can be done
1719	% also algebraically.
1720
1721    symbolic;
1722
1723
1724nil
1725
1726    n:=get('n,'basis);
1727
1728
1729(dpmat 21 0 ((1 ((((0 0 4) 4) . 1) (((0 1 2 0 1) 4) . -2) (((0 2 0 0 2) 4) . 1))
17303 0 nil) (2 ((((0 0 0 4) 4) . 1) (((0 1 0 2 0 0 1) 4) . -2) (((0 2 0 0 0 0 2) 4)
1731 . 1)) 3 0 nil) (3 ((((0 0 0 0 0 4) 4) . 1) (((0 0 0 0 1 2 1) 4) . -2) (((0 0 0
17320 2 0 2) 4) . 1)) 3 0 nil) (4 ((((0 0 2 2) 4) . 1) (((0 1 1 1 0 1) 4) . -2) (((0
17332 0 0 0 2) 4) . 1)) 3 0 nil) (5 ((((0 0 0 2 0 2) 4) . 1) (((0 0 1 1 0 1 1) 4) .
1734-2) (((0 0 2 0 0 0 2) 4) . 1)) 3 0 nil) (6 ((((0 0 3 1) 4) . 1) (((0 1 1 1 1) 4)
1735 . -1) (((0 1 2 0 0 1) 4) . -1) (((0 2 0 0 1 1) 4) . 1)) 4 0 nil) (7 ((((0 0 1 3
1736) 4) . 1) (((0 1 0 2 0 1) 4) . -1) (((0 1 1 1 0 0 1) 4) . -1) (((0 2 0 0 0 1 1)
17374) . 1)) 4 0 nil) (8 ((((0 0 2 1 1) 4) . 1) (((0 1 0 1 2) 4) . -1) (((0 0 3 0 0
17381) 4) . -1) (((0 1 1 0 1 1) 4) . 1)) 4 0 nil) (9 ((((0 0 2 1 0 1) 4) . 1) (((0 1
17390 1 1 1) 4) . -1) (((0 0 3 0 0 0 1) 4) . -1) (((0 1 1 0 1 0 1) 4) . 1)) 4 0 nil)
1740(10 ((((0 0 1 2 0 1) 4) . 1) (((0 1 0 1 0 2) 4) . -1) (((0 0 2 1 0 0 1) 4) . -1)
1741(((0 1 1 0 0 1 1) 4) . 1)) 4 0 nil) (11 ((((0 0 0 3 0 1) 4) . 1) (((0 0 1 2 0 0
17421) 4) . -1) (((0 1 0 1 0 1 1) 4) . -1) (((0 1 1 0 0 0 2) 4) . 1)) 4 0 nil) (12 (
1743(((0 0 2 0 0 2) 4) . 1) (((0 1 0 0 1 2) 4) . -1) (((0 0 2 0 1 0 1) 4) . -1) (((0
17441 0 0 2 0 1) 4) . 1)) 4 0 nil) (13 ((((0 0 1 1 0 2) 4) . 1) (((0 1 0 0 0 3) 4)
1745 . -1) (((0 0 1 1 1 0 1) 4) . -1) (((0 1 0 0 1 1 1) 4) . 1)) 4 0 nil) (14 ((((0
17460 0 1 1 2) 4) . 1) (((0 0 1 0 0 3) 4) . -1) (((0 0 0 1 2 0 1) 4) . -1) (((0 0 1
17470 1 1 1) 4) . 1)) 4 0 nil) (15 ((((0 0 0 1 0 3) 4) . 1) (((0 0 0 1 1 1 1) 4) .
1748-1) (((0 0 1 0 0 2 1) 4) . -1) (((0 0 1 0 1 0 2) 4) . 1)) 4 0 nil) (16 ((((0 0 0
17492 2) 4) . 1) (((0 0 1 1 1 1) 4) . -2) (((0 1 0 0 1 2) 4) . 1) (((0 0 2 0 1 0 1)
17504) . 1) (((0 1 0 0 2 0 1) 4) . -1)) 5 0 nil) (17 ((((0 0 1 2 1) 4) . 1) (((0 1 0
17511 1 1) 4) . -2) (((0 1 1 0 0 2) 4) . 1) (((0 0 3 0 0 0 1) 4) . -1) (((0 1 1 0 1
17520 1) 4) . 1)) 5 0 nil) (18 ((((0 0 0 3 1) 4) . 1) (((0 1 0 1 0 2) 4) . -1) (((0
17530 2 1 0 0 1) 4) . -1) (((0 1 0 1 1 0 1) 4) . -1) (((0 1 1 0 0 1 1) 4) . 2)) 5 0
1754nil) (19 ((((0 0 0 2 1 1) 4) . 1) (((0 1 0 0 0 3) 4) . -1) (((0 0 1 1 1 0 1) 4)
1755 . -2) (((0 0 2 0 0 1 1) 4) . 1) (((0 1 0 0 1 1 1) 4) . 1)) 5 0 nil) (20 ((((0 0
17560 2 1 0 1) 4) . 1) (((0 0 1 1 0 1 1) 4) . -2) (((0 1 0 0 0 2 1) 4) . 1) (((0 0 2
17570 0 0 2) 4) . 1) (((0 1 0 0 1 0 2) 4) . -1)) 5 0 nil) (21 ((((0 1 0 2 1) 4) . 1)
1758(((0 1 1 1 0 1) 4) . -2) (((0 2 0 0 0 2) 4) . 1) (((0 1 2 0 0 0 1) 4) . 1) (((0
17592 0 0 1 0 1) 4) . -1)) 5 0 nil)) nil nil)
1760
1761
1762	% This needs even more time than the eqhull, of course.
1763
1764    u:=primarydecomposition!* n;
1765
1766
1767(((dpmat 16 0 ((1 ((((0 0 2 1 0 1) 4) . 1) (((0 1 0 1 1 1) 4) . -1) (((0 0 3 0 0
17680 1) 4) . -1) (((0 1 1 0 1 0 1) 4) . 1)) 4 0 nil) (2 ((((0 0 1 2 0 1) 4) . 1) ((
1769(0 1 0 1 0 2) 4) . -1) (((0 0 2 1 0 0 1) 4) . -1) (((0 1 1 0 0 1 1) 4) . 1)) 4 0
1770nil) (3 ((((0 0 1 1 0 2) 4) . 1) (((0 1 0 0 0 3) 4) . -1) (((0 0 1 1 1 0 1) 4)
1771 . -1) (((0 1 0 0 1 1 1) 4) . 1)) 4 0 nil) (4 ((((0 0 4) 4) . 1) (((0 1 2 0 1) 4
1772) . -2) (((0 2 0 0 2) 4) . 1)) 3 0 nil) (5 ((((0 0 3 1) 4) . 1) (((0 1 1 1 1) 4)
1773 . -1) (((0 1 2 0 0 1) 4) . -1) (((0 2 0 0 1 1) 4) . 1)) 4 0 nil) (6 ((((0 0 2 2
1774) 4) . 1) (((0 1 1 1 0 1) 4) . -2) (((0 2 0 0 0 2) 4) . 1)) 3 0 nil) (7 ((((0 0
17752 1 1) 4) . 1) (((0 1 0 1 2) 4) . -1) (((0 0 3 0 0 1) 4) . -1) (((0 1 1 0 1 1) 4
1776) . 1)) 4 0 nil) (8 ((((0 0 2 0 0 2) 4) . 1) (((0 1 0 0 1 2) 4) . -1) (((0 0 2 0
17771 0 1) 4) . -1) (((0 1 0 0 2 0 1) 4) . 1)) 4 0 nil) (9 ((((0 0 0 4) 4) . 1) (((0
17781 0 2 0 0 1) 4) . -2) (((0 2 0 0 0 0 2) 4) . 1)) 3 0 nil) (10 ((((0 0 0 0 0 4) 4
1779) . 1) (((0 0 0 0 1 2 1) 4) . -2) (((0 0 0 0 2 0 2) 4) . 1)) 3 0 nil) (11 ((((0
17800 0 2 0 2) 4) . 1) (((0 0 1 1 0 1 1) 4) . -2) (((0 0 2 0 0 0 2) 4) . 1)) 3 0 nil
1781) (12 ((((0 0 1 3) 4) . 1) (((0 1 0 2 0 1) 4) . -1) (((0 1 1 1 0 0 1) 4) . -1) (
1782((0 2 0 0 0 1 1) 4) . 1)) 4 0 nil) (13 ((((0 0 0 3 0 1) 4) . 1) (((0 0 1 2 0 0 1
1783) 4) . -1) (((0 1 0 1 0 1 1) 4) . -1) (((0 1 1 0 0 0 2) 4) . 1)) 4 0 nil) (14 ((
1784((0 0 0 1 1 2) 4) . 1) (((0 0 1 0 0 3) 4) . -1) (((0 0 0 1 2 0 1) 4) . -1) (((0
17850 1 0 1 1 1) 4) . 1)) 4 0 nil) (15 ((((0 0 0 1 0 3) 4) . 1) (((0 0 0 1 1 1 1) 4)
1786 . -1) (((0 0 1 0 0 2 1) 4) . -1) (((0 0 1 0 1 0 2) 4) . 1)) 4 0 nil) (16 ((((0
17870 0 2 1) 3) . 1) (((0 0 1 1 0 1) 3) . -2) (((0 1 0 0 0 2) 3) . 1) (((0 0 2 0 0 0
17881) 3) . 1) (((0 1 0 0 1 0 1) 3) . -1)) 5 0 nil)) nil t) (dpmat 6 0 ((1 ((((0 0 0
17891 0 1) 2) . 1) (((0 0 1 0 0 0 1) 2) . -1)) 2 0 nil) (2 ((((0 0 0 0 0 2) 2) . 1)
1790(((0 0 0 0 1 0 1) 2) . -1)) 2 0 nil) (3 ((((0 0 0 1 1) 2) . 1) (((0 0 1 0 0 1) 2
1791) . -1)) 2 0 nil) (4 ((((0 0 0 2) 2) . 1) (((0 1 0 0 0 0 1) 2) . -1)) 2 0 nil) (
17925 ((((0 0 1 1) 2) . 1) (((0 1 0 0 0 1) 2) . -1)) 2 0 nil) (6 ((((0 0 2) 2) . 1)
1793(((0 1 0 0 1) 2) . -1)) 2 0 nil)) nil t)) ((dpmat 18 0 ((1 ((((0 0 1 0 0 3) 4)
1794 . 1)) 1 0 nil) (2 ((((0 0 0 0 0 0 1) 1) . 1)) 1 0 nil) (3 ((((0 0 0 4) 4) . 1))
17951 0 nil) (4 ((((0 0 0 0 0 4) 4) . 1)) 1 0 nil) (5 ((((0 0 0 2 0 2) 4) . 1)) 1 0
1796nil) (6 ((((0 0 0 3 0 1) 4) . 1)) 1 0 nil) (7 ((((0 0 0 1 0 3) 4) . 1)) 1 0 nil)
1797(8 ((((0 0 0 0 1) 1) . 1)) 1 0 nil) (9 ((((0 0 3 0 0 1) 4) . 1)) 1 0 nil) (10 ((
1798((0 0 2 1 0 1) 4) . 1)) 1 0 nil) (11 ((((0 0 1 2 0 1) 4) . 1)) 1 0 nil) (12 ((((
17990 0 2 0 0 2) 4) . 1)) 1 0 nil) (13 ((((0 0 1 1 0 2) 4) . 1)) 1 0 nil) (14 ((((0
18000 4) 4) . 1)) 1 0 nil) (15 ((((0 0 2 2) 4) . 1)) 1 0 nil) (16 ((((0 1) 1) . 1))
18011 0 nil) (17 ((((0 0 1 3) 4) . 1)) 1 0 nil) (18 ((((0 0 3 1) 4) . 1)) 1 0 nil))
1802nil t) (dpmat 6 0 ((1 ((((0 0 0 0 0 0 1) 1) . 1)) 1 0 nil) (2 ((((0 0 0 0 1) 1)
1803 . 1)) 1 0 nil) (3 ((((0 1) 1) . 1)) 1 0 nil) (4 ((((0 0 1) 1) . 1)) 1 0 nil) (5
1804((((0 0 0 1) 1) . 1)) 1 0 nil) (6 ((((0 0 0 0 0 1) 1) . 1)) 1 0 nil)) nil t)))
1805
1806    for each x in u collect easydim!* cadr x;
1807
1808
1809(3 0)
1810
1811    for each x in u collect degree!* car x;
1812
1813
1814(16 20)
1815
1816
1817	% Hence the embedded component is a trivial one. Let's divide
1818	% it out by a stable ideal quotient calculation :
1819
1820    algebraic;
1821
1822
1823    setideal(n2,matstabquot(n,vars));
1824
1825
1826{x2**4 - 2*x1*x2**2*x4 + x1**2*x4**2,
1827x3**4 - 2*x1*x3**2*x6 + x1**2*x6**2,
1828x5**4 - 2*x4*x5**2*x6 + x4**2*x6**2,
1829x2**2*x3**2 - 2*x1*x2*x3*x5 + x1**2*x5**2,
1830x3**2*x5**2 - 2*x2*x3*x5*x6 + x2**2*x6**2,
1831x2**3*x3 - x1*x2*x3*x4 - x1*x2**2*x5 + x1**2*x4*x5,
1832x2*x3**3 - x1*x3**2*x5 - x1*x2*x3*x6 + x1**2*x5*x6,
1833x2**2*x3*x4 - x1*x3*x4**2 - x2**3*x5 + x1*x2*x4*x5,
1834x2**2*x3*x5 - x1*x3*x4*x5 - x2**3*x6 + x1*x2*x4*x6,
1835x2*x3**2*x5 - x1*x3*x5**2 - x2**2*x3*x6 + x1*x2*x5*x6,
1836x3**3*x5 - x2*x3**2*x6 - x1*x3*x5*x6 + x1*x2*x6**2,
1837x2**2*x5**2 - x1*x4*x5**2 - x2**2*x4*x6 + x1*x4**2*x6,
1838x2*x3*x5**2 - x1*x5**3 - x2*x3*x4*x6 + x1*x4*x5*x6,
1839x3*x4*x5**2 - x2*x5**3 - x3*x4**2*x6 + x2*x4*x5*x6,
1840x3*x5**3 - x3*x4*x5*x6 - x2*x5**2*x6 + x2*x4*x6**2,
1841x3**2*x4 - 2*x2*x3*x5 + x1*x5**2 + x2**2*x6 - x1*x4*x6}$
1842
1843    modequalp(n1,n2);
1844
1845
1846yes$
1847
1848
1849
1850comment
1851
1852	########################################
1853	###				     ###
1854	###  Test Examples for New Features  ###
1855	###				     ###
1856	########################################
1857
1858end comment;
1859
1860
1861
1862% ==> Testing the different zerodimensional solver
1863
1864	vars:={x,y,z}$
1865
1866
1867	setring(vars,degreeorder vars,revlex);
1868
1869
1870{{x,y,z},{{1,1,1}},revlex,{1,1,1}}$
1871
1872	setideal(m,{x^3+y+z-3,y^3+x+z-3,z^3+x+y-3});
1873
1874
1875{x**3 + y + z - 3,y**3 + x + z - 3,z**3 + x + y - 3}$
1876
1877	zerosolve1 m;
1878
1879
1880{{x + y + z**3 - 3,
1881y + z**3 + z - 3,
1882z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1883{x + y + z**3 - 3,
18842*y + z**3 - 3,
1885z**6 - 2*z**4 - 6*z**3 + 4*z**2 + 6*z + 5},
1886{x + y + z,
1887y**2 + y*z + z**2 - 1,
1888z**3 - z - 3},
1889{x + z**3 + z - 3,
1890y - z,
1891z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1892{x - z,y - z,z**2 + z + 3},
1893{x - 1,y - 1,z - 1}}$
1894
1895	zerosolve2 m;
1896
1897
1898{{x + y + z**3 - 3,
1899y + z**3 + z - 3,
1900z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1901{x + y + z**3 - 3,
19022*y + z**3 - 3,
1903z**6 - 2*z**4 - 6*z**3 + 4*z**2 + 6*z + 5},
1904{x + y + z,
1905y**2 + y*z + z**2 - 1,
1906z**3 - z - 3},
1907{x + z**3 + z - 3,
1908y - z,
1909z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1910{x - z,y - z,z**2 + z + 3},
1911{x - 1,y - 1,z - 1}}$
1912
1913	setring(vars,{},lex)$
1914
1915 setideal(m,m)$
1916
1917 m1:=gbasis m$
1918
1919
1920	zerosolve  m1;
1921
1922
1923{{x - 1,y - 1,z - 1},
1924{x - z,y - z,z**2 + z + 3},
1925{x + y + z,
1926y**2 + y*z + z**2 - 1,
1927z**3 - z - 3},
1928{2*x + z**3 - 3,
19292*y + z**3 - 3,
1930z**6 - 2*z**4 - 6*z**3 + 4*z**2 + 6*z + 5},
1931{x + z**3 + z - 3,
1932y - z,
1933z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1934{x - z,
1935y + z**3 + z - 3,
1936z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8}}$
1937
1938	zerosolve1 m1;
1939
1940
1941{{x - 1,y - 1,z - 1},
1942{x - z,y - z,z**2 + z + 3},
1943{x + y + z,
1944y**2 + y*z + z**2 - 1,
1945z**3 - z - 3},
1946{x - y,
19472*y + z**3 - 3,
1948z**6 - 2*z**4 - 6*z**3 + 4*z**2 + 6*z + 5},
1949{x + z**3 + z - 3,
1950y - z,
1951z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1952{x - z,
1953y + z**3 + z - 3,
1954z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8}}$
1955
1956	zerosolve2 m1;
1957
1958
1959{{x - 1,y - 1,z - 1},
1960{x - z,y - z,z**2 + z + 3},
1961{x + y + z,
1962y**2 + y*z + z**2 - 1,
1963z**3 - z - 3},
1964{x - y,
19652*y + z**3 - 3,
1966z**6 - 2*z**4 - 6*z**3 + 4*z**2 + 6*z + 5},
1967{x + z**3 + z - 3,
1968y - z,
1969z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8},
1970{x - z,
1971y + z**3 + z - 3,
1972z**6 + z**4 - 6*z**3 + z**2 - 3*z + 8}}$
1973
1974
1975% ==> Testing groebfactor, extendedgroebfactor, extendedgroebfactor1
1976
1977  % Gerdt et al. : Seventh order KdV type equation.
1978
1979A1:=-2*L1**2+L1*L2+2*L1*L3-L2**2-7*L5+21*L6$
1980
1981
1982A2:=7*L7-2*L1*L4+3/7*L1**3$
1983
1984
1985B1:=L1*(5*L1-3*L2+L3)$
1986
1987
1988B2:=L1*(2*L6-4*L4)$
1989
1990
1991B3:=L1*L7/2$
1992
1993
1994P1:=L1*(L4-L5/2+L6)$
1995
1996
1997P2:=(2/7*L1**2-L4)*(-10*L1+5*L2-L3)$
1998
1999
2000P3:=(2/7*L1**2-L4)*(3*L4-L5+L6)$
2001
2002
2003P4:=A1*(-3*L1+2*L2)+21*A2$
2004
2005
2006P5:=A1*(2*L4-2*L5)+A2*(-45*L1+15*L2-3*L3)$
2007
2008
2009P6:=2*A1*L7+A2*(12*L4-3*L5+2*L6)$
2010
2011
2012P7:=B1*(2*L2-L1)+7*B2$
2013
2014
2015P8:=B1*L3+7*B2$
2016
2017
2018P9:=B1*(-2*L4-2*L5)+B2*(2*L2-8*L1)+84*B3$
2019
2020
2021P10:=B1*(8/3*L5+6*L6)+B2*(11*L1-17/3*L2+5/3*L3)-168*B3$
2022
2023
2024P11:=15*B1*L7+B2*(5*L4-2*L5)+B3*(-120*L1+30*L2-6*L3)$
2025
2026
2027P12:=-3*B1*L7+B2*(-L4/2+L5/4-L6/2)+B3*(24*L1-6*L2)$
2028
2029
2030P13:=3*B2*L7+B3*(40*L4-8*L5+4*L6)$
2031
2032
2033
2034polys:={P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13};
2035
2036
2037polys := {(l1*(2*l4 - l5 + 2*l6))/2,
2038( - 20*l1**3 + 10*l1**2*l2 - 2*l1**2*l3 + 70*l1*l4 - 35*l2*l4 + 7*l3*l4)/7,
2039(6*l1**2*l4 - 2*l1**2*l5 + 2*l1**2*l6 - 21*l4**2 + 7*l4*l5 - 7*l4*l6)/7,
204015*l1**3 - 7*l1**2*l2 - 6*l1**2*l3 + 5*l1*l2**2 + 4*l1*l2*l3 - 42*l1*l4 + 21*l1*
2041l5 - 63*l1*l6 - 2*l2**3 - 14*l2*l5 + 42*l2*l6 + 147*l7,
2042( - 135*l1**4 + 45*l1**3*l2 - 9*l1**3*l3 + 602*l1**2*l4 + 28*l1**2*l5 - 196*l1*
2043l2*l4 - 14*l1*l2*l5 + 70*l1*l3*l4 - 28*l1*l3*l5 - 2205*l1*l7 - 14*l2**2*l4 + 14*
2044l2**2*l5 + 735*l2*l7 - 147*l3*l7 - 98*l4*l5 + 294*l4*l6 + 98*l5**2 - 294*l5*l6)/
20457,
2046(36*l1**3*l4 - 9*l1**3*l5 + 6*l1**3*l6 - 28*l1**2*l7 + 14*l1*l2*l7 + 28*l1*l3*l7
2047 - 168*l1*l4**2 + 42*l1*l4*l5 - 28*l1*l4*l6 - 14*l2**2*l7 + 588*l4*l7 - 245*l5*
2048l7 + 392*l6*l7)/7,
2049l1*( - 5*l1**2 + 13*l1*l2 - l1*l3 - 6*l2**2 + 2*l2*l3 - 28*l4 + 14*l6),
2050l1*(5*l1*l3 - 3*l2*l3 + l3**2 - 28*l4 + 14*l6),
20512*l1*(11*l1*l4 - 5*l1*l5 - 8*l1*l6 - l2*l4 + 3*l2*l5 + 2*l2*l6 - l3*l4 - l3*l5 +
2052 21*l7),
2053(4*l1*( - 33*l1*l4 + 10*l1*l5 + 39*l1*l6 + 17*l2*l4 - 6*l2*l5 - 22*l2*l6 - 5*l3*
2054l4 + 2*l3*l5 + 7*l3*l6 - 63*l7))/3,
2055l1*(15*l1*l7 - 30*l2*l7 + 12*l3*l7 - 20*l4**2 + 8*l4*l5 + 10*l4*l6 - 4*l5*l6),
2056(l1*( - 6*l1*l7 + 12*l2*l7 - 6*l3*l7 + 4*l4**2 - 2*l4*l5 + 2*l4*l6 + l5*l6 - 2*
2057l6**2))/2,
20584*l1*l7*(2*l4 - l5 + 2*l6)}$
2059
2060vars:={L7,L6,L5,L4,L3,L2,L1};
2061
2062
2063vars := {l7,
2064l6,
2065l5,
2066l4,
2067l3,
2068l2,
2069l1}$
2070
2071clear a1,a2,b1,b2,b3$
2072
2073
2074
2075	off lexefgb;
2076
2077
2078	setring(vars,{},lex);
2079
2080
2081{{l7,l6,l5,l4,l3,l2,l1},{},lex,{1,1,1,1,1,1,1}}$
2082
2083
2084  % The factorized Groebner algorithm.
2085	groebfactor polys;
2086
2087
2088{{l1,l4,l7,21*l6 - 7*l5 - l2**2},
2089{l1,
2090l4,
20917*l5 - l3*l2 + 5*l2**2,
209256*l6 - 5*l3*l2 + 23*l2**2,
2093588*l7 + 7*l3*l2**2 - 37*l2**3},
2094{l1,
2095l7,
2096l3 - 5*l2,
209714*l6 - 21*l4 - l2**2,
209814*l5 - 63*l4 - l2**2},
2099{l1,l4,l2,l5,l7},
2100{7*l4 - 2*l1**2,
2101l2 - 2*l1,
2102l3 - 3*l1,
2103147*l7 - 4*l1**3,
21047*l5 - 6*l1**2,
21057*l6 - l1**2},
2106{7*l4 - 2*l1**2,
21072*l2 - 7*l1,
2108l3 - 6*l1,
2109147*l7 - 4*l1**3,
21107*l5 - 9*l1**2,
211114*l6 - 5*l1**2},
2112{l1,
2113l3 - 5*l2,
211463*l4 + 2*l2**2,
211563*l5 + 2*l2**2,
211663*l6 - 4*l2**2,
21171323*l7 + 10*l2**3},
2118{l1,l2,l3,l7,l5 - l4,l6 + 2*l4},
2119{l2 - 3*l1,
2120l3 - 5*l1,
212114*l4 - 5*l1**2,
212298*l7 - 5*l1**3,
21237*l5 - 10*l1**2,
212414*l6 - 5*l1**2}}$
2125
2126
2127  % The extended Groebner factorizer, producing triangular sets.
2128	extendedgroebfactor polys;
2129
2130
2131{{{98*l7 - 5*l1**3,
213214*l6 - 5*l1**2,
21337*l5 - 10*l1**2,
213414*l4 - 5*l1**2,
2135l3 - 5*l1,
2136l2 - 3*l1},
2137{},
2138{l1}},
2139{{l7,l6 + 2*l4,l5 - l4,l3,l2,l1},{},{l4}},
2140{{1323*l7 + 10*l2**3,
214163*l6 - 4*l2**2,
214263*l5 + 2*l2**2,
214363*l4 + 2*l2**2,
2144l3 - 5*l2,
2145l1},
2146{},
2147{l2}},
2148{{147*l7 - 4*l1**3,
214914*l6 - 5*l1**2,
21507*l5 - 9*l1**2,
21517*l4 - 2*l1**2,
2152l3 - 6*l1,
21532*l2 - 7*l1},
2154{},
2155{l1}},
2156{{147*l7 - 4*l1**3,
21577*l6 - l1**2,
21587*l5 - 6*l1**2,
21597*l4 - 2*l1**2,
2160l3 - 3*l1,
2161l2 - 2*l1},
2162{},
2163{l1}},
2164{{l7,l5,l4,l2,l1},{},{l6,l3}},
2165{{l7,
216614*l6 - (l2**2 + 21*l4),
216714*l5 - (l2**2 + 63*l4),
2168l3 - 5*l2,
2169l1},
2170{},
2171{l4,l2}},
2172{{588*l7 - (37*l2**3 - 7*l2**2*l3),
217356*l6 + (23*l2**2 - 5*l2*l3),
21747*l5 + (5*l2**2 - l2*l3),
2175l4,
2176l1},
2177{},
2178{l3,l2}},
2179{{l7,21*l6 - (l2**2 + 7*l5),l4,l1},{},{l5,l3,l2}}}$
2180
2181
2182  % The extended Groebner factorizer with subproblem removal check.
2183	extendedgroebfactor1 polys;
2184
2185
2186{{{l7,21*l6 - (l2**2 + 7*l5),l4,l1},{},{l5,l3,l2}},
2187{{588*l7 - (37*l2**3 - 7*l2**2*l3),
218856*l6 + (23*l2**2 - 5*l2*l3),
21897*l5 + (5*l2**2 - l2*l3),
2190l4,
2191l1},
2192{},
2193{l3,l2}},
2194{{l7,
219514*l6 - (l2**2 + 21*l4),
219614*l5 - (l2**2 + 63*l4),
2197l3 - 5*l2,
2198l1},
2199{},
2200{l4,l2}},
2201{{l7,l5,l4,l2,l1},{},{l6,l3}},
2202{{147*l7 - 4*l1**3,
22037*l6 - l1**2,
22047*l5 - 6*l1**2,
22057*l4 - 2*l1**2,
2206l3 - 3*l1,
2207l2 - 2*l1},
2208{},
2209{l1}},
2210{{147*l7 - 4*l1**3,
221114*l6 - 5*l1**2,
22127*l5 - 9*l1**2,
22137*l4 - 2*l1**2,
2214l3 - 6*l1,
22152*l2 - 7*l1},
2216{},
2217{l1}},
2218{{1323*l7 + 10*l2**3,
221963*l6 - 4*l2**2,
222063*l5 + 2*l2**2,
222163*l4 + 2*l2**2,
2222l3 - 5*l2,
2223l1},
2224{},
2225{l2}},
2226{{l7,l6 + 2*l4,l5 - l4,l3,l2,l1},{},{l4}},
2227{{98*l7 - 5*l1**3,
222814*l6 - 5*l1**2,
22297*l5 - 10*l1**2,
223014*l4 - 5*l1**2,
2231l3 - 5*l1,
2232l2 - 3*l1},
2233{},
2234{l1}}}$
2235
2236
2237  % Gonnet's example (ACM SIGSAM Bulletin 17 (1983), 48 - 49)
2238
2239vars:={a0,a2,a3,a4,a5,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5};
2240
2241
2242vars := {a0,
2243a2,
2244a3,
2245a4,
2246a5,
2247b0,
2248b1,
2249b2,
2250b3,
2251b4,
2252b5,
2253c0,
2254c1,
2255c2,
2256c3,
2257c4,
2258c5}$
2259
2260polys:={a4*b4,
2261a5*b1+b5+a4*b3+a3*b4,
2262a2*b2,a5*b5,
2263(a0+1+a4)*b2+a2*(b0+b1+b4)+c2,
2264(a0+1+a4)*(b0+b1+b4)+(a3+a5)*b2+a2*(b3+b5)+c0+c1+c4,
2265(a3+a5)*(b0+b1+b4)+(b3+b5)*(a0+1+a4)+c3+c5-1,
2266(a3+a5)*(b3+b5),
2267a5*(b3+b5)+b5*(a3+a5),
2268b5*(a0+1+2*a4)+a5*(b0+b1+2*b4)+a3*b4+a4*b3+c5,
2269a4*(b0+b1+2*b4)+a2*b5+a5*b2+(a0+1)*b4+c4,
2270a2*b4+a4*b2,
2271a4*b5+a5*b4,
22722*a3*b3+a3*b5+a5*b3,
2273c3+b3*(a0+2+a4)+a3*(b0+2*b1+b4)+b5+a5*b1,
2274c1+(a0+2+a4)*b1+a2*b3+a3*b2+(b0+b4),
2275a2*b1+b2,
2276a5*b3+a3*b5,
2277b4+a4*b1};
2278
2279
2280polys := {a4*b4,
2281a3*b4 + a4*b3 + a5*b1 + b5,
2282a2*b2,
2283a5*b5,
2284a0*b2 + a2*b0 + a2*b1 + a2*b4 + a4*b2 + b2 + c2,
2285a0*b0 + a0*b1 + a0*b4 + a2*b3 + a2*b5 + a3*b2 + a4*b0 + a4*b1 + a4*b4 + a5*b2 +
2286b0 + b1 + b4 + c0 + c1 + c4,
2287a0*b3 + a0*b5 + a3*b0 + a3*b1 + a3*b4 + a4*b3 + a4*b5 + a5*b0 + a5*b1 + a5*b4 +
2288b3 + b5 + c3 + c5 - 1,
2289a3*b3 + a3*b5 + a5*b3 + a5*b5,
2290a3*b5 + a5*b3 + 2*a5*b5,
2291a0*b5 + a3*b4 + a4*b3 + 2*a4*b5 + a5*b0 + a5*b1 + 2*a5*b4 + b5 + c5,
2292a0*b4 + a2*b5 + a4*b0 + a4*b1 + 2*a4*b4 + a5*b2 + b4 + c4,
2293a2*b4 + a4*b2,
2294a4*b5 + a5*b4,
22952*a3*b3 + a3*b5 + a5*b3,
2296a0*b3 + a3*b0 + 2*a3*b1 + a3*b4 + a4*b3 + a5*b1 + 2*b3 + b5 + c3,
2297a0*b1 + a2*b3 + a3*b2 + a4*b1 + b0 + 2*b1 + b4 + c1,
2298a2*b1 + b2,
2299a3*b5 + a5*b3,
2300a4*b1 + b4}$
2301
2302
2303	on lexefgb;
2304
2305 % Switching back to the default.
2306	setring(vars,{},lex);
2307
2308
2309{{a0,a2,a3,a4,a5,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5},
2310{},
2311lex,
2312{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}}$
2313
2314	groebfactor polys;
2315
2316
2317{{c5,
2318b5,
2319c2,
2320c4,
2321b2,
2322b4,
2323a4,
2324a2,
2325a5,
2326b3,
2327a3*b1 + 1,
2328b0 - b1*c3 + 2*b1,
2329a0 - a3*c1 + c3,
2330b1*c3**2 - 2*b1*c3 + b1 - c0 + c1*c3 - 2*c1,
2331a3*c0 - a3*c1*c3 + 2*a3*c1 + c3**2 - 2*c3 + 1},
2332{c5,
2333c4,
2334b5,
2335b4,
2336a4,
2337b2,
2338a5,
2339a3,
2340b1,
2341b3 + 1,
2342a0 - c3 + 2,
2343b0*c3 - 2*b0 + c0,
2344a2 - b0 - c1,
2345b0**2 + b0*c1 + c2,
2346b0*c0 + c0*c1 - c2*c3 + 2*c2,
2347c0**2 - c0*c1*c3 + 2*c0*c1 + c2*c3**2 - 4*c2*c3 + 4*c2},
2348{c5,
2349b5,
2350c2,
2351c4,
2352b2,
2353b4,
2354a4,
2355a2,
2356a5,
2357a3,
2358b3 + 1,
2359b0 + b1*c3 + c1,
2360a0 - c3 + 2,
2361b1*c3**2 - 2*b1*c3 + b1 - c0 + c1*c3 - 2*c1}}$
2362
2363	extendedgroebfactor polys;
2364
2365
2366{{{b1*a0 + (b1 + c1),
2367a2,
2368b1*a3 + 1,
2369a4,
2370a5,
2371b0 + b1,
2372b2,
2373b3,
2374b4,
2375b5,
2376c0 + c1,
2377c2,
2378c3 - 1,
2379c4,
2380c5},
2381{b1,b1},
2382{b1,c1}},
2383{{a0,
2384a2 - b0 - c1,
2385a3,
2386a4,
2387a5,
2388b0**2 + c1*b0 + c2,
2389b1,
2390b2,
2391b3 + 1,
2392b4,
2393b5,
2394c0,
2395c3 - 2,
2396c4,
2397c5},
2398{},
2399{c1,c2}},
2400{{a0 + 1,a2,a3,a4,a5,b0 + (b1 + c1),b2,b3 + 1,b4,b5,c0 + c1,c2,c3 - 1,c4,c5},
2401{},
2402{b1,c1}},
2403{{a0 - (c3 - 2),
2404a2,
2405a3,
2406a4,
2407a5,
2408(c3**2 - 2*c3 + 1)*b0 + (c0*c3 + c1),
2409(c3**2 - 2*c3 + 1)*b1 - (c0 - c1*c3 + 2*c1),
2410b2,
2411b3 + 1,
2412b4,
2413b5,
2414c2,
2415c4,
2416c5},
2417{c3**2 - 2*c3 + 1,c3**2 - 2*c3 + 1},
2418{c0,c1,c3}},
2419{{a0 - (c3 - 2),
2420(c3 - 2)*a2 + c0 - (c1*c3 - 2*c1),
2421a3,
2422a4,
2423a5,
2424(c3 - 2)*b0 + c0,
2425b1,
2426b2,
2427b3 + 1,
2428b4,
2429b5,
2430c0**2 - (c1*c3 - 2*c1)*c0 + (c2*c3**2 - 4*c2*c3 + 4*c2),
2431c4,
2432c5},
2433{c3 - 2,c3 - 2},
2434{c1,c2,c3}},
2435{{(c0 - c1*c3 + 2*c1)*a0 + (c0*c3 + c1),
2436a2,
2437(c0 - c1*c3 + 2*c1)*a3 + (c3**2 - 2*c3 + 1),
2438a4,
2439a5,
2440(c3**2 - 2*c3 + 1)*b0 - (c0*c3 - 2*c0 - c1*c3**2 + 4*c1*c3 - 4*c1),
2441(c3**2 - 2*c3 + 1)*b1 - (c0 - c1*c3 + 2*c1),
2442b2,
2443b3,
2444b4,
2445b5,
2446c2,
2447c4,
2448c5},
2449{c0 - c1*c3 + 2*c1,
2450c0 - c1*c3 + 2*c1,
2451c3**2 - 2*c3 + 1,
2452c3**2 - 2*c3 + 1},
2453{c0,c1,c3}}}$
2454
2455	extendedgroebfactor1 polys;
2456
2457
2458{{{(c0 - c1*c3 + 2*c1)*a0 + (c0*c3 + c1),
2459a2,
2460(c0 - c1*c3 + 2*c1)*a3 + (c3**2 - 2*c3 + 1),
2461a4,
2462a5,
2463(c3**2 - 2*c3 + 1)*b0 - (c0*c3 - 2*c0 - c1*c3**2 + 4*c1*c3 - 4*c1),
2464(c3**2 - 2*c3 + 1)*b1 - (c0 - c1*c3 + 2*c1),
2465b2,
2466b3,
2467b4,
2468b5,
2469c2,
2470c4,
2471c5},
2472{c0 - c1*c3 + 2*c1,
2473c0 - c1*c3 + 2*c1,
2474c3**2 - 2*c3 + 1,
2475c3**2 - 2*c3 + 1},
2476{c0,c1,c3}},
2477{{a0 - (c3 - 2),
2478(c3 - 2)*a2 + c0 - (c1*c3 - 2*c1),
2479a3,
2480a4,
2481a5,
2482(c3 - 2)*b0 + c0,
2483b1,
2484b2,
2485b3 + 1,
2486b4,
2487b5,
2488c0**2 - (c1*c3 - 2*c1)*c0 + (c2*c3**2 - 4*c2*c3 + 4*c2),
2489c4,
2490c5},
2491{c3 - 2,c3 - 2},
2492{c1,c2,c3}},
2493{{a0 - (c3 - 2),
2494a2,
2495a3,
2496a4,
2497a5,
2498(c3**2 - 2*c3 + 1)*b0 + (c0*c3 + c1),
2499(c3**2 - 2*c3 + 1)*b1 - (c0 - c1*c3 + 2*c1),
2500b2,
2501b3 + 1,
2502b4,
2503b5,
2504c2,
2505c4,
2506c5},
2507{c3**2 - 2*c3 + 1,c3**2 - 2*c3 + 1},
2508{c0,c1,c3}}}$
2509
2510
2511  % Schwarz' example s5
2512
2513vars:=for k:=1:5 collect mkid(x,k);
2514
2515
2516vars := {x1,
2517x2,
2518x3,
2519x4,
2520x5}$
2521
2522
2523s5:={
2524x1**2+x1+2*x2*x5+2*x3*x4,
25252*x1*x2+x2+2*x3*x5+x4**2,
25262*x1*x3+x2**2+x3+2*x4*x5,
25272*x1*x4+2*x2*x3+x4+x5**2,
25282*x1*x5+2*x2*x4+x3**2+x5};
2529
2530
2531s5 := {x1**2 + x1 + 2*x2*x5 + 2*x3*x4,
25322*x1*x2 + x2 + 2*x3*x5 + x4**2,
25332*x1*x3 + x2**2 + x3 + 2*x4*x5,
25342*x1*x4 + 2*x2*x3 + x4 + x5**2,
25352*x1*x5 + 2*x2*x4 + x3**2 + x5}$
2536
2537
2538	setring(vars,degreeorder vars,revlex);
2539
2540
2541{{x1,x2,x3,x4,x5},{{1,1,1,1,1}},revlex,{1,1,1,1,1}}$
2542
2543	m:=groebfactor s5;
2544
2545
2546m := {{x1**2 + 2*x3*x4 + 2*x2*x5 + x1,
25472*x1*x2 + x4**2 + 2*x3*x5 + x2,
2548x2**2 + 2*x1*x3 + 2*x4*x5 + x3,
25492*x2*x3 + 2*x1*x4 + x5**2 + x4,
2550x3**2 + 2*x2*x4 + 2*x1*x5 + x5,
25512*x1*x3*x4 + 2*x4**2*x5 + x3*x5**2 + x3*x4,
25525*x4**3 + 30*x3*x4*x5 + 15*x2*x5**2 - 2*x5,
255310*x3*x4**2 - 10*x1*x5**2 - 5*x5**2 - x4,
2554625*x4*x5**3 + 50*x3*x4 + 75*x2*x5 - 6,
255515*x2*x4**2 + 30*x1*x4*x5 + 5*x5**3 + 15*x4*x5 + x3,
2556100*x1*x4*x5**2 + 25*x5**4 + 50*x4*x5**2 + x4**2 + 4*x3*x5,
25571250*x1*x3*x5**2 + 625*x3*x5**2 - 75*x3*x4 - 50*x2*x5 + 8,
255875*x4**2*x5**2 + 50*x3*x5**3 + x2*x4 + 4*x1*x5 + 2*x5,
2559150*x3*x4*x5**2 + 100*x2*x5**3 - 2*x1*x4 - 13*x5**2 - x4,
2560625*x2*x5**4 - 50*x1*x4*x5 - 75*x5**3 - 25*x4*x5 - x3,
25611250*x3*x5**4 - 200*x2*x4*x5 - 50*x1*x5**2 - 25*x5**2 + 3*x4,
2562625*x5**5 + 375*x4**2*x5 + 500*x3*x5**2 + 24*x1 + 12,
256310*x1*x4**2 + 20*x1*x3*x5 + 20*x4*x5**2 + 5*x4**2 + 10*x3*x5 + x2,
256475*x2*x4*x5**2 + 50*x1*x5**3 + 25*x5**3 - 2*x1*x3 - 3*x4*x5 - x3,
25651250*x1*x5**4 + 625*x5**4 + 100*x1*x3*x5 + 150*x4*x5**2 + 50*x3*x5 + 3*x2},
2566{x5,x2,x4,x3,x1},
2567{x5,x2,x4,x3,x1 + 1}}$
2568
2569
2570  % Recompute a list of problems with listgroebfactor for another term
2571  % order.
2572	setring(vars,{},lex);
2573
2574
2575{{x1,x2,x3,x4,x5},{},lex,{1,1,1,1,1}}$
2576
2577	listgroebfactor m;
2578
2579
2580{{5*x5 - 1,
25815*x4 - 1,
25825*x1 + 4,
25835*x2 - 1,
25845*x3 - 1},
2585{5*x5 + 1,
25865*x4 + 1,
25875*x1 + 1,
25885*x2 + 1,
25895*x3 + 1},
2590{5*x1 + 2,
2591x2 - x5,
259225*x5**2 - 5*x5 - 1,
25935*x4 + 5*x5 - 1,
25945*x3 + 5*x5 - 1},
2595{5*x1 + 3,
2596x2 - x5,
259725*x5**2 + 5*x5 - 1,
25985*x4 + 5*x5 + 1,
25995*x3 + 5*x5 + 1},
2600{5*x1 + 3,
26015*x4 - 25*x5**2 + 10*x5 - 2,
2602x3 - 25*x5**3 + 15*x5**2 - 3*x5,
26035*x2 + 125*x5**3 - 50*x5**2 + 10*x5 - 1,
2604625*x5**4 - 375*x5**3 + 100*x5**2 - 10*x5 + 1},
2605{5*x1 + 2,
26065*x2 + 5*x5 - 1,
26075*x4 - 250*x5**3 + 75*x5**2 - 30*x5 + 2,
26085*x3 + 250*x5**3 - 75*x5**2 + 30*x5 - 3,
2609625*x5**4 - 250*x5**3 + 100*x5**2 - 15*x5 + 1},
2610{x4 + 5*x5**2,
26115*x1 + 1,
2612x3 - 25*x5**3,
26135*x2 + 125*x5**3 - 25*x5**2 + 5*x5 - 1,
2614625*x5**4 - 125*x5**3 + 25*x5**2 - 5*x5 + 1},
2615{x4 - 5*x5**2,
26165*x1 + 4,
2617x3 - 25*x5**3,
26185*x2 + 125*x5**3 + 25*x5**2 + 5*x5 + 1,
2619625*x5**4 + 125*x5**3 + 25*x5**2 + 5*x5 + 1},
2620{5*x1 + 3,
26215*x2 + 5*x5 + 1,
26225*x4 - 250*x5**3 - 75*x5**2 - 30*x5 - 2,
26235*x3 + 250*x5**3 + 75*x5**2 + 30*x5 + 3,
2624625*x5**4 + 250*x5**3 + 100*x5**2 + 15*x5 + 1},
2625{5*x1 + 2,
26265*x4 + 25*x5**2 + 10*x5 + 2,
2627x3 - 25*x5**3 - 15*x5**2 - 3*x5,
26285*x2 + 125*x5**3 + 50*x5**2 + 10*x5 + 1,
2629625*x5**4 + 375*x5**3 + 100*x5**2 + 10*x5 + 1},
2630{x5,
2631x2,
2632x4,
2633x3,
2634x1 + 1},
2635{x5,
2636x2,
2637x4,
2638x3,
2639x1}}$
2640
2641
2642
2643% ==> Testing the linear algebra package
2644
2645  % Find the ideal of points in affine and projective space.
2646
2647	vars:=for k:=1:6 collect mkid(x,k);
2648
2649
2650vars := {x1,
2651x2,
2652x3,
2653x4,
2654x5,
2655x6}$
2656
2657	setring(vars,degreeorder vars,revlex);
2658
2659
2660{{x1,x2,x3,x4,x5,x6},{{1,1,1,1,1,1}},revlex,{1,1,1,1,1,1}}$
2661
2662	matrix mm(10,6);
2663
2664
2665	on rounded;
2666
2667
2668	for k:=1:6 do for l:=1:10 do mm(l,k):=floor(exp((k+l)/4));
2669
2670
2671	off rounded;
2672
2673
2674	mm;
2675
2676
2677mat((1,2,2,3,4,5),(2,2,3,4,5,7),(2,3,4,5,7,9),(3,4,5,7,9,12),(4,5,7,9,12,15),(5,
26787,9,12,15,20),(7,9,12,15,20,25),(9,12,15,20,25,33),(12,15,20,25,33,42),(15,20,25
2679,33,42,54))$
2680
2681	setideal(u,affine_points mm);
2682
2683
2684{48337*x5**2 - 318*x4*x6 - 75336*x5*x6 + 29579*x6**2 - 11598*x1 - 11016*x2 -
268511352*x3 - 2502*x4 + 18371*x5 - 1837*x6 - 1836,
2686386696*x3*x6 + 239238*x4*x6 - 185716*x5*x6 - 182039*x6**2 - 270738*x1 - 1255800*
2687x2 - 5052384*x3 - 2106864*x4 + 2351946*x5 + 2434483*x6 - 1562736,
268848337*x4**2 - 58746*x4*x6 + 148*x5*x6 + 17725*x6**2 + 2502*x1 + 576*x2 - 1302*x3
2689 + 25721*x4 - 3488*x5 - 12857*x6 + 96,
2690193348*x4*x5 - 151394*x4*x6 - 118604*x5*x6 + 92869*x6**2 + 1590*x1 + 8712*x2 +
269116560*x3 - 3708*x4 + 43918*x5 - 43409*x6 + 1452,
2692386696*x1*x6 + 175678*x4*x6 + 20108*x5*x6 - 233347*x6**2 - 5821074*x1 - 831000*
2693x2 + 1382952*x3 + 741984*x4 - 2153934*x5 + 2692351*x6 - 1491936,
2694386696*x2*x6 - 382090*x4*x6 - 43364*x5*x6 + 123645*x6**2 - 1313130*x1 - 4809120*
2695x2 + 91464*x3 + 5853096*x4 + 1118658*x5 - 2323361*x6 - 28128,
2696193348*x3*x4 - 19782*x4*x6 - 57060*x5*x6 + 1407*x6**2 - 86718*x1 - 378840*x2 -
26971475924*x3 - 576996*x4 + 715078*x5 + 671885*x6 - 449836,
2698386696*x3*x5 + 184150*x4*x6 - 329484*x5*x6 + 3733*x6**2 - 302634*x1 - 1062840*x2
2699 - 3845096*x3 - 1562608*x4 + 1956858*x5 + 1752663*x6 - 1143880,
2700193348*x6**3 - 78919578*x4*x6 - 63413004*x5*x6 + 81565689*x6**2 + 1412352942*x1
2701+ 1563160200*x2 + 761482008*x3 + 10324224*x4 + 304232130*x5 - 1255484065*x6 -
2702643375200,
270396674*x3**2 + 56278*x4*x6 - 44916*x5*x6 - 20423*x6**2 - 85218*x1 - 315900*x2 -
27041104614*x3 - 478348*x4 + 559514*x5 + 528787*x6 - 342672,
2705193348*x1*x4 - 3606*x4*x6 + 6664*x5*x6 - 36689*x6**2 - 1729374*x1 - 256248*x2 +
2706422132*x3 + 345556*x4 - 671778*x5 + 747089*x6 - 429404,
2707193348*x2*x4 - 186922*x4*x6 - 13484*x5*x6 + 80823*x6**2 - 400398*x1 - 1437268*x2
2708 + 32400*x3 + 1825348*x4 + 346526*x5 - 749039*x6 - 13972,
2709386696*x1*x5 + 139942*x4*x6 - 99156*x5*x6 - 94107*x6**2 - 4388370*x1 - 668088*x2
2710 + 1063040*x3 + 468112*x4 - 1464774*x5 + 1964239*x6 - 1078088,
2711386696*x2*x5 - 299774*x4*x6 - 183476*x5*x6 + 214259*x6**2 - 1032390*x1 - 3818088
2712*x2 + 38568*x3 + 4563624*x4 + 1175646*x5 - 2005927*x6 - 56304,
2713193348*x5*x6**2 - 59111766*x4*x6 - 58092824*x5*x6 + 68856463*x6**2 + 1134803514*
2714x1 + 1224865560*x2 + 591403776*x3 - 36549312*x4 + 316517430*x5 - 1023460331*x6 -
2715 498675720,
2716193348*x1**2 + 50726*x4*x6 + 4164*x5*x6 - 49995*x6**2 - 1502518*x1 - 234624*x2 +
2717 337000*x3 + 189344*x4 - 544926*x5 + 709519*x6 - 425800,
2718193348*x1*x2 - 22834*x4*x6 - 3056*x5*x6 - 4123*x6**2 - 1183010*x1 - 780060*x2 +
2719282940*x3 + 989552*x4 - 238902*x5 + 102179*x6 - 226684,
272096674*x2**2 - 69590*x4*x6 - 7908*x5*x6 + 35327*x6**2 - 243426*x1 - 832910*x2 +
272114700*x3 + 1041208*x4 + 204662*x5 - 420851*x6 - 26032,
2722386696*x1*x3 + 153254*x4*x6 - 46332*x5*x6 - 109011*x6**2 - 2706290*x1 - 776040*
2723x2 - 650592*x3 - 288096*x4 - 295470*x5 + 1856303*x6 - 1096080,
2724386696*x2*x3 - 95202*x4*x6 - 92692*x5*x6 + 63421*x6**2 - 736122*x1 - 2670472*x2
2725- 1669344*x3 + 2061800*x4 + 1466002*x5 - 394913*x6 - 509528,
272696674*x4*x6**2 - 29277416*x4*x6 - 19752504*x5*x6 + 28388673*x6**2 + 433544670*x1
2727 + 473916360*x2 + 235723620*x3 + 39729120*x4 + 97903830*x5 - 411516489*x6 -
2728188800920}$
2729 setgbasis u$
2730
2731 dim u;
2732
2733
27340$
2735 degree u;
2736
2737
273810$
2739
2740	setideal(u,proj_points mm);
2741
2742
2743{457380*x5**3 - 13500*x2*x5*x6 - 20835*x3*x5*x6 + 76950*x4*x5*x6 - 1050234*x5**2
2744*x6 + 100*x1*x6**2 + 10800*x2*x6**2 + 16568*x3*x6**2 - 60271*x4*x6**2 + 771366*
2745x5*x6**2 - 179875*x6**3,
2746330*x4**2 + 1665*x2*x5 + 555*x3*x5 - 4337*x4*x5 - 626*x5**2 + 6*x1*x6 - 1332*x2*
2747x6 - 450*x3*x6 + 3013*x4*x6 + 2740*x5*x6 - 1635*x6**2,
274833*x1*x5 - 90*x2*x5 - 63*x3*x5 + 216*x4*x5 + 60*x5**2 - 25*x1*x6 + 72*x2*x6 + 49
2749*x3*x6 - 170*x4*x6 - 171*x5*x6 + 97*x6**2,
275090*x3**2 - 483*x2*x5 - 183*x3*x5 + 1197*x4*x5 + 174*x5**2 - 2*x1*x6 + 384*x2*x6
2751+ 68*x3*x6 - 937*x4*x6 - 738*x5*x6 + 485*x6**2,
2752330*x3*x4 + 555*x2*x5 + 75*x3*x5 - 1519*x4*x5 - 172*x5**2 + 2*x1*x6 - 444*x2*x6
2753- 260*x3*x6 + 1041*x4*x6 + 950*x5*x6 - 545*x6**2,
2754457380*x4*x5**2 - 10800*x2*x5*x6 - 9045*x3*x5*x6 - 662625*x4*x5*x6 - 265413*x5**
27552*x6 + 80*x1*x6**2 + 8640*x2*x6**2 + 7156*x3*x6**2 + 238408*x4*x6**2 + 391452*x5
2756*x6**2 - 143900*x6**3,
2757495*x1*x2 + 1977*x2*x5 + 87*x3*x5 - 4824*x4*x5 - 339*x5**2 - 164*x1*x6 - 1707*x2
2758*x6 - 97*x3*x6 + 3782*x4*x6 + 2697*x5*x6 - 1840*x6**2,
2759495*x2**2 + 1134*x2*x5 + 939*x3*x5 - 3771*x4*x5 - 822*x5**2 - 4*x1*x6 - 1257*x2*
2760x6 - 734*x3*x6 + 2956*x4*x6 + 2709*x5*x6 - 1550*x6**2,
2761990*x1*x3 - 5043*x2*x5 - 1263*x3*x5 + 12321*x4*x5 + 1866*x5**2 - 464*x1*x6 +
27624008*x2*x6 + 788*x3*x6 - 9643*x4*x6 - 7968*x5*x6 + 5165*x6**2,
2763495*x2*x3 + 1242*x2*x5 - 48*x3*x5 - 3555*x4*x5 - 267*x5**2 + 4*x1*x6 - 1218*x2*
2764x6 - 157*x3*x6 + 2786*x4*x6 + 2142*x5*x6 - 1420*x6**2,
276566*x1*x4 + 345*x2*x5 + 93*x3*x5 - 861*x4*x5 - 120*x5**2 - 38*x1*x6 - 276*x2*x6 -
2766 76*x3*x6 + 659*x4*x6 + 540*x5*x6 - 337*x6**2,
2767495*x2*x4 + 1770*x2*x5 + 645*x3*x5 - 4908*x4*x5 - 729*x5**2 + 4*x1*x6 - 1713*x2*
2768x6 - 520*x3*x6 + 3677*x4*x6 + 3165*x5*x6 - 1915*x6**2,
2769152460*x3*x5**2 + 5880*x2*x5*x6 - 237983*x3*x5*x6 - 6896*x4*x5*x6 - 71438*x5**2*
2770x6 + 64*x1*x6**2 - 4704*x2*x6**2 + 92748*x3*x6**2 + 5427*x4*x6**2 + 113560*x5*x6
2771**2 - 45061*x6**3,
2772990*x1**2 - 1893*x2*x5 + 447*x3*x5 + 3771*x4*x5 + 426*x5**2 - 524*x1*x6 + 1488*
2773x2*x6 - 322*x3*x6 - 2923*x4*x6 - 2478*x5*x6 + 1715*x6**2,
2774457380*x2*x5**2 - 754524*x2*x5*x6 - 31530*x3*x5*x6 + 156561*x4*x5*x6 - 132597*x5
2775**2*x6 + 136*x1*x6**2 + 310896*x2*x6**2 + 25088*x3*x6**2 - 122581*x4*x6**2 +
2776141732*x5*x6**2 - 30097*x6**3}$
2777 setgbasis u$
2778
2779 dim u;
2780
2781
27821$
2783 degree u;
2784
2785
278610$
2787
2788
2789  % Change the term order to pure lex in dimension zero.
2790  % Test both approaches, with and without precomputed borderbasis.
2791
2792	vars:=for k:=1:6 collect mkid(x,k);
2793
2794
2795vars := {x1,
2796x2,
2797x3,
2798x4,
2799x5,
2800x6}$
2801
2802	r1:=setring(vars,{},lex);
2803
2804
2805r1 := {{x1,x2,x3,x4,x5,x6},{},lex,{1,1,1,1,1,1}}$
2806
2807	r2:=setring(vars,degreeorder vars,revlex);
2808
2809
2810r2 := {{x1,x2,x3,x4,x5,x6},{{1,1,1,1,1,1}},revlex,{1,1,1,1,1,1}}$
2811
2812	setideal(m,{x1**2+x1+2*x2*x6+2*x3*x5+x4**2,
2813		2*x1*x2+x2+2*x3*x6+2*x4*x5,
2814		2*x1*x3+x2**2+x3+2*x4*x6+x5**2,
2815		2*x1*x4+2*x2*x3+x4+2*x5*x6,
2816		2*x1*x5+2*x2*x4+x3**2+x5+x6**2,
2817		2*x1*x6+2*x2*x5+2*x3*x4+x6});
2818
2819
2820{x1**2 + x4**2 + 2*x3*x5 + 2*x2*x6 + x1,
28212*x1*x2 + 2*x4*x5 + 2*x3*x6 + x2,
2822x2**2 + 2*x1*x3 + x5**2 + 2*x4*x6 + x3,
28232*x2*x3 + 2*x1*x4 + 2*x5*x6 + x4,
2824x3**2 + 2*x2*x4 + 2*x1*x5 + x6**2 + x5,
28252*x3*x4 + 2*x2*x5 + 2*x1*x6 + x6}$
2826
2827	gbasis m;
2828
2829
2830{72*x1*x3*x5*x6 + 36*x3*x5*x6 - 2*x1*x6 - x6,
28312*x1*x2 + 2*x4*x5 + 2*x3*x6 + x2,
28322*x2*x3 + 2*x1*x4 + 2*x5*x6 + x4,
28332*x3*x4 + 2*x2*x5 + 2*x1*x6 + x6,
283410368*x6**7 + 5040*x4*x6**4 + 140*x4**2*x6 + 252*x2*x6**2 - 15*x6,
28351296*x4*x6**5 + 180*x4**2*x6**2 + 180*x2*x6**3 + 4*x2*x4 - 15*x6**2,
28362592*x3*x6**5 - 360*x2*x5*x6**2 + 2*x1*x4 + 12*x5*x6 + x4,
283772*x3*x5**2*x6 + 72*x2*x5*x6**2 - 2*x1*x4 - 8*x5*x6 - x4,
283836*x2*x5**3 - 108*x1*x4*x6**2 - 72*x5*x6**3 - 54*x4*x6**2 - 5*x3*x6,
283918*x4**2*x5 + 18*x3*x5**2 - 18*x1*x6**2 - 9*x6**2 - 2*x5,
284036*x4*x5**2 + 36*x4**2*x6 + 72*x3*x5*x6 + 36*x2*x6**2 - 5*x6,
2841x1**2 + x4**2 + 2*x3*x5 + 2*x2*x6 + x1,
2842x2**2 + 2*x1*x3 + x5**2 + 2*x4*x6 + x3,
2843x3**2 + 2*x2*x4 + 2*x1*x5 + x6**2 + x5,
28442592*x5*x6**5 + 360*x4*x5*x6**2 + 360*x3*x6**3 - 2*x2*x5 + 10*x1*x6 + 5*x6,
28452592*x5**2*x6**3 + 1296*x4*x6**4 + 36*x4**2*x6 + 144*x3*x5*x6 + 180*x2*x6**2 -
284613*x6,
284772*x5**3*x6 + 216*x4*x5*x6**2 + 72*x3*x6**3 + 2*x2*x5 + 6*x1*x6 + 3*x6,
28484*x4**3 - 12*x2*x5**2 - 24*x1*x5*x6 - 4*x6**3 - 12*x5*x6 - x4,
284912*x2*x4**2 - 24*x1*x3*x6 - 12*x5**2*x6 - 12*x4*x6**2 - 12*x3*x6 - x2,
28501296*x1*x6**5 + 648*x6**5 + 180*x1*x4*x6**2 + 180*x5*x6**3 + 90*x4*x6**2 + x4*x5
2851 + 6*x3*x6,
28522592*x2*x6**5 + 360*x2*x4*x6**2 - 180*x6**4 - 6*x1*x3 - 3*x5**2 - 16*x4*x6 - 3*
2853x3,
285472*x3*x5*x6**3 + 36*x2*x6**4 - x2*x5**2 - 4*x2*x4*x6 - 4*x1*x5*x6 - 6*x6**3 - 2*
2855x5*x6,
2856648*x4*x5*x6**3 + 324*x3*x6**4 - 9*x3*x5**2 - 18*x2*x5*x6 + 18*x1*x6**2 + 9*x6**
28572 + x5,
28582592*x1*x3*x6**3 + 1296*x4*x6**4 + 1296*x3*x6**3 - 36*x4**2*x6 - 72*x3*x5*x6 +
285936*x2*x6**2 + 5*x6,
28601080*x2*x4*x6**3 + 216*x6**5 - 60*x1*x3*x6 - 30*x5**2*x6 - 90*x4*x6**2 - 30*x3*
2861x6 - x2,
286272*x4**2*x6**3 + 36*x2*x6**4 + 3*x2*x5**2 + 8*x2*x4*x6 + 6*x1*x5*x6 - 2*x6**3 +
28633*x5*x6,
286436*x1*x5**2*x6 + 36*x1*x4*x6**2 + 36*x5*x6**3 + 18*x5**2*x6 + 18*x4*x6**2 + x4*
2865x5 + 2*x3*x6,
286618*x1*x5**3 - 54*x1*x3*x6**2 - 36*x4*x6**3 + 9*x5**3 - 27*x3*x6**2 + x3*x5 - 2*
2867x2*x6,
286818*x1*x4*x5 + 18*x1*x3*x6 + 18*x5**2*x6 + 18*x4*x6**2 + 9*x4*x5 + 9*x3*x6 + x2,
286918*x2*x4*x5 + 18*x1*x5**2 + 18*x1*x4*x6 + 18*x5*x6**2 + 9*x5**2 + 9*x4*x6 + x3,
28702*x1*x4**2 + 4*x1*x3*x5 + 2*x5**3 + 8*x4*x5*x6 + 2*x3*x6**2 + x4**2 + 2*x3*x5,
287172*x1*x4*x6**3 + 36*x5*x6**4 + 36*x4*x6**3 - 2*x1*x3*x5 - x5**3 - 2*x4*x5*x6 + 2
2872*x3*x6**2 - x3*x5,
28733240*x1*x5*x6**3 + 648*x6**5 + 1620*x5*x6**3 + 90*x1*x3*x6 + 90*x5**2*x6 + 180*
2874x4*x6**2 + 45*x3*x6 + 2*x2,
287572*x2*x5**2*x6 + 72*x2*x4*x6**2 + 144*x1*x5*x6**2 + 36*x6**4 + 72*x5*x6**2 - 2*
2876x1*x3 - x5**2 - x3,
287736*x5**4 - 216*x4**2*x6**2 - 432*x3*x5*x6**2 - 288*x2*x6**3 + 2*x2*x4 + 8*x1*x5
2878+ 39*x6**2 + 4*x5,
287972*x3*x5**3 - 216*x1*x5*x6**2 - 36*x6**4 - 108*x5*x6**2 - 2*x1*x3 - 9*x5**2 - 8*
2880x4*x6 - x3,
28811296*x2*x5*x6**3 + 648*x1*x6**4 + 324*x6**4 - 18*x1*x5**2 - 36*x1*x4*x6 - 72*x5*
2882x6**2 - 9*x5**2 - 18*x4*x6 - x3,
288318*x1*x3*x5**2 + 18*x4**2*x6**2 + 54*x3*x5*x6**2 + 36*x2*x6**3 + 9*x3*x5**2 - x2
2884*x4 - 2*x1*x5 - 5*x6**2 - x5}$
2885
2886	m1:=change_termorder(m,r1);
2887
2888
2889m1 := {46656*x4*x5*x6**6 - x4*x5,
289080621568*x5*x6**13 + 44928*x5*x6**7 - x5*x6,
2891637*x2 + 1077507256320*x6**17 - 927987840*x6**11 - 806157*x6**5,
28927*x4**2*x5 + 252*x4*x5*x6**3 - 30233088*x5*x6**12 - 17496*x5*x6**6,
289358773123072*x6**19 - 47869056*x6**13 - 45657*x6**7 + x6,
28942*x1*x4 + x4 + 1296*x5**3*x6**3 + 3*x5*x6,
28952548*x4**2*x6 + 91728*x4*x6**4 + 362797056*x6**13 - 33696*x6**7 - 141*x6,
28968491392*x4*x6**7 - 182*x4*x6 + 19591041024*x6**16 + 10917504*x6**10 - 243*x6**4,
289717199*x5**4*x6 + 1238328*x5**2*x6**5 + 4353564672*x6**15 - 5003856*x6**9 - 1328*
2898x6**3,
28994245696*x5**2*x6**7 - 91*x5**2*x6 + 8707129344*x6**17 - 12130560*x6**11 + 256*x6
2900**5,
29017*x3 - 567*x5**5 - 204120*x5**3*x6**4 + 524880*x5*x6**8 - 90*x5*x6**2,
29022916*x5**7 - 567*x5**3*x6**2 + 347680512*x5*x6**12 + 196668*x5*x6**6 - 4*x5,
290314*x1*x6 + 504*x4*x5*x6**2 + 252*x5**3*x6 + 20155392*x5*x6**11 + 8640*x5*x6**5 +
2904 7*x6,
29052548*x4**3 + 19813248*x4*x6**6 - 637*x4 + 39182082048*x6**15 + 30326400*x6**9 +
29064428*x6**3,
29071911*x4*x5**2 - 68796*x4*x6**4 - 68796*x5**2*x6**3 - 362797056*x6**13 + 151632*
2908x6**7 + 50*x6,
29091274*x1*x5 + 1651104*x4*x6**5 + 5733*x5**4 + 1238328*x5**2*x6**4 + 637*x5 +
29106530347008*x6**14 - 1667952*x6**8 + 192*x6**2,
29111274*x1**2 + 1274*x1 + 1274*x4**2 + 206388*x5**6 - 85995*x5**2*x6**2 -
291211754624614400*x6**18 + 9498228480*x6**12 + 9295668*x6**6}$
2913
2914	setring r2$
2915
2916 m2:=change_termorder1(m,r1);
2917
2918
2919m2 := {46656*x4*x5*x6**6 - x4*x5,
292080621568*x5*x6**13 + 44928*x5*x6**7 - x5*x6,
29212*x1*x4 + x4 + 1296*x5**3*x6**3 + 3*x5*x6,
2922637*x2 + 1077507256320*x6**17 - 927987840*x6**11 - 806157*x6**5,
29237*x4**2*x5 + 252*x4*x5*x6**3 - 30233088*x5*x6**12 - 17496*x5*x6**6,
292458773123072*x6**19 - 47869056*x6**13 - 45657*x6**7 + x6,
29252548*x4**2*x6 + 91728*x4*x6**4 + 362797056*x6**13 - 33696*x6**7 - 141*x6,
292617199*x5**4*x6 + 1238328*x5**2*x6**5 + 4353564672*x6**15 - 5003856*x6**9 - 1328*
2927x6**3,
29284245696*x5**2*x6**7 - 91*x5**2*x6 + 8707129344*x6**17 - 12130560*x6**11 + 256*x6
2929**5,
29307*x3 - 567*x5**5 - 204120*x5**3*x6**4 + 524880*x5*x6**8 - 90*x5*x6**2,
29318491392*x4*x6**7 - 182*x4*x6 + 19591041024*x6**16 + 10917504*x6**10 - 243*x6**4,
29322916*x5**7 - 567*x5**3*x6**2 + 347680512*x5*x6**12 + 196668*x5*x6**6 - 4*x5,
293314*x1*x6 + 504*x4*x5*x6**2 + 252*x5**3*x6 + 20155392*x5*x6**11 + 8640*x5*x6**5 +
2934 7*x6,
29351911*x4*x5**2 - 68796*x4*x6**4 - 68796*x5**2*x6**3 - 362797056*x6**13 + 151632*
2936x6**7 + 50*x6,
29372548*x4**3 + 19813248*x4*x6**6 - 637*x4 + 39182082048*x6**15 + 30326400*x6**9 +
29384428*x6**3,
29391274*x1*x5 + 1651104*x4*x6**5 + 5733*x5**4 + 1238328*x5**2*x6**4 + 637*x5 +
29406530347008*x6**14 - 1667952*x6**8 + 192*x6**2,
29411274*x1**2 + 1274*x1 + 1274*x4**2 + 206388*x5**6 - 85995*x5**2*x6**2 -
294211754624614400*x6**18 + 9498228480*x6**12 + 9295668*x6**6}$
2943
2944	setideal(m1,m1)$
2945
2946 setideal(m2,m2)$
2947
2948
2949	setgbasis m1$
2950
2951 setgbasis m2$
2952
2953 modequalp(m1,m2);
2954
2955
2956yes$
2957
2958
2959% ==> Different hilbert series driver
2960
2961    setideal(m,proj_monomial_curve(w1:={0,2,5,9},{w,x,y,z}));
2962
2963
2964{x**5 - w**3*y**2,
2965w*y**3 - x**3*z,
2966y**4 - w*x*z**2,
2967x**2*y - w**2*z}$
2968
2969    weights:={{1,1,1,1},w1};
2970
2971
2972weights := {{1,1,1,1},{0,2,5,9}}$
2973
2974    hftestversion 2;
2975
2976
2977hf!=whilb2$
2978
2979    f1:=weightedhilbertseries(gbasis m,weights);
2980
2981
2982f1 := ( - w**5*x**17 + w**4*x**17 - w**4*x**15 + w**4*x**8 + w**3*x**15 + w**3*x
2983**12 + w**3*x**6 + w**2*x**10 + w**2*x**7 + w**2*x**4 + w*x**5 + w*x**2 + 1)/(w
2984**2*x**9 - w*x**9 - w + 1)$
2985
2986    sub(x=1,ws);
2987
2988
2989( - w**5 + w**4 + 3*w**3 + 3*w**2 + 2*w + 1)/(w**2 - 2*w + 1)$
2990 % The ordinary Hilbert series.
2991    hftestversion 1;
2992
2993
2994hf!=whilb1$
2995 % The default.
2996    f2:=weightedhilbertseries(gbasis m,weights);
2997
2998
2999f2 := ( - w**5*x**17 + w**4*x**17 - w**4*x**15 + w**4*x**8 + w**3*x**15 + w**3*x
3000**12 + w**3*x**6 + w**2*x**10 + w**2*x**7 + w**2*x**4 + w*x**5 + w*x**2 + 1)/(w
3001**2*x**9 - w*x**9 - w + 1)$
3002
3003    sub(x=1,ws);
3004
3005
3006( - w**5 + w**4 + 3*w**3 + 3*w**2 + 2*w + 1)/(w**2 - 2*w + 1)$
3007
3008    f1-f2;
3009
3010
30110$
3012
3013
3014% ==> Different primary decomposition approaches. The example is due
3015	% to Shimoyama Takeshi. CALI 2.2. produced auxiliary embedded
3016	% primes on it.
3017
3018    vars:={dx,dy,x,y};
3019
3020
3021vars := {dx,dy,x,y}$
3022
3023    setring(vars,degreeorder vars,revlex);
3024
3025
3026{{dx,dy,x,y},{{1,1,1,1}},revlex,{1,1,1,1}}$
3027
3028    f3:={DY*( - X*DX + Y**2*DY - Y*DY),DX*(X**2*DX - X*DX - Y*DY)}$
3029
3030
3031    primarydecomposition f3;
3032
3033
3034{{{dx**3,
3035dy**3,
3036dx**2*dy,
3037dx*dy**2,
3038dy*( - dx*x + dy*y**2 - dy*y),
3039dx*(dx*x**2 - dx*x - dy*y)},
3040{dx,dy}},
3041{{x*y - x - y,
3042dx*x - dx - dy*y + dy,
3043 - dx + dy*y**2 - 2*dy*y + dy},
3044{x*y - x - y,
3045dx*x - dx - dy*y + dy,
3046 - dx + dy*y**2 - 2*dy*y + dy}},
3047{{dy,x - 1},{dy,x - 1}},
3048{{dy**2,
3049dy*x,
3050x**2,
3051dx*x + dy*y},
3052{dy,x}},
3053{{dx,y - 1},{dx,y - 1}},
3054{{dx**2,
3055dx*y,
3056y**2,
3057dx*x + dy*y},
3058{dx,y}},
3059{{y**2,
3060x**2,
3061x*y,
3062dx*x + dy*y},
3063{y,x}}}$
3064
3065
3066showtime;
3067
3068
3069
3070
3071end;
3072
3073Tested on x86_64-pc-windows CSL
3074Time (counter 1): 2298 ms  plus GC time: 61 ms
3075
3076End of Lisp run after 2.29+0.12 seconds
3077real 2.68
3078user 0.01
3079sys 0.06
3080