Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.24
1.24 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.23 2004/05/05 07:32:54 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
1.24 ! takayama 10: /ecartd.gb.oxRingStructure [ ] def
! 11:
1.8 takayama 12: /ecartd.begin {
13: ecart.begin
14: [(EcartAutomaticHomogenization) 1] system_variable
15: } def
16: /ecartd.end {
17: ecart.end
18: [(EcartAutomaticHomogenization) 0] system_variable
19: } def
1.1 takayama 20:
1.22 takayama 21: /ecart.message.quiet 0 def
22: /ecart.message {
23: ecart.message.quiet { pop } { message } ifelse
24: } def
25: /ecart.messagen {
26: ecart.message.quiet { pop } { messagen } ifelse
27: } def
1.15 takayama 28: /ecart.setOpt {
29: /arg1 set
30: [/in-ecart.setOpt /opt /i /n /ans] pushVariables
31: [
32: /opt arg1 def
33: /ans [ ] def
34: /n opt length def
35: 0 2 n 1 sub {
36: /i set
37: opt i get tag StringP eq not {
38: (ecart.setOpt : [keyword value keyword value ....] ) error
39: } { } ifelse
40: { % start of the loop
41: % Global: degreeShift
42: opt i get (degreeShift) eq {
43: /degreeShift opt i 1 add get def
44: exit
45: } { } ifelse
46: % Global: hdShift
47: opt i get (startingShift) eq {
48: /hdShift opt i 1 add get def
49: exit
50: } { } ifelse
51: % Global: hdShift
52: opt i get (noAutoHomogenize) eq {
53: /hdShift -1 def
54: exit
55: } { } ifelse
1.16 takayama 56: % Global: ecart.useSugar
57: opt i get (sugar) eq {
58: /ecart.useSugar opt i 1 add get def
59: exit
60: } { } ifelse
61:
1.15 takayama 62: ans [opt i get opt i 1 add get ] append /ans set
63: exit
64: } loop
65: } for
66:
67: ecart.gb.verbose {
68: (ecart.setOpt:) message
69: (degreeShift=) messagen degreeShift message
70: $hdShift(startingShift)=$ messagen hdShift message
1.16 takayama 71: (sugar=) messagen ecart.useSugar message
1.15 takayama 72: (Other options=) messagen ans message
73: } { } ifelse
74:
75: /arg1 ans def
76: ] pop
77: popVariables
78: arg1
79: } def
80:
1.1 takayama 81: /ecart.dehomogenize {
82: /arg1 set
83: [/in.ecart.dehomogenize /ll /rr] pushVariables
84: [
85: /ll arg1 def
86: ll tag 6 eq {
87: ll { ecart.dehomogenize } map /ll set
88: } {
89: ll (0). eq {
90: } {
91: ll getRing /rr set
1.24 ! takayama 92: ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ]
1.1 takayama 93: [ (h) rr ,, (1) rr ,, ]] replace
94: /ll set
95: } ifelse
96: } ifelse
97: /arg1 ll def
98: ] pop
99: popVariables
100: arg1
101: } def
102: [(ecart.dehomogenize)
103: [(obj ecart.dehomogenize r)
104: (h->1, H->1)
105: ]] putUsages
106:
107: /ecart.dehomogenizeH {
108: /arg1 set
109: [/in.ecart.dehomogenize /ll /rr] pushVariables
110: [
111: /ll arg1 def
112: ll tag 6 eq {
113: ll { ecart.dehomogenize } map /ll set
114: } {
115: ll (0). eq {
116: } {
117: ll getRing /rr set
1.24 ! takayama 118: ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace
1.1 takayama 119: /ll set
120: } ifelse
121: } ifelse
122: /arg1 ll def
123: ] pop
124: popVariables
125: arg1
126: } def
127: [(ecart.dehomogenizeH)
128: [(obj ecart.dehomogenizeH r)
129: (H->1, h is not changed.)
130: ]] putUsages
131:
132: /ecart.homogenize01 {
133: /arg1 set
1.11 takayama 134: [/in.ecart.homogenize01 /ll /ll0] pushVariables
1.1 takayama 135: [
136: /ll arg1 def
1.11 takayama 137: ll tag ArrayP eq {
138: ll 0 get tag ArrayP eq not {
139: [(degreeShift) [ ] ll ] homogenize /arg1 set
140: } {
141: ll { ecart.homogenize01 } map /arg1 set
142: } ifelse
143: } {
144: [(degreeShift) [ ] ll ] homogenize /arg1 set
1.12 takayama 145: } ifelse
1.1 takayama 146: ] pop
147: popVariables
148: arg1
149: } def
150: [(ecart.homogenize01)
151: [(obj ecart.homogenize01 r)
152: (Example: )
153: ( [(x1,x2) ring_of_differential_operators )
154: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
155: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
156: ( [(Dx1) 1 (Dx2) 1] )
157: ( [(x1) -1 (x2) -1])
1.18 takayama 158: ( ] ecart.weight_vector )
1.1 takayama 159: ( 0 )
1.11 takayama 160: ( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
1.1 takayama 161: ( ] define_ring)
162: ( ecart.begin)
163: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
164: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
1.11 takayama 165: ( {ecart.homogenize01} map /eqs2 set)
1.1 takayama 166: ( [eqs2] groebner )
167: ]] putUsages
168:
169: /ecart.homogenize01_with_shiftVector {
170: /arg2.set
171: /arg1 set
1.11 takayama 172: [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
1.1 takayama 173: [
174: /sv arg2 def
175: /ll arg1 def
1.11 takayama 176: ll tag ArrayP eq {
177: ll 0 get tag ArrayP eq not {
178: [(degreeShift) sv ll ] homogenize /arg1 set
179: } {
180: ll { ecart.homogenize01_with_shiftVector } map /arg1 set
181: } ifelse
182: } {
183: [(degreeShift) sv ll ] homogenize /arg1 set
1.12 takayama 184: } ifelse
1.1 takayama 185: ] pop
186: popVariables
187: arg1
188: } def
189: [(ecart.dehomogenize01_with_degreeShift)
190: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
1.11 takayama 191: (cf. homogenize)
1.1 takayama 192: ]] putUsages
193:
194: %% Aux functions to return the default weight vectors.
195: /ecart.wv1 {
196: /arg1 set
197: [/in.ecart.wv1 /v] pushVariables
198: [
199: /v arg1 def
1.24 ! takayama 200: [@@@.Hsymbol (h) v to_records pop] /v set
1.1 takayama 201: v { 1 } map /v set
202: /arg1 v def
203: ] pop
204: popVariables
205: arg1
206: } def
207: /ecart.wv2 {
208: /arg1 set
209: [/in.ecart.wv2 /v] pushVariables
210: [
211: /v arg1 def
212: [v to_records pop] /v set
213: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
214: [(h) 1 ] v join /v set
215: /arg1 v def
216: ] pop
217: popVariables
218: arg1
219: } def
220:
1.7 takayama 221: /ecart.gb {ecartd.gb} def
222:
1.22 takayama 223: [(ecartd.gb)
224: [(See ecart.gb)]] putUsages
225:
1.7 takayama 226: [(ecart.gb)
227: [(a ecart.gb b)
228: (array a; array b;)
229: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
230: ( in the ring of differential operators.)
231: (The computation is done by using Ecart division algorithm and )
232: (the double homogenization.)
233: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
234: $ ii is the initial ideal in case of w is given or <<a>> belongs$
235: $ to a ring. In the other cases, it returns the initial monominal.$
236: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
237: (a : [f v]; array f; string v; v is the variables. )
238: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
1.15 takayama 239: $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
1.11 takayama 240: ( array ds; ds is the degree shift for the ring. )
1.15 takayama 241: $a : [f v w [(degreeShift) ds (startingShift) hdShift]]; array f; string v; array of array w; w is the weight matirx.$
1.11 takayama 242: ( array ds; ds is the degree shift for the ring. )
243: ( array hsShift is the degree shift for the homogenization. cf.homogenize )
1.15 takayama 244: $a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$
1.11 takayama 245: ( No automatic homogenization.)
1.16 takayama 246: $ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $
1.7 takayama 247: ( )
1.19 takayama 248: $cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize), ecartd.reduction $
1.7 takayama 249: ( )
250: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
251: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
252: (Example 2: )
253: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.9 takayama 254: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /ff set ff pmat ;$
255: (To set the current ring to the ring in which ff belongs )
256: ( ff getRing ring_def )
1.7 takayama 257: ( )
258: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
259: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
1.10 takayama 260: ( This example will cause an error on order.)
1.7 takayama 261: ( )
262: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
263: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.10 takayama 264: ( This example will cause an error on order.)
1.7 takayama 265: ( )
266: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.15 takayama 267: $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
268: $ [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
1.7 takayama 269: ( )
270: (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
271: ( ecart.dehomogenize, ecart.dehomogenizeH)
272: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
273: ( define_ring )
274: (/ecart.autoHomogenize 0 def )
275: ( not to dehomogenize and homogenize)
276: ]] putUsages
277:
1.1 takayama 278: /ecart.gb.verbose 1 def
1.12 takayama 279: %ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb.
1.7 takayama 280: /ecarth.gb {
1.1 takayama 281: /arg1 set
1.7 takayama 282: [/in-ecarth.gb /aa /typev /setarg /f /v
1.1 takayama 283: /gg /wv /vec /ans /rr /mm
284: /degreeShift /env2 /opt /ans.gb
1.12 takayama 285: /hdShift
1.17 takayama 286: /ecart.useSugar
1.1 takayama 287: ] pushVariables
288: [(CurrentRingp) (KanGBmessage)] pushEnv
289: [
290: /aa arg1 def
1.13 takayama 291: aa isArray { } { ( << array >> ecarth.gb) error } ifelse
1.1 takayama 292: /setarg 0 def
293: /wv 0 def
294: /degreeShift 0 def
1.12 takayama 295: /hdShift 0 def
1.1 takayama 296: /opt [(weightedHomogenization) 1] def
1.17 takayama 297: /ecart.useSugar 0 def
1.1 takayama 298: aa { tag } map /typev set
299: typev [ ArrayP ] eq
300: { /f aa 0 get def
301: /v gb.v def
302: /setarg 1 def
303: } { } ifelse
304: typev [ArrayP StringP] eq
305: { /f aa 0 get def
306: /v aa 1 get def
307: /setarg 1 def
308: } { } ifelse
309: typev [ArrayP RingP] eq
310: { /f aa 0 get def
311: /v aa 1 get def
312: /setarg 1 def
313: } { } ifelse
314: typev [ArrayP ArrayP] eq
315: { /f aa 0 get def
316: /v aa 1 get from_records def
317: /setarg 1 def
318: } { } ifelse
319: typev [ArrayP StringP ArrayP] eq
320: { /f aa 0 get def
321: /v aa 1 get def
322: /wv aa 2 get def
323: /setarg 1 def
324: } { } ifelse
325: typev [ArrayP ArrayP ArrayP] eq
326: { /f aa 0 get def
327: /v aa 1 get from_records def
328: /wv aa 2 get def
329: /setarg 1 def
330: } { } ifelse
1.15 takayama 331:
1.1 takayama 332: typev [ArrayP StringP ArrayP ArrayP] eq
333: { /f aa 0 get def
334: /v aa 1 get def
335: /wv aa 2 get def
1.15 takayama 336: opt aa 3 get ecart.setOpt join /opt set
1.12 takayama 337: /setarg 1 def
338: } { } ifelse
1.1 takayama 339: typev [ArrayP ArrayP ArrayP ArrayP] eq
340: { /f aa 0 get def
341: /v aa 1 get from_records def
342: /wv aa 2 get def
1.15 takayama 343: opt aa 3 get ecart.setOpt join /opt set
1.13 takayama 344: /setarg 1 def
345: } { } ifelse
1.1 takayama 346:
347: /env1 getOptions def
348:
1.12 takayama 349: ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } { } ifelse
350: setarg { } { (ecarth.gb : Argument mismatch) error } ifelse
1.1 takayama 351:
352: [(KanGBmessage) ecart.gb.verbose ] system_variable
353:
354: %%% Start of the preprocess
355: v tag RingP eq {
356: /rr v def
357: }{
358: f getRing /rr set
359: } ifelse
360: %% To the normal form : matrix expression.
361: f gb.toMatrixOfString /f set
362: /mm gb.itWasMatrix def
363:
364: rr tag 0 eq {
365: %% Define our own ring
366: v isInteger {
367: (Error in gb: Specify variables) error
368: } { } ifelse
369: wv isInteger {
370: [v ring_of_differential_operators
1.18 takayama 371: % [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
1.3 takayama 372: gb.characteristic
1.1 takayama 373: opt
374: ] define_ring
375: }{
376: degreeShift isInteger {
377: [v ring_of_differential_operators
1.18 takayama 378: % [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
379: wv ecart.weight_vector
1.3 takayama 380: gb.characteristic
1.1 takayama 381: opt
382: ] define_ring
383:
384: }{
385: [v ring_of_differential_operators
1.18 takayama 386: % [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
387: wv ecart.weight_vector
1.3 takayama 388: gb.characteristic
1.1 takayama 389: [(degreeShift) degreeShift] opt join
390: ] define_ring
391:
392: } ifelse
393: } ifelse
394: } {
395: %% Use the ring structre given by the input.
396: v isInteger not {
397: gb.warning {
398: (Warning : the given ring definition is not used.) message
399: } { } ifelse
400: } { } ifelse
401: rr ring_def
402: /wv rr gb.getWeight def
403:
404: } ifelse
405: %%% Enf of the preprocess
406:
407: ecart.gb.verbose {
1.6 takayama 408: (The first and the second weight vectors for automatic homogenization: )
1.1 takayama 409: message
410: v ecart.wv1 message
411: v ecart.wv2 message
412: degreeShift isInteger { }
413: {
414: (The degree shift is ) messagen
415: degreeShift message
416: } ifelse
417: } { } ifelse
418:
1.5 takayama 419: %%BUG: case of v is integer
420: v ecart.checkOrder
421:
1.1 takayama 422: ecart.begin
423:
424: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
1.13 takayama 425:
1.12 takayama 426:
427: hdShift tag 1 eq {
428: ecart.autoHomogenize not hdShift -1 eq or {
429: % No automatic h-s-homogenization.
430: f { {. } map} map /f set
431: } {
432: % Automatic h-s-homogenization without degreeShift
1.13 takayama 433: (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized without degree shift.)
434: message
1.12 takayama 435: f { {. ecart.dehomogenize} map} map /f set
436: f ecart.homogenize01 /f set
437: } ifelse
438: } {
439: % Automatic h-s-homogenization with degreeShift
1.13 takayama 440: (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized with degree shift.)
441: message
1.12 takayama 442: f { {. ecart.dehomogenize} map} map /f set
443: f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
444: }ifelse
445:
1.17 takayama 446: ecart.useSugar {
447: ecart.needSyz {
448: [f [(needSyz)] gb.options join ] groebner_sugar /gg set
449: } {
450: [f gb.options] groebner_sugar 0 get /gg set
451: } ifelse
452: } {
453: ecart.needSyz {
454: [f [(needSyz)] gb.options join ] groebner /gg set
455: } {
456: [f gb.options] groebner 0 get /gg set
457: } ifelse
1.1 takayama 458: } ifelse
459:
460: ecart.needSyz {
461: mm {
462: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
1.11 takayama 463: } { /ans.gb gg 0 get def } ifelse
464: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
465: % ans pmat ;
1.1 takayama 466: } {
467: wv isInteger {
468: /ans [gg gg {init} map] def
469: }{
1.10 takayama 470: degreeShift isInteger {
471: /ans [gg gg {wv 0 get weightv init} map] def
472: } {
473: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
474: } ifelse
1.1 takayama 475: }ifelse
476:
477: %% Postprocess : recover the matrix expression.
478: mm {
479: ans { /tmp set [mm tmp] toVectors } map
480: /ans set
481: }{ }
482: ifelse
483: } ifelse
484:
485: ecart.end
486:
487: %%
488: env1 restoreOptions %% degreeShift changes "grade"
489:
490: /arg1 ans def
491: ] pop
492: popEnv
493: popVariables
494: arg1
495: } def
1.7 takayama 496: (ecarth.gb ) messagen-quiet
1.1 takayama 497:
1.7 takayama 498: [(ecarth.gb)
499: [(a ecarth.gb b)
1.1 takayama 500: (array a; array b;)
501: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
502: ( in the ring of differential operators.)
1.12 takayama 503: (The computation is done by using Ecart division algorithm.)
504: $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$
505: (they are not dehomogenized.)
1.1 takayama 506: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
507: $ ii is the initial ideal in case of w is given or <<a>> belongs$
508: $ to a ring. In the other cases, it returns the initial monominal.$
509: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
510: (a : [f v]; array f; string v; v is the variables. )
511: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
1.15 takayama 512: $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
1.1 takayama 513: ( array ds; ds is the degree shift )
514: ( )
515: (/ecart.autoHomogenize 0 def )
516: ( not to dehomogenize and homogenize)
517: ( )
518: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 519: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 520: (Example 2: )
521: (To put H and h=1, type in, e.g., )
522: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.7 takayama 523: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
1.1 takayama 524: ( )
525: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 526: $ [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
1.1 takayama 527: ( )
528: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.7 takayama 529: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 530: ( )
531: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.15 takayama 532: $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
533: $ [(degreeShift) [[0 1] [-3 1] ]] ] ecarth.gb pmat ; $
1.1 takayama 534: ( )
1.7 takayama 535: (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
1.1 takayama 536: ( ecart.dehomogenize, ecart.dehomogenizeH)
537: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
538: ( define_ring )
539: ]] putUsages
540:
541:
542: /ecart.syz {
543: /arg1 set
544: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
545: [
546: /ff arg1 def
547: /ecart.save.needSyz ecart.needSyz def
548: /ecart.needSyz 1 def
549: ff ecart.gb /ff.ans set
550: /ecart.needSyz ecart.save.needSyz def
551: /arg1 ff.ans def
552: ] pop
553: popVariables
554: arg1
555: } def
556: (ecart.syz ) messagen-quiet
557:
558: [(ecart.syz)
559: [(a ecart.syz b)
560: (array a; array b;)
561: $b : [syzygy gb tmat input]; gb = tmat * input $
562: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.8 takayama 563: $ [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
1.1 takayama 564: $ ff 0 get ff 3 get mul pmat $
565: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
566: ( )
1.9 takayama 567: (To set the current ring to the ring in which ff belongs )
568: ( ff getRing ring_def )
1.1 takayama 569: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.8 takayama 570: $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
1.1 takayama 571: ( )
572: (cf. ecart.gb)
573: ( /ecart.autoHomogenize 0 def )
574: ]] putUsages
1.2 takayama 575:
1.3 takayama 576:
577: /ecartn.begin {
578: (red@) (standard) switch_function
579: %% (red@) (ecart) switch_function
580: [(Ecart) 1] system_variable
581: [(CheckHomogenization) 0] system_variable
582: [(ReduceLowerTerms) 0] system_variable
583: [(AutoReduce) 0] system_variable
584: [(EcartAutomaticHomogenization) 0] system_variable
585: } def
586: /ecartn.gb {
587: /arg1 set
588: [/in-ecartn.gb /aa /typev /setarg /f /v
589: /gg /wv /vec /ans /rr /mm
590: /degreeShift /env2 /opt /ans.gb
591: ] pushVariables
592: [(CurrentRingp) (KanGBmessage)] pushEnv
593: [
594: /aa arg1 def
1.13 takayama 595: aa isArray { } { ( << array >> ecartn.gb) error } ifelse
1.3 takayama 596: /setarg 0 def
597: /wv 0 def
598: /degreeShift 0 def
599: /opt [(weightedHomogenization) 1] def
600: aa { tag } map /typev set
601: typev [ ArrayP ] eq
602: { /f aa 0 get def
603: /v gb.v def
604: /setarg 1 def
605: } { } ifelse
606: typev [ArrayP StringP] eq
607: { /f aa 0 get def
608: /v aa 1 get def
609: /setarg 1 def
610: } { } ifelse
611: typev [ArrayP RingP] eq
612: { /f aa 0 get def
613: /v aa 1 get def
614: /setarg 1 def
615: } { } ifelse
616: typev [ArrayP ArrayP] eq
617: { /f aa 0 get def
618: /v aa 1 get from_records def
619: /setarg 1 def
620: } { } ifelse
621: typev [ArrayP StringP ArrayP] eq
622: { /f aa 0 get def
623: /v aa 1 get def
624: /wv aa 2 get def
625: /setarg 1 def
626: } { } ifelse
627: typev [ArrayP ArrayP ArrayP] eq
628: { /f aa 0 get def
629: /v aa 1 get from_records def
630: /wv aa 2 get def
631: /setarg 1 def
632: } { } ifelse
1.15 takayama 633:
1.3 takayama 634: typev [ArrayP StringP ArrayP ArrayP] eq
635: { /f aa 0 get def
636: /v aa 1 get def
637: /wv aa 2 get def
1.15 takayama 638: opt aa 3 get ecart.setOpt join /opt set
1.3 takayama 639: /setarg 1 def
640: } { } ifelse
641: typev [ArrayP ArrayP ArrayP ArrayP] eq
642: { /f aa 0 get def
643: /v aa 1 get from_records def
644: /wv aa 2 get def
1.15 takayama 645: opt aa 3 get ecart.setOpt join /opt set
1.3 takayama 646: /setarg 1 def
647: } { } ifelse
648:
649: /env1 getOptions def
650:
651: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
652:
653: [(KanGBmessage) ecart.gb.verbose ] system_variable
654:
655: %%% Start of the preprocess
656: v tag RingP eq {
657: /rr v def
658: }{
659: f getRing /rr set
660: } ifelse
661: %% To the normal form : matrix expression.
662: f gb.toMatrixOfString /f set
663: /mm gb.itWasMatrix def
664:
665: rr tag 0 eq {
666: %% Define our own ring
667: v isInteger {
668: (Error in gb: Specify variables) error
669: } { } ifelse
670: wv isInteger {
671: [v ring_of_differential_operators
1.18 takayama 672: [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
1.3 takayama 673: gb.characteristic
674: opt
675: ] define_ring
676: }{
677: degreeShift isInteger {
678: [v ring_of_differential_operators
1.18 takayama 679: [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
1.3 takayama 680: gb.characteristic
681: opt
682: ] define_ring
683:
684: }{
685: [v ring_of_differential_operators
1.18 takayama 686: [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
1.3 takayama 687: gb.characteristic
688: [(degreeShift) degreeShift] opt join
689: ] define_ring
690:
691: } ifelse
692: } ifelse
693: } {
694: %% Use the ring structre given by the input.
695: v isInteger not {
696: gb.warning {
697: (Warning : the given ring definition is not used.) message
698: } { } ifelse
699: } { } ifelse
700: rr ring_def
701: /wv rr gb.getWeight def
702:
703: } ifelse
704: %%% Enf of the preprocess
705:
706: ecart.gb.verbose {
707: (The first and the second weight vectors are automatically set as follows)
708: message
709: v ecart.wv1 message
710: v ecart.wv2 message
711: degreeShift isInteger { }
712: {
713: (The degree shift is ) messagen
714: degreeShift message
715: } ifelse
716: } { } ifelse
717:
1.5 takayama 718: %%BUG: case of v is integer
719: v ecart.checkOrder
720:
1.3 takayama 721: ecartn.begin
722:
723: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
724: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
725: ecart.autoHomogenize {
726: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
727: message
728: } { } ifelse
729: ecart.autoHomogenize {
730: f { {. ecart.dehomogenize} map} map /f set
731: f ecart.homogenize01 /f set
732: }{
733: f { {. } map } map /f set
734: } ifelse
735: ecart.needSyz {
736: [f [(needSyz)] gb.options join ] groebner /gg set
737: } {
738: [f gb.options] groebner 0 get /gg set
739: } ifelse
740:
741: ecart.needSyz {
742: mm {
743: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
744: } { /ans.gb gg 0 get def } ifelse
745: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 takayama 746: % ans pmat ;
1.3 takayama 747: } {
748: wv isInteger {
749: /ans [gg gg {init} map] def
750: }{
1.10 takayama 751: degreeShift isInteger {
752: /ans [gg gg {wv 0 get weightv init} map] def
753: } {
754: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
755: } ifelse
1.3 takayama 756: }ifelse
757:
758: %% Postprocess : recover the matrix expression.
759: mm {
760: ans { /tmp set [mm tmp] toVectors } map
761: /ans set
762: }{ }
763: ifelse
764: } ifelse
765:
766: ecart.end
767:
768: %%
769: env1 restoreOptions %% degreeShift changes "grade"
770:
771: /arg1 ans def
772: ] pop
773: popEnv
774: popVariables
775: arg1
776: } def
777: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 takayama 778:
779: /ecartd.gb {
780: /arg1 set
781: [/in-ecart.gb /aa /typev /setarg /f /v
782: /gg /wv /vec /ans /rr /mm
783: /degreeShift /env2 /opt /ans.gb
1.11 takayama 784: /hdShift
1.16 takayama 785: /ecart.useSugar
1.4 takayama 786: ] pushVariables
787: [(CurrentRingp) (KanGBmessage)] pushEnv
788: [
789: /aa arg1 def
1.13 takayama 790: aa isArray { } { ( << array >> ecartd.gb) error } ifelse
1.4 takayama 791: /setarg 0 def
792: /wv 0 def
793: /degreeShift 0 def
1.11 takayama 794: /hdShift 0 def
1.16 takayama 795: /ecart.useSugar 0 def
1.4 takayama 796: /opt [(weightedHomogenization) 1] def
797: aa { tag } map /typev set
798: typev [ ArrayP ] eq
799: { /f aa 0 get def
800: /v gb.v def
801: /setarg 1 def
802: } { } ifelse
803: typev [ArrayP StringP] eq
804: { /f aa 0 get def
805: /v aa 1 get def
806: /setarg 1 def
807: } { } ifelse
808: typev [ArrayP RingP] eq
809: { /f aa 0 get def
810: /v aa 1 get def
811: /setarg 1 def
812: } { } ifelse
813: typev [ArrayP ArrayP] eq
814: { /f aa 0 get def
815: /v aa 1 get from_records def
816: /setarg 1 def
817: } { } ifelse
818: typev [ArrayP StringP ArrayP] eq
819: { /f aa 0 get def
820: /v aa 1 get def
821: /wv aa 2 get def
822: /setarg 1 def
823: } { } ifelse
824: typev [ArrayP ArrayP ArrayP] eq
825: { /f aa 0 get def
826: /v aa 1 get from_records def
827: /wv aa 2 get def
828: /setarg 1 def
829: } { } ifelse
1.15 takayama 830:
1.4 takayama 831: typev [ArrayP StringP ArrayP ArrayP] eq
832: { /f aa 0 get def
833: /v aa 1 get def
834: /wv aa 2 get def
1.15 takayama 835: opt aa 3 get ecart.setOpt join /opt set
1.4 takayama 836: /setarg 1 def
837: } { } ifelse
838: typev [ArrayP ArrayP ArrayP ArrayP] eq
839: { /f aa 0 get def
840: /v aa 1 get from_records def
841: /wv aa 2 get def
1.15 takayama 842: opt aa 3 get ecart.setOpt join /opt set
1.13 takayama 843: /setarg 1 def
844: } { } ifelse
1.4 takayama 845:
846: /env1 getOptions def
847:
848: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
849:
850: [(KanGBmessage) ecart.gb.verbose ] system_variable
1.22 takayama 851: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message
1.4 takayama 852:
853: %%% Start of the preprocess
854: v tag RingP eq {
855: /rr v def
856: }{
857: f getRing /rr set
858: } ifelse
859: %% To the normal form : matrix expression.
860: f gb.toMatrixOfString /f set
861: /mm gb.itWasMatrix def
862:
863: rr tag 0 eq {
864: %% Define our own ring
865: v isInteger {
866: (Error in gb: Specify variables) error
867: } { } ifelse
868: wv isInteger {
1.22 takayama 869: (Give a weight vector such that x < 1) error
1.4 takayama 870: }{
871: degreeShift isInteger {
872: [v ring_of_differential_operators
1.18 takayama 873: wv ecart.weight_vector
1.4 takayama 874: gb.characteristic
875: opt
876: ] define_ring
877:
878: }{
879: [v ring_of_differential_operators
1.18 takayama 880: wv ecart.weight_vector
1.4 takayama 881: gb.characteristic
882: [(degreeShift) degreeShift] opt join
883: ] define_ring
884:
885: } ifelse
886: } ifelse
887: } {
888: %% Use the ring structre given by the input.
889: v isInteger not {
890: gb.warning {
891: (Warning : the given ring definition is not used.) message
892: } { } ifelse
893: } { } ifelse
894: rr ring_def
895: /wv rr gb.getWeight def
896:
897: } ifelse
898: %%% Enf of the preprocess
899:
900: ecart.gb.verbose {
901: degreeShift isInteger { }
902: {
903: (The degree shift is ) messagen
904: degreeShift message
905: } ifelse
906: } { } ifelse
907:
1.5 takayama 908: %%BUG: case of v is integer
909: v ecart.checkOrder
910:
1.8 takayama 911: ecartd.begin
1.4 takayama 912:
1.22 takayama 913: ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
1.4 takayama 914:
1.11 takayama 915: hdShift tag 1 eq {
1.12 takayama 916: ecart.autoHomogenize not hdShift -1 eq or {
1.11 takayama 917: % No automatic h-homogenization.
918: f { {. } map} map /f set
919: } {
920: % Automatic h-homogenization without degreeShift
1.22 takayama 921: (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message
1.11 takayama 922: f { {. ecart.dehomogenize} map} map /f set
923: f ecart.homogenize01 /f set
1.24 ! takayama 924: f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
1.11 takayama 925: } ifelse
926: } {
927: % Automatic h-homogenization with degreeShift
1.13 takayama 928: (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message
1.11 takayama 929: f { {. ecart.dehomogenize} map} map /f set
930: f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
1.24 ! takayama 931: f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
1.11 takayama 932: }ifelse
1.4 takayama 933:
1.16 takayama 934: ecart.useSugar {
935: ecart.needSyz {
936: [f [(needSyz)] gb.options join ] groebner_sugar /gg set
937: } {
938: [f gb.options] groebner_sugar 0 get /gg set
939: } ifelse
940: } {
941: ecart.needSyz {
942: [f [(needSyz)] gb.options join ] groebner /gg set
943: } {
944: [f gb.options] groebner 0 get /gg set
945: } ifelse
1.4 takayama 946: } ifelse
947:
948: ecart.needSyz {
949: mm {
950: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
951: } { /ans.gb gg 0 get def } ifelse
952: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 takayama 953: % ans pmat ;
1.4 takayama 954: } {
955: wv isInteger {
956: /ans [gg gg {init} map] def
957: }{
1.11 takayama 958: %% Get the initial ideal
1.10 takayama 959: degreeShift isInteger {
960: /ans [gg gg {wv 0 get weightv init} map] def
961: } {
962: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
963: } ifelse
1.4 takayama 964: }ifelse
965:
966: %% Postprocess : recover the matrix expression.
967: mm {
968: ans { /tmp set [mm tmp] toVectors } map
969: /ans set
970: }{ }
971: ifelse
972: } ifelse
973:
1.8 takayama 974: ecartd.end
1.4 takayama 975:
1.24 ! takayama 976: ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
1.4 takayama 977: %%
978: env1 restoreOptions %% degreeShift changes "grade"
979:
980: /arg1 ans def
981: ] pop
982: popEnv
983: popVariables
984: arg1
985: } def
986: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 987:
1.5 takayama 988: /ecart.checkOrder {
989: /arg1 set
990: [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
991: [
992: /vv arg1 def
993: vv isArray
994: { } { [vv to_records pop] /vv set } ifelse
995: vv {toString} map /vv set
996: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
997: % Starting the checks.
998: 0 1 vv length 1 sub {
999: /i set
1000: vv i get . dd i get . mul /tt set
1001: tt @@@.hsymbol . add init tt eq { }
1002: { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
1003: } for
1004:
1005: 0 1 vv length 1 sub {
1006: /i set
1007: vv i get . /tt set
1008: tt (1). add init (1). eq { }
1.6 takayama 1009: { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5 takayama 1010: } for
1011: /arg1 1 def
1012: ] pop
1013: popVariables
1014: arg1
1015: } def
1016: [(ecart.checkOrder)
1017: [(v ecart.checkOrder bool checks if the given order is relevant)
1018: (for the ecart division.)
1019: (cf. ecartd.gb, ecart.gb, ecartn.gb)
1020: ]
1021: ] putUsages
1022:
1023: /ecart.wv_last {
1024: /arg1 set
1025: [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
1026: [
1027: /vv arg1 def
1028: vv isArray
1029: { } { [vv to_records pop] /vv set } ifelse
1030: vv {toString} map /vv set
1031: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
1032: vv { -1 } map
1033: dd { 1 } map join /arg1 set
1034: ] pop
1035: popVariables
1036: arg1
1037: } def
1038: [(ecart.wv_last)
1039: [(v ecart.wv_last wt )
1040: (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
1041: (Use this weight vector as the last weight vector for ecart division)
1042: (if ecart.checkOrder complains about the order given.)
1043: ]
1044: ] putUsages
1.13 takayama 1045:
1046: /ecart.mimimalBase.test {
1047: [
1048: [ (0) , (-2*Dx) , (2*t) , (y) , (x^2) ]
1049: [ (3*t ) , ( -3*Dy ) , ( 0 ) , ( -x ) , ( -y) ]
1050: [ (3*y ) , ( 6*Dt ) , ( 2*x ) , ( 0 ) , ( 1) ]
1051: [ (-3*x^2 ) , ( 0 ) , ( -2*y ) , ( 1 ) , ( 0 )]
1052: [ (Dx ) , ( 0 ) , ( -Dy ) , ( Dt ) , ( 0) ]
1053: [ (0 ) , ( 0 ) , ( 6*t*Dt+2*x*Dx+3*y*Dy+8*h ) , ( 0 ) , ( 3*x^2*Dt+Dx) ]
1054: [ (6*t*Dx ) , ( 0 ) , ( -6*t*Dy ) , ( -2*x*Dx-3*y*Dy-5*h ) , ( -2*y*Dx-3*x^2*Dy) ]
1055: [ (6*t*Dt+3*y*Dy+9*h ) , ( 0 ) , ( 2*x*Dy ) , ( -2*x*Dt ) , ( -2*y*Dt+Dy) ]
1056: ]
1057: /ff set
1058:
1059: /nmshift [ [1 0 1 1 1] [1 0 1 0 0] ] def
1060: /shift [ [1 0 1 0 0] ] def
1061: /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def
1062:
1.15 takayama 1063: [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase
1.13 takayama 1064:
1065:
1066: } def
1067: /test {ecart.mimimalBase.test} def
1068:
1069: %(x,y) ==> [(Dx) 1 (Dy) 1 (h) 1]
1070: /ecart.minimalBase.D1 {
1071: /arg1 set
1072: [/in-ecart.minimalBase.D1 /tt /v] pushVariables
1073: [
1074: /v arg1 def
1075: [ v to_records pop] /v set
1076: v { /tt set [@@@.Dsymbol tt] cat 1 } map /v set
1077: v [(h) 1] join /arg1 set
1078: ] pop
1079: popVariables
1080: arg1
1081: } def
1082:
1083: % [0 1 2] 1 ecart.removeElem [0 2]
1084: /ecart.removeElem {
1085: /arg2 set
1086: /arg1 set
1087: [/in-ecart.removeElem /v /q /i /ans /j] pushVariables
1088: [
1089: /v arg1 def
1090: /q arg2 def
1091: /ans v length 1 sub newVector def
1092: /j 0 def
1093: 0 1 v length 1 sub {
1094: /i set
1095: i q eq not {
1096: ans j v i get put
1097: /j j 1 add def
1098: } { } ifelse
1099: } for
1100: ] pop
1101: popVariables
1102: arg1
1103: } def
1104:
1.14 takayama 1105: /ecart.isZeroRow {
1106: /arg1 set
1107: [/in-ecart.isZeroRow /aa /i /n /yes] pushVariables
1108: [
1109: /aa arg1 def
1110: aa length /n set
1111: /yes 1 def
1112: 0 1 n 1 sub {
1113: /i set
1114: aa i get (0). eq {
1115: } {
1116: /yes 0 def
1117: } ifelse
1118: } for
1119: /arg1 yes def
1120: ] pop
1121: popVariables
1122: arg1
1123: } def
1124:
1125: /ecart.removeZeroRow {
1126: /arg1 set
1127: [/in-ecart.removeZeroRow /aa /i /n /ans] pushVariables
1128: [
1129: /aa arg1 def
1130: aa length /n set
1131: /ans [ ] def
1132: 0 1 n 1 sub {
1133: /i set
1134: aa i get ecart.isZeroRow {
1135: } {
1136: ans aa i get append /ans set
1137: } ifelse
1138: } for
1139: /arg1 ans def
1140: ] pop
1141: popVariables
1142: arg1
1143: } def
1144:
1145: /ecart.gen_input {
1146: /arg1 set
1147: [/in-ecart.gen_input /aa /typev /setarg /f /v
1148: /gg /wv /vec /ans /rr /mm
1149: /degreeShift /env2 /opt /ss0
1150: /hdShift /ff
1151: ] pushVariables
1152: [
1153: /aa arg1 def
1154: aa isArray { } { ( << array >> ecart.gen_input) error } ifelse
1155: /setarg 0 def
1156: /wv 0 def
1157: /degreeShift 0 def
1158: /hdShift 0 def
1.15 takayama 1159: /opt [ ] def
1.14 takayama 1160: aa { tag } map /typev set
1.15 takayama 1161: typev [ArrayP StringP ArrayP ArrayP] eq
1.14 takayama 1162: { /f aa 0 get def
1163: /v aa 1 get def
1164: /wv aa 2 get def
1.15 takayama 1165: opt aa 3 get ecart.setOpt join /opt set
1.14 takayama 1166: /setarg 1 def
1167: } { } ifelse
1.15 takayama 1168: typev [ArrayP ArrayP ArrayP ArrayP] eq
1.14 takayama 1169: { /f aa 0 get def
1170: /v aa 1 get from_records def
1171: /wv aa 2 get def
1.15 takayama 1172: opt aa 3 get ecart.setOpt join /opt set
1.14 takayama 1173: /setarg 1 def
1174: } { } ifelse
1175: setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
1176:
1177: [(KanGBmessage) ecart.gb.verbose ] system_variable
1178:
1179: f 0 get tag ArrayP eq { }
1180: { f { /tt set [ tt ] } map /f set } ifelse
1181:
1.15 takayama 1182: [f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join]
1.14 takayama 1183: ecart.gb /ff set
1184: ff getRing ring_def
1185:
1186: ff 0 get { {toString } map } map /ff set
1187:
1.15 takayama 1188: [ff v wv
1189: [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join
1190: ] /arg1 set
1.14 takayama 1191: ] pop
1192: popVariables
1193: arg1
1194: } def
1195: [(ecart.gen_input)
1.18 takayama 1196: [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ] ecart.gen_input $
1197: $ [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $
1.14 takayama 1198: (It generates the input for the minimal filtered free resolution.)
1199: (Current ring is changed to the ring of gg_h.)
1200: (cf. ecart.minimalBase)
1201: $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
1202: $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
1.15 takayama 1203: $ [(degreeShift) [ [0] ] $
1204: $ (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $
1.14 takayama 1205: ]] putUsages
1206:
1207:
1.13 takayama 1208: [(ecart.minimalBase)
1.18 takayama 1209: [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalBase $
1.14 takayama 1210: ( [mbase gr_of_mbase )
1.18 takayama 1211: $ [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
1.14 takayama 1212: ( gr_of_syz ])
1213: (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)
1214: (generators.)
1215: $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
1216: $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
1.15 takayama 1217: $ [(degreeShift) [ [0] ] $
1218: $ (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $
1.14 takayama 1219: $ gg0 ecart.minimalBase /ss0 set $
1220: $ ss0 2 get ecart.minimalBase /ss1 set $
1221: $ ss1 2 get ecart.minimalBase /ss2 set $
1222: $ (--------- minimal filtered resolution -------) message $
1223: $ ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat $
1224: $ (--------- degree shift (n,m) n:D-shift m:uv-shift -------) message $
1.15 takayama 1225: $ gg0 3 get 3 get message $
1226: $ ss0 2 get 3 get 3 get message $
1227: $ ss1 2 get 3 get 3 get message $
1228: $ ss2 2 get 3 get 3 get message ; $
1.14 takayama 1229:
1.13 takayama 1230: ]] putUsages
1231: /ecart.minimalBase {
1232: /arg1 set
1233: [/in-ecart.minimalBase /ai1 /ai /aa /typev /setarg /f /v
1234: /gg /wv /vec /ans /rr /mm
1235: /degreeShift /env2 /opt /ss0
1236: /hdShift
1237: /degreeShiftD /degreeShiftUV
1238: /degreeShiftDnew /degreeShiftUVnew
1239: /tt
1240: /ai1_gr /ai_gr
1241: /s /r /p /q /i /j /k
1242: /ai1_new /ai_new /ai_new2
1243: ] pushVariables
1244: [
1245: /aa arg1 def
1246: aa isArray { } { ( << array >> ecart.minimalBase) error } ifelse
1247: /setarg 0 def
1248: /wv 0 def
1249: /degreeShift 0 def
1250: /hdShift 0 def
1.15 takayama 1251: /opt [ ] def
1.13 takayama 1252: aa { tag } map /typev set
1.15 takayama 1253: typev [ArrayP StringP ArrayP ArrayP] eq
1.13 takayama 1254: { /f aa 0 get def
1255: /v aa 1 get def
1256: /wv aa 2 get def
1.15 takayama 1257: opt aa 3 get ecart.setOpt join /opt set
1.13 takayama 1258: /setarg 1 def
1259: } { } ifelse
1.15 takayama 1260: typev [ArrayP ArrayP ArrayP ArrayP] eq
1.13 takayama 1261: { /f aa 0 get def
1262: /v aa 1 get from_records def
1263: /wv aa 2 get def
1.15 takayama 1264: opt aa 3 get ecart.setOpt join /opt set
1.13 takayama 1265: /setarg 1 def
1266: } { } ifelse
1267: setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
1268:
1269: [(KanGBmessage) ecart.gb.verbose ] system_variable
1270:
1271: f 0 get tag ArrayP eq { }
1272: { f { /tt set [ tt ] } map /f set } ifelse
1.15 takayama 1273: [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set
1.13 takayama 1274:
1275: ss0 getRing ring_def
1276: /degreeShiftD hdShift 0 get def
1277: /degreeShiftUV hdShift 1 get def
1278: % -- ai --> D^r -- ai1 --> D^rr
1279: /ai1 f { { . } map } map def
1280: /ai ss0 0 get def
1281:
1282: {
1283: /degreeShiftUVnew
1284: ai1 { [ << wv 0 get weightv >> degreeShiftUV ] ord_ws_all } map
1285: def
1286: (degreeShiftUVnew=) messagen degreeShiftUVnew message
1287:
1288: /degreeShiftDnew
1289: ai1 { [ << v ecart.minimalBase.D1 weightv >> degreeShiftD ] ord_ws_all}
1290: map
1291: def
1292: (degreeShiftDnew=) messagen degreeShiftDnew message
1293:
1294: ai {[wv 0 get weightv degreeShiftUVnew] init} map /ai_gr set
1295:
1296: %C Note 2003.8.26
1297:
1.14 takayama 1298: ai [ ] eq {
1299: exit
1300: } { } ifelse
1301:
1.13 takayama 1302: /s ai length def
1303: /r ai 0 get length def
1304:
1305: /itIsMinimal 1 def
1306: 0 1 s 1 sub {
1307: /i set
1308: 0 1 r 1 sub {
1309: /j set
1310:
1311: [(isConstantAll) ai_gr i get j get] gbext
1312: ai_gr i get j get (0). eq not and
1313: {
1314: /itIsMinimal 0 def
1315: /p i def /q j def
1316: } { } ifelse
1317: } for
1318: } for
1319:
1320:
1321: itIsMinimal { exit } { } ifelse
1322:
1323: % construct new ai and ai1 (A_i and A_{i-1})
1324: /ai1_new r 1 sub newVector def
1325: /j 0 def
1326: 0 1 r 1 sub {
1327: /i set
1328: i q eq not {
1329: ai1_new j ai1 i get put
1330: /j j 1 add def
1331: } { } ifelse
1332: } for
1333:
1334: /ai_new [s r] newMatrix def
1335: 0 1 s 1 sub {
1336: /j set
1337: 0 1 r 1 sub {
1338: /k set
1339: ai_new [j k]
1340: << ai p get q get >> << ai j get k get >> mul
1341: << ai j get q get >> << ai p get k get >> mul
1342: sub
1343: put
1344: } for
1345: } for
1346:
1347: % remove 0 column
1348: /ai_new2 [s 1 sub r 1 sub] newMatrix def
1349: /j 0 def
1350: 0 1 s 1 sub {
1351: /i set
1352: i p eq not {
1353: ai_new2 j << ai_new i get q ecart.removeElem >> put
1354: /j j 1 add def
1355: } { } ifelse
1356: } for
1357:
1358: % ( ) error
1.14 takayama 1359: /ai1 ai1_new def
1360: /ai ai_new2 ecart.removeZeroRow def
1.13 takayama 1361:
1362: } loop
1.14 takayama 1363: /arg1
1364: [ ai1
1365: ai1 {[wv 0 get weightv degreeShift 0 get] init} map %Getting gr of A_{i-1}
1.15 takayama 1366: [ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]]
1.14 takayama 1367: ai {[wv 0 get weightv degreeShiftUVnew] init} map %Getting gr of A_i
1368: ]
1369: def
1.13 takayama 1370: ] pop
1371: popVariables
1372: arg1
1373: } def
1374:
1.15 takayama 1375: /ecart.minimalResol {
1376: /arg1 set
1377: [/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables
1378: [
1379: /aa arg1 def
1380: /ans [ ] def
1381: /ansds [ ] def
1382: /ans_gr [ ] def
1383: /c 0 def
1384:
1385: (---- ecart.gen_input ----) message
1386: aa ecart.gen_input /gg0 set
1387: ansds gg0 3 get 3 get append /ansds set
1388: (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
1389: gg0 ecart.minimalBase /ssi set
1390: ansds ssi 2 get 3 get 3 get append /ansds set
1391: ans ssi 0 get append /ans set
1392: ans_gr ssi 1 get append /ans_gr set
1393: {
1394: ssi 3 get [ ] eq { exit } { } ifelse
1395: (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
1396: ssi 2 get ecart.minimalBase /ssi_new set
1397: ans ssi_new 0 get append /ans set
1398: ansds ssi_new 2 get 3 get 3 get append /ansds set
1399: ans_gr ssi_new 1 get append /ans_gr set
1400: /ssi ssi_new def
1401: } loop
1402: /arg1 [ans ansds ans_gr] def
1403: ] pop
1404: popVariables
1405: arg1
1406: } def
1407:
1408: (ecart.minimalResol) message
1409:
1410: [(ecart.minimalResol)
1411: [
1412:
1.18 takayama 1413: $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalResol $
1.15 takayama 1414: ( [resol degree_shifts gr_of_resol_by_uv_shift_m] )
1415: $Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
1416: $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
1417: $ [(degreeShift) [ [0] ] $
1418: $ (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $
1419: ]] putUsages
1.18 takayama 1420:
1421: %% for ecart.weight_vector
1422: /ecart.eliminationOrderTemplate { %% esize >= 1
1423: %% if esize == 0, it returns reverse lexicographic order.
1424: %% m esize eliminationOrderTemplate mat
1425: /arg2 set /arg1 set
1426: [/m /esize /m1 /m2 /k /om /omtmp] pushVariables
1427: [
1428: /m arg1 def /esize arg2 def
1429: /m1 m esize sub 1 sub def
1430: /m2 esize 1 sub def
1431: [esize 0 gt
1432: {
1433: [1 1 esize
1434: { pop 1 } for
1435: esize 1 << m 1 sub >>
1436: { pop 0 } for
1437: ] %% 1st vector
1438: }
1439: { } ifelse
1440:
1441: m esize gt
1442: {
1443: [1 1 esize
1444: { pop 0 } for
1445: esize 1 << m 1 sub >>
1446: { pop 1 } for
1447: ] %% 2nd vector
1448: }
1449: { } ifelse
1450:
1451: m1 0 gt
1452: {
1453: m 1 sub -1 << m m1 sub >>
1454: {
1455: /k set
1456: m k evec_neg
1457: } for
1458: }
1459: { } ifelse
1460:
1461: m2 0 gt
1462: {
1463: << esize 1 sub >> -1 1
1464: {
1465: /k set
1466: m k evec_neg
1467: } for
1468: }
1469: { } ifelse
1470:
1471: ] /om set
1472: om [ 0 << m 2 idiv >> 1 sub] 0 put
1473: om [ << m 2 idiv >> 1 add << m 2 idiv >> 1 sub] 0 put
1474: /arg1 om def
1475: ] pop
1476: popVariables
1477: arg1
1478: } def
1479:
1480: %note 2003.09.29
1481: /ecart.elimination_order {
1482: %% [x-list d-list params] (x,y,z) elimination_order
1483: %% vars evars
1484: %% [x-list d-list params order]
1485: /arg2 set /arg1 set
1486: [/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables
1487: /vars arg1 def /evars [arg2 to_records pop] def
1488: [
1489: /univ vars 0 get reverse
1490: vars 1 get reverse join
1491: def
1492:
1493: << univ length 2 sub >>
1494: << evars length >>
1495: ecart.eliminationOrderTemplate /order set
1496:
1497: [[1]] order oplus [[1]] oplus /order set
1498:
1499: /m order length 2 sub def
1500: /omtmp [1 1 m 2 add { pop 0 } for ] def
1501: omtmp << m 2 idiv >> 1 put
1502: order omtmp append /order set
1503: % order pmat
1504:
1505: /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
1506:
1507: /compl
1508: [univ 0 get] evars join evars univ0 complement join
1509: def
1510: compl univ
1511: getPerm /perm set
1512: %%perm :: univ :: compl ::
1513:
1514: order perm permuteOrderMatrix /order set
1515:
1516:
1517: vars [order] join /arg1 set
1518: ] pop
1519: popVariables
1520: arg1
1521: } def
1522:
1523: /ecart.define_ring {
1524: /arg1 set
1525: [/rp /param /foo] pushVariables
1526: [/rp arg1 def
1527:
1528: rp 0 get length 3 eq {
1529: rp 0 [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ]
1530: ( ) ecart.elimination_order put
1531: } { } ifelse
1532:
1533: [
1534: rp 0 get 0 get %% x-list
1535: rp 0 get 1 get %% d-list
1536: rp 0 get 2 get /param set
1537: param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example.
1538: param %% parameters.
1539: rp 0 get 3 get %% order matrix.
1540: rp length 2 eq
1541: { [ ] } %% null optional argument.
1542: { rp 2 get }
1543: ifelse
1544: ] /foo set
1545: foo aload pop set_up_ring@
1546: ] pop
1547: popVariables
1548: [(CurrentRingp)] system_variable
1549: } def
1550: /ecart.weight_vector {
1551: /arg2 set /arg1 set
1552: [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables
1553: /vars arg1 def /w-vectors arg2 def
1554: [
1555: /univ vars 0 get reverse
1556: vars 1 get reverse join
1557: def
1558: [
1559: 0 1 << w-vectors length 1 sub >>
1560: {
1561: /k set
1562: univ w-vectors k get w_to_vec
1563: } for
1564: ] /order1 set
1565: %% order1 ::
1566:
1567: vars ( ) ecart.elimination_order 3 get /order2 set
1568: vars [ << order1 order2 join >> ] join /arg1 set
1569: ] pop
1570: popVariables
1571: arg1
1572: } def
1573:
1574: %% end of for ecart.define_ring
1.19 takayama 1575:
1576: /ecartd.reduction {
1577: /arg2 set
1578: /arg1 set
1579: [/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables
1580: [(CurrentRingp) (KanGBmessage)] pushEnv
1581: [
1582: /gbasis arg2 def
1583: /flist arg1 def
1584: gbasis 0 get tag 6 eq { }
1585: { (ecartd.reduction: the second argument must be a list of lists) error }
1586: ifelse
1587:
1588: gbasis length 1 eq {
1589: gbasis getRing ring_def
1590: /gbasis2 gbasis 0 get def
1591: } {
1592: [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
1593: /gbasis2 gbasis 0 get ,,, def
1594: } ifelse
1595: ecartd.begin
1596:
1597: flist ,,, /flist set
1598: flist tag 6 eq {
1599: flist { gbasis2 reduction } map /ans set
1600: }{
1601: flist gbasis2 reduction /ans set
1602: } ifelse
1603: /arg1 ans def
1604:
1605: ecartd.end
1606: ] pop
1607: popEnv
1608: popVariables
1609: arg1
1610: } def
1611:
1612: /ecartd.reduction.test {
1613: [
1614: [( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
1615: (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]]
1616: ecartd.gb /gg set
1617:
1618: (Dx) [gg 0 get] ecartd.reduction /gg2 set
1619: gg2 message
1620: (-----------------------------) message
1621:
1622: [(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set
1623: gg3 message
1624:
1625: (-----------------------------) message
1626: [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )]
1627: (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
1628: (Dx) ggg ecartd.reduction /gg4 set
1629: gg4 message
1630: [gg2 gg3 gg4]
1631: } def
1632:
1633: /ecarth.reduction {
1634: /arg2 set
1635: /arg1 set
1636: [/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables
1637: [(CurrentRingp) (KanGBmessage)] pushEnv
1638: [
1639: /gbasis arg2 def
1640: /flist arg1 def
1641: gbasis 0 get tag 6 eq { }
1642: { (ecarth.reduction: the second argument must be a list of lists) error }
1643: ifelse
1644:
1645: gbasis length 1 eq {
1646: gbasis getRing ring_def
1647: /gbasis2 gbasis 0 get def
1648: } {
1649: [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
1650: /gbasis2 gbasis 0 get ,,, def
1651: } ifelse
1652: ecarth.begin
1653:
1654: flist ,,, /flist set
1655: flist tag 6 eq {
1656: flist { gbasis2 reduction } map /ans set
1657: }{
1658: flist gbasis2 reduction /ans set
1659: } ifelse
1660: /arg1 ans def
1661:
1662: ecarth.end
1663: ] pop
1664: popEnv
1665: popVariables
1666: arg1
1667: } def
1668:
1669: [(ecartd.reduction)
1670: [ (f basis ecartd.reduction r)
1671: (f is reduced by basis by the tangent cone algorithm.)
1.20 takayama 1672: (The first element of basis <g_1,...,g_m> must be a standard basis.)
1.19 takayama 1673: (r is the return value format of reduction.)
1.20 takayama 1674: (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
1675: (basis is given in the argument format of ecartd.gb.)
1.21 takayama 1676: $h[0,1](D)-homogenization is used.$
1.19 takayama 1677: (cf. reduction, ecartd.gb, ecartd.reduction.test )
1678: $Example:$
1679: $ [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] $
1680: $ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
1681: $ (Dx+Dy) ggg ecartd.reduction :: $
1682: ]] putUsages
1.22 takayama 1683:
1684: /ecart.stdOrder {
1685: /arg1 set
1686: [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2
1687: ] pushVariables
1688: [
1689: /vv arg1 def
1690: vv isString { [ vv to_records pop] /vv set }
1691: { } ifelse
1692: vv { toString} map /vv set
1693:
1694: vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
1695: dvv { 1 } map /wv1 set
1696: vv { -1 } map dvv { 1 } map join /wv2 set
1697: /arg1 [wv1 wv2 ] def
1.23 takayama 1698: ] pop
1699: popVariables
1.22 takayama 1700: arg1
1701: } def
1702:
1703: /ecartd.isSameIdeal_h {
1704: /arg1 set
1705: [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
1706: /ecartd.isSameIdeal_h.opt
1707: /save-ecart.autoHomogenize /wv /save-ecart.message.quiet
1708: ] pushVariables
1709: [(CurrentRingp) (Homogenize_vec)] pushEnv
1710: [
1711: /aa arg1 def
1712: gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse
1713: %% comparison of hilbert series has not yet been implemented.
1714: /save-ecart.message.quiet ecart.message.quiet def
1715: aa length 3 eq { }
1716: { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse
1717: /ii aa 0 get def
1718: /jj aa 1 get def
1719: /vv aa 2 get def
1720: ii length 0 eq jj length 0 eq and
1721: { /ans 1 def /LLL.ecartd.isSame_h goto } { } ifelse
1722:
1723: vv ecart.stdOrder /wv set
1724:
1725: /save-ecart.autoHomogenize ecart.autoHomogenize def
1726: /ecart.autoHomogenize 0 def
1727: [ii vv wv] ecartd.gb /iigg set
1728: [jj vv wv] ecartd.gb /jjgg set
1729: save-ecart.autoHomogenize /ecart.autoHomogenize set
1730:
1731: iigg getRing ring_def
1732:
1733: getOptions /ecartd.isSameIdeal_h.opt set
1734:
1735: /ans 1 def
1736: iigg 0 get /iigg set
1737: jjgg 0 get /jjgg set
1738: %%Bug: not implemented for the case of module.
1739:
1740: /save-ecart.message.quiet ecart.message.quiet def
1741: /ecart.message.quiet 1 def
1742: gb.verbose { (Comparing) message iigg message (and) message jjgg message }
1743: { } ifelse
1744: gb.verbose { ( ii < jj ?) messagen } { } ifelse
1745: iigg length /n set
1746: 0 1 n 1 sub {
1747: /k set
1748: iigg k get
1749: [jjgg vv wv] ecartd.reduction 0 get
1750: (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse
1751: gb.verbose { (o) messagen } { } ifelse
1752: } for
1753: gb.verbose { ( jj < ii ?) messagen } { } ifelse
1754: jjgg length /n set
1755: 0 1 n 1 sub {
1756: /k set
1757: jjgg k get
1758: [iigg vv wv] ecartd.reduction 0 get
1759: (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse
1760: gb.verbose { (o) messagen } { } ifelse
1761: } for
1762: /LLL.ecartd.isSame_h
1763: gb.verbose { ( Done) message } { } ifelse
1764: save-ecart.message.quiet /ecart.message.quiet set
1765: ecartd.isSameIdeal_h.opt restoreOptions
1766: /arg1 ans def
1767: ] pop
1768: popEnv
1769: popVariables
1770: arg1
1771: } def
1772: (ecartd.isSameIdeal_h ) messagen-quiet
1773:
1774: [(ecartd.isSameIdeal_h)
1775: [([ii jj vv] ecartd.isSameIdeal_h bool)
1776: (ii, jj : ideal, vv : variables)
1777: $The ideals ii and jj will be compared in the ring h[0,1](D).$
1778: $ii and jj are re-parsed.$
1779: $Example 1: [ [((1-x) Dx + h)] [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
1.23 takayama 1780: ]] putUsages
1781:
1782: /ecart.01Order {
1783: /arg1 set
1784: [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2
1785: ] pushVariables
1786: [
1787: /vv arg1 def
1788: vv isString { [ vv to_records pop] /vv set }
1789: { } ifelse
1790: vv { toString} map /vv set
1791:
1792: vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
1793: dvv { 1 } map /wv1 set
1794: /arg1 [wv1] def
1795: ] pop
1796: popVariables
1797: arg1
1798: } def
1799: /ecart.homogenize01Ideal {
1800: /arg1 set
1801: [/in.ecart.homogenize01Ideal /ll /vv /wv] pushVariables
1802: [
1803: /ll arg1 0 get def
1804: /vv arg1 1 get def
1805: vv isArray { vv from_records /vv set } { } ifelse
1806: vv ecart.01Order /wv set
1807: [vv ring_of_differential_operators 0] define_ring
1808: ll ,,, /ll set ll dehomogenize /ll set
1809: [ll vv wv] gb 0 get /ll set
1810:
1811: ecart.begin
1812: [vv ring_of_differential_operators
1813: vv ecart.stdOrder weight_vector 0
1814: [(weightedHomogenization) 1]] define_ring
1815: ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /arg1 set
1816: ] pop
1817: popVariables
1818: arg1
1819: } def
1820: [(ecart.homogenize01Ideal)
1821: [([ii vv] ecartd.homogenize01Ideal)
1822: (ii : ideal, vv : variables)
1823: $The ideal ii is homogenized in h[0,1](D).$
1824: $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $
1.22 takayama 1825: ]] putUsages
1826:
1.18 takayama 1827:
1.5 takayama 1828:
1.2 takayama 1829: ( ) message-quiet
1.5 takayama 1830:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ecart.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc