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