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