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