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