Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.4
1.4 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.3 2003/07/29 08:36:39 takayama Exp $
1.1 takayama 2: %[(parse) (hol.sm1) pushfile] extension
3: %[(parse) (appell.sm1) pushfile] extension
4:
5: (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
6: /ecart.begin { beginEcart } def
7: /ecart.end { endEcart } def
8: /ecart.autoHomogenize 1 def
9: /ecart.needSyz 0 def
10:
11: /ecart.dehomogenize {
12: /arg1 set
13: [/in.ecart.dehomogenize /ll /rr] pushVariables
14: [
15: /ll arg1 def
16: ll tag 6 eq {
17: ll { ecart.dehomogenize } map /ll set
18: } {
19: ll (0). eq {
20: } {
21: ll getRing /rr set
22: ll [ [ (H) rr ,, (1) rr ,, ]
23: [ (h) rr ,, (1) rr ,, ]] replace
24: /ll set
25: } ifelse
26: } ifelse
27: /arg1 ll def
28: ] pop
29: popVariables
30: arg1
31: } def
32: [(ecart.dehomogenize)
33: [(obj ecart.dehomogenize r)
34: (h->1, H->1)
35: ]] putUsages
36:
37: /ecart.dehomogenizeH {
38: /arg1 set
39: [/in.ecart.dehomogenize /ll /rr] pushVariables
40: [
41: /ll arg1 def
42: ll tag 6 eq {
43: ll { ecart.dehomogenize } map /ll set
44: } {
45: ll (0). eq {
46: } {
47: ll getRing /rr set
48: ll [ [ (H) rr ,, (1) rr ,, ] ] replace
49: /ll set
50: } ifelse
51: } ifelse
52: /arg1 ll def
53: ] pop
54: popVariables
55: arg1
56: } def
57: [(ecart.dehomogenizeH)
58: [(obj ecart.dehomogenizeH r)
59: (H->1, h is not changed.)
60: ]] putUsages
61:
62: /ecart.homogenize01 {
63: /arg1 set
64: [/in.ecart.homogenize01 /ll ] pushVariables
65: [
66: /ll arg1 def
67: [(degreeShift) [ ] ll ] homogenize
68: /arg1 set
69: ] pop
70: popVariables
71: arg1
72: } def
73: [(ecart.homogenize01)
74: [(obj ecart.homogenize01 r)
75: (Example: )
76: ( [(x1,x2) ring_of_differential_operators )
77: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
78: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
79: ( [(Dx1) 1 (Dx2) 1] )
80: ( [(x1) -1 (x2) -1])
81: ( ] weight_vector )
82: ( 0 )
83: ( [(degreeShift) [[0 0 0]]])
84: ( ] define_ring)
85: ( ecart.begin)
86: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
87: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
88: ( ecart.homogenize01 /eqs2 set)
89: ( [eqs2] groebner )
90: ]] putUsages
91:
92: /ecart.homogenize01_with_shiftVector {
93: /arg2.set
94: /arg1 set
95: [/in.ecart.homogenize01 /ll /sv] pushVariables
96: [
97: /sv arg2 def
98: /ll arg1 def
99: [(degreeShift) sv ll ] homogenize
100: /arg1 set
101: ] pop
102: popVariables
103: arg1
104: } def
105: [(ecart.dehomogenize01_with_degreeShift)
106: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
107: ]] putUsages
108:
109: %% Aux functions to return the default weight vectors.
110: /ecart.wv1 {
111: /arg1 set
112: [/in.ecart.wv1 /v] pushVariables
113: [
114: /v arg1 def
115: [(H) (h) v to_records pop] /v set
116: v { 1 } map /v set
117: /arg1 v def
118: ] pop
119: popVariables
120: arg1
121: } def
122: /ecart.wv2 {
123: /arg1 set
124: [/in.ecart.wv2 /v] pushVariables
125: [
126: /v arg1 def
127: [v to_records pop] /v set
128: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
129: [(h) 1 ] v join /v set
130: /arg1 v def
131: ] pop
132: popVariables
133: arg1
134: } def
135:
136: /ecart.gb.verbose 1 def
137: /ecart.gb {
138: /arg1 set
139: [/in-ecart.gb /aa /typev /setarg /f /v
140: /gg /wv /vec /ans /rr /mm
141: /degreeShift /env2 /opt /ans.gb
142: ] pushVariables
143: [(CurrentRingp) (KanGBmessage)] pushEnv
144: [
145: /aa arg1 def
146: aa isArray { } { ( << array >> gb) error } ifelse
147: /setarg 0 def
148: /wv 0 def
149: /degreeShift 0 def
150: /opt [(weightedHomogenization) 1] def
151: aa { tag } map /typev set
152: typev [ ArrayP ] eq
153: { /f aa 0 get def
154: /v gb.v def
155: /setarg 1 def
156: } { } ifelse
157: typev [ArrayP StringP] eq
158: { /f aa 0 get def
159: /v aa 1 get def
160: /setarg 1 def
161: } { } ifelse
162: typev [ArrayP RingP] eq
163: { /f aa 0 get def
164: /v aa 1 get def
165: /setarg 1 def
166: } { } ifelse
167: typev [ArrayP ArrayP] eq
168: { /f aa 0 get def
169: /v aa 1 get from_records def
170: /setarg 1 def
171: } { } ifelse
172: typev [ArrayP StringP ArrayP] eq
173: { /f aa 0 get def
174: /v aa 1 get def
175: /wv aa 2 get def
176: /setarg 1 def
177: } { } ifelse
178: typev [ArrayP ArrayP ArrayP] eq
179: { /f aa 0 get def
180: /v aa 1 get from_records def
181: /wv aa 2 get def
182: /setarg 1 def
183: } { } ifelse
184: typev [ArrayP StringP ArrayP ArrayP] eq
185: { /f aa 0 get def
186: /v aa 1 get def
187: /wv aa 2 get def
188: /degreeShift aa 3 get def
189: /setarg 1 def
190: } { } ifelse
191: typev [ArrayP ArrayP ArrayP ArrayP] eq
192: { /f aa 0 get def
193: /v aa 1 get from_records def
194: /wv aa 2 get def
195: /degreeShift aa 3 get def
196: /setarg 1 def
197: } { } ifelse
198:
199: /env1 getOptions def
200:
201: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
202:
203: [(KanGBmessage) ecart.gb.verbose ] system_variable
204:
205: %%% Start of the preprocess
206: v tag RingP eq {
207: /rr v def
208: }{
209: f getRing /rr set
210: } ifelse
211: %% To the normal form : matrix expression.
212: f gb.toMatrixOfString /f set
213: /mm gb.itWasMatrix def
214:
215: rr tag 0 eq {
216: %% Define our own ring
217: v isInteger {
218: (Error in gb: Specify variables) error
219: } { } ifelse
220: wv isInteger {
221: [v ring_of_differential_operators
222: [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3 takayama 223: gb.characteristic
1.1 takayama 224: opt
225: ] define_ring
226: }{
227: degreeShift isInteger {
228: [v ring_of_differential_operators
229: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 takayama 230: gb.characteristic
1.1 takayama 231: opt
232: ] define_ring
233:
234: }{
235: [v ring_of_differential_operators
236: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 takayama 237: gb.characteristic
1.1 takayama 238: [(degreeShift) degreeShift] opt join
239: ] define_ring
240:
241: } ifelse
242: } ifelse
243: } {
244: %% Use the ring structre given by the input.
245: v isInteger not {
246: gb.warning {
247: (Warning : the given ring definition is not used.) message
248: } { } ifelse
249: } { } ifelse
250: rr ring_def
251: /wv rr gb.getWeight def
252:
253: } ifelse
254: %%% Enf of the preprocess
255:
256: ecart.gb.verbose {
257: (The first and the second weight vectors are automatically set as follows)
258: message
259: v ecart.wv1 message
260: v ecart.wv2 message
261: degreeShift isInteger { }
262: {
263: (The degree shift is ) messagen
264: degreeShift message
265: } ifelse
266: } { } ifelse
267:
268: ecart.begin
269:
270: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
271: ecart.autoHomogenize {
272: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
273: message
274: } { } ifelse
275: ecart.autoHomogenize {
276: f { {. ecart.dehomogenize} map} map /f set
277: f ecart.homogenize01 /f set
278: }{
279: f { {. } map } map /f set
280: } ifelse
281: ecart.needSyz {
282: [f [(needSyz)] gb.options join ] groebner /gg set
283: } {
284: [f gb.options] groebner 0 get /gg set
285: } ifelse
286:
287: ecart.needSyz {
288: mm {
289: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
290: } { /ans.gb gg 0 get def } ifelse
291: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
292: ans pmat ;
293: } {
294: wv isInteger {
295: /ans [gg gg {init} map] def
296: }{
297: /ans [gg gg {wv 0 get weightv init} map] def
298: }ifelse
299:
300: %% Postprocess : recover the matrix expression.
301: mm {
302: ans { /tmp set [mm tmp] toVectors } map
303: /ans set
304: }{ }
305: ifelse
306: } ifelse
307:
308: ecart.end
309:
310: %%
311: env1 restoreOptions %% degreeShift changes "grade"
312:
313: /arg1 ans def
314: ] pop
315: popEnv
316: popVariables
317: arg1
318: } def
319: (ecart.gb ) messagen-quiet
320:
321: [(ecart.gb)
322: [(a ecart.gb b)
323: (array a; array b;)
324: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
325: ( in the ring of differential operators.)
326: (The computation is done by using Ecart division algorithm and )
327: (the double homogenization.)
328: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
329: $ ii is the initial ideal in case of w is given or <<a>> belongs$
330: $ to a ring. In the other cases, it returns the initial monominal.$
331: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
332: (a : [f v]; array f; string v; v is the variables. )
333: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
334: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
335: ( array ds; ds is the degree shift )
336: ( )
337: (/ecart.autoHomogenize 0 def )
338: ( not to dehomogenize and homogenize)
339: ( )
340: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
341: $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $
342: (Example 2: )
343: (To put H and h=1, type in, e.g., )
344: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
345: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
346: ( )
347: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
348: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
349: ( )
350: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
351: $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $
352: ( )
353: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
354: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
355: ( )
356: (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
357: ( ecart.dehomogenize, ecart.dehomogenizeH)
358: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
359: ( define_ring )
360: ]] putUsages
361:
362: %% BUG: " f weight init " works well in case of vectors with degree shift ?
363:
364: /ecart.syz {
365: /arg1 set
366: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
367: [
368: /ff arg1 def
369: /ecart.save.needSyz ecart.needSyz def
370: /ecart.needSyz 1 def
371: ff ecart.gb /ff.ans set
372: /ecart.needSyz ecart.save.needSyz def
373: /arg1 ff.ans def
374: ] pop
375: popVariables
376: arg1
377: } def
378: (ecart.syz ) messagen-quiet
379:
380: [(ecart.syz)
381: [(a ecart.syz b)
382: (array a; array b;)
383: $b : [syzygy gb tmat input]; gb = tmat * input $
384: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
385: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
386: $ ff 0 get ff 3 get mul pmat $
387: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
388: ( )
389: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
390: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
391: ( )
392: (cf. ecart.gb)
393: ( /ecart.autoHomogenize 0 def )
394: ]] putUsages
1.2 takayama 395:
1.3 takayama 396:
397: /ecartn.begin {
398: (red@) (standard) switch_function
399: %% (red@) (ecart) switch_function
400: [(Ecart) 1] system_variable
401: [(CheckHomogenization) 0] system_variable
402: [(ReduceLowerTerms) 0] system_variable
403: [(AutoReduce) 0] system_variable
404: [(EcartAutomaticHomogenization) 0] system_variable
405: } def
406: /ecartn.gb {
407: /arg1 set
408: [/in-ecartn.gb /aa /typev /setarg /f /v
409: /gg /wv /vec /ans /rr /mm
410: /degreeShift /env2 /opt /ans.gb
411: ] pushVariables
412: [(CurrentRingp) (KanGBmessage)] pushEnv
413: [
414: /aa arg1 def
415: aa isArray { } { ( << array >> gb) error } ifelse
416: /setarg 0 def
417: /wv 0 def
418: /degreeShift 0 def
419: /opt [(weightedHomogenization) 1] def
420: aa { tag } map /typev set
421: typev [ ArrayP ] eq
422: { /f aa 0 get def
423: /v gb.v def
424: /setarg 1 def
425: } { } ifelse
426: typev [ArrayP StringP] eq
427: { /f aa 0 get def
428: /v aa 1 get def
429: /setarg 1 def
430: } { } ifelse
431: typev [ArrayP RingP] eq
432: { /f aa 0 get def
433: /v aa 1 get def
434: /setarg 1 def
435: } { } ifelse
436: typev [ArrayP ArrayP] eq
437: { /f aa 0 get def
438: /v aa 1 get from_records def
439: /setarg 1 def
440: } { } ifelse
441: typev [ArrayP StringP ArrayP] eq
442: { /f aa 0 get def
443: /v aa 1 get def
444: /wv aa 2 get def
445: /setarg 1 def
446: } { } ifelse
447: typev [ArrayP ArrayP ArrayP] eq
448: { /f aa 0 get def
449: /v aa 1 get from_records def
450: /wv aa 2 get def
451: /setarg 1 def
452: } { } ifelse
453: typev [ArrayP StringP ArrayP ArrayP] eq
454: { /f aa 0 get def
455: /v aa 1 get def
456: /wv aa 2 get def
457: /degreeShift aa 3 get def
458: /setarg 1 def
459: } { } ifelse
460: typev [ArrayP ArrayP ArrayP ArrayP] eq
461: { /f aa 0 get def
462: /v aa 1 get from_records def
463: /wv aa 2 get def
464: /degreeShift aa 3 get def
465: /setarg 1 def
466: } { } ifelse
467:
468: /env1 getOptions def
469:
470: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
471:
472: [(KanGBmessage) ecart.gb.verbose ] system_variable
473:
474: %%% Start of the preprocess
475: v tag RingP eq {
476: /rr v def
477: }{
478: f getRing /rr set
479: } ifelse
480: %% To the normal form : matrix expression.
481: f gb.toMatrixOfString /f set
482: /mm gb.itWasMatrix def
483:
484: rr tag 0 eq {
485: %% Define our own ring
486: v isInteger {
487: (Error in gb: Specify variables) error
488: } { } ifelse
489: wv isInteger {
490: [v ring_of_differential_operators
491: [ v ecart.wv1 v ecart.wv2 ] weight_vector
492: gb.characteristic
493: opt
494: ] define_ring
495: }{
496: degreeShift isInteger {
497: [v ring_of_differential_operators
498: [v ecart.wv1 v ecart.wv2] wv join weight_vector
499: gb.characteristic
500: opt
501: ] define_ring
502:
503: }{
504: [v ring_of_differential_operators
505: [v ecart.wv1 v ecart.wv2] wv join weight_vector
506: gb.characteristic
507: [(degreeShift) degreeShift] opt join
508: ] define_ring
509:
510: } ifelse
511: } ifelse
512: } {
513: %% Use the ring structre given by the input.
514: v isInteger not {
515: gb.warning {
516: (Warning : the given ring definition is not used.) message
517: } { } ifelse
518: } { } ifelse
519: rr ring_def
520: /wv rr gb.getWeight def
521:
522: } ifelse
523: %%% Enf of the preprocess
524:
525: ecart.gb.verbose {
526: (The first and the second weight vectors are automatically set as follows)
527: message
528: v ecart.wv1 message
529: v ecart.wv2 message
530: degreeShift isInteger { }
531: {
532: (The degree shift is ) messagen
533: degreeShift message
534: } ifelse
535: } { } ifelse
536:
537: ecartn.begin
538:
539: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
540: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
541: ecart.autoHomogenize {
542: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
543: message
544: } { } ifelse
545: ecart.autoHomogenize {
546: f { {. ecart.dehomogenize} map} map /f set
547: f ecart.homogenize01 /f set
548: }{
549: f { {. } map } map /f set
550: } ifelse
551: ecart.needSyz {
552: [f [(needSyz)] gb.options join ] groebner /gg set
553: } {
554: [f gb.options] groebner 0 get /gg set
555: } ifelse
556:
557: ecart.needSyz {
558: mm {
559: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
560: } { /ans.gb gg 0 get def } ifelse
561: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
562: ans pmat ;
563: } {
564: wv isInteger {
565: /ans [gg gg {init} map] def
566: }{
567: /ans [gg gg {wv 0 get weightv init} map] def
568: }ifelse
569:
570: %% Postprocess : recover the matrix expression.
571: mm {
572: ans { /tmp set [mm tmp] toVectors } map
573: /ans set
574: }{ }
575: ifelse
576: } ifelse
577:
578: ecart.end
579:
580: %%
581: env1 restoreOptions %% degreeShift changes "grade"
582:
583: /arg1 ans def
584: ] pop
585: popEnv
586: popVariables
587: arg1
588: } def
589: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 ! takayama 590:
! 591: /ecartd.gb {
! 592: /arg1 set
! 593: [/in-ecart.gb /aa /typev /setarg /f /v
! 594: /gg /wv /vec /ans /rr /mm
! 595: /degreeShift /env2 /opt /ans.gb
! 596: ] pushVariables
! 597: [(CurrentRingp) (KanGBmessage)] pushEnv
! 598: [
! 599: /aa arg1 def
! 600: aa isArray { } { ( << array >> gb) error } ifelse
! 601: /setarg 0 def
! 602: /wv 0 def
! 603: /degreeShift 0 def
! 604: /opt [(weightedHomogenization) 1] def
! 605: aa { tag } map /typev set
! 606: typev [ ArrayP ] eq
! 607: { /f aa 0 get def
! 608: /v gb.v def
! 609: /setarg 1 def
! 610: } { } ifelse
! 611: typev [ArrayP StringP] eq
! 612: { /f aa 0 get def
! 613: /v aa 1 get def
! 614: /setarg 1 def
! 615: } { } ifelse
! 616: typev [ArrayP RingP] eq
! 617: { /f aa 0 get def
! 618: /v aa 1 get def
! 619: /setarg 1 def
! 620: } { } ifelse
! 621: typev [ArrayP ArrayP] eq
! 622: { /f aa 0 get def
! 623: /v aa 1 get from_records def
! 624: /setarg 1 def
! 625: } { } ifelse
! 626: typev [ArrayP StringP ArrayP] eq
! 627: { /f aa 0 get def
! 628: /v aa 1 get def
! 629: /wv aa 2 get def
! 630: /setarg 1 def
! 631: } { } ifelse
! 632: typev [ArrayP ArrayP ArrayP] eq
! 633: { /f aa 0 get def
! 634: /v aa 1 get from_records def
! 635: /wv aa 2 get def
! 636: /setarg 1 def
! 637: } { } ifelse
! 638: typev [ArrayP StringP ArrayP ArrayP] eq
! 639: { /f aa 0 get def
! 640: /v aa 1 get def
! 641: /wv aa 2 get def
! 642: /degreeShift aa 3 get def
! 643: /setarg 1 def
! 644: } { } ifelse
! 645: typev [ArrayP ArrayP ArrayP ArrayP] eq
! 646: { /f aa 0 get def
! 647: /v aa 1 get from_records def
! 648: /wv aa 2 get def
! 649: /degreeShift aa 3 get def
! 650: /setarg 1 def
! 651: } { } ifelse
! 652:
! 653: /env1 getOptions def
! 654:
! 655: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
! 656:
! 657: [(KanGBmessage) ecart.gb.verbose ] system_variable
! 658: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
! 659:
! 660: %%% Start of the preprocess
! 661: v tag RingP eq {
! 662: /rr v def
! 663: }{
! 664: f getRing /rr set
! 665: } ifelse
! 666: %% To the normal form : matrix expression.
! 667: f gb.toMatrixOfString /f set
! 668: /mm gb.itWasMatrix def
! 669:
! 670: rr tag 0 eq {
! 671: %% Define our own ring
! 672: v isInteger {
! 673: (Error in gb: Specify variables) error
! 674: } { } ifelse
! 675: wv isInteger {
! 676: (Give an weight vector such that x < 1) error
! 677: }{
! 678: degreeShift isInteger {
! 679: [v ring_of_differential_operators
! 680: wv weight_vector
! 681: gb.characteristic
! 682: opt
! 683: ] define_ring
! 684:
! 685: }{
! 686: [v ring_of_differential_operators
! 687: wv weight_vector
! 688: gb.characteristic
! 689: [(degreeShift) degreeShift] opt join
! 690: ] define_ring
! 691:
! 692: } ifelse
! 693: } ifelse
! 694: } {
! 695: %% Use the ring structre given by the input.
! 696: v isInteger not {
! 697: gb.warning {
! 698: (Warning : the given ring definition is not used.) message
! 699: } { } ifelse
! 700: } { } ifelse
! 701: rr ring_def
! 702: /wv rr gb.getWeight def
! 703:
! 704: } ifelse
! 705: %%% Enf of the preprocess
! 706:
! 707: ecart.gb.verbose {
! 708: degreeShift isInteger { }
! 709: {
! 710: (The degree shift is ) messagen
! 711: degreeShift message
! 712: } ifelse
! 713: } { } ifelse
! 714:
! 715: ecart.begin
! 716: [(EcartAutomaticHomogenization) 1] system_variable
! 717:
! 718: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
! 719:
! 720: f { {. ecart.dehomogenize} map} map /f set
! 721: f ecart.homogenize01 /f set
! 722: f { { [[(H). (1).]] replace } map } map /f set
! 723:
! 724: ecart.needSyz {
! 725: [f [(needSyz)] gb.options join ] groebner /gg set
! 726: } {
! 727: [f gb.options] groebner 0 get /gg set
! 728: } ifelse
! 729:
! 730: ecart.needSyz {
! 731: mm {
! 732: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
! 733: } { /ans.gb gg 0 get def } ifelse
! 734: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
! 735: ans pmat ;
! 736: } {
! 737: wv isInteger {
! 738: /ans [gg gg {init} map] def
! 739: }{
! 740: /ans [gg gg {wv 0 get weightv init} map] def
! 741: }ifelse
! 742:
! 743: %% Postprocess : recover the matrix expression.
! 744: mm {
! 745: ans { /tmp set [mm tmp] toVectors } map
! 746: /ans set
! 747: }{ }
! 748: ifelse
! 749: } ifelse
! 750:
! 751: ecart.end
! 752: [(EcartAutomaticHomogenization) 0] system_variable
! 753:
! 754: %%
! 755: env1 restoreOptions %% degreeShift changes "grade"
! 756:
! 757: /arg1 ans def
! 758: ] pop
! 759: popEnv
! 760: popVariables
! 761: arg1
! 762: } def
! 763: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 764:
765: ( ) message-quiet
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>