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