Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.12
1.12 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.11 2003/08/24 05:19:44 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:
19: /ecart.dehomogenize {
20: /arg1 set
21: [/in.ecart.dehomogenize /ll /rr] pushVariables
22: [
23: /ll arg1 def
24: ll tag 6 eq {
25: ll { ecart.dehomogenize } map /ll set
26: } {
27: ll (0). eq {
28: } {
29: ll getRing /rr set
30: ll [ [ (H) rr ,, (1) rr ,, ]
31: [ (h) rr ,, (1) rr ,, ]] replace
32: /ll set
33: } ifelse
34: } ifelse
35: /arg1 ll def
36: ] pop
37: popVariables
38: arg1
39: } def
40: [(ecart.dehomogenize)
41: [(obj ecart.dehomogenize r)
42: (h->1, H->1)
43: ]] putUsages
44:
45: /ecart.dehomogenizeH {
46: /arg1 set
47: [/in.ecart.dehomogenize /ll /rr] pushVariables
48: [
49: /ll arg1 def
50: ll tag 6 eq {
51: ll { ecart.dehomogenize } map /ll set
52: } {
53: ll (0). eq {
54: } {
55: ll getRing /rr set
56: ll [ [ (H) rr ,, (1) rr ,, ] ] replace
57: /ll set
58: } ifelse
59: } ifelse
60: /arg1 ll def
61: ] pop
62: popVariables
63: arg1
64: } def
65: [(ecart.dehomogenizeH)
66: [(obj ecart.dehomogenizeH r)
67: (H->1, h is not changed.)
68: ]] putUsages
69:
70: /ecart.homogenize01 {
71: /arg1 set
1.11 takayama 72: [/in.ecart.homogenize01 /ll /ll0] pushVariables
1.1 takayama 73: [
74: /ll arg1 def
1.11 takayama 75: ll tag ArrayP eq {
76: ll 0 get tag ArrayP eq not {
77: [(degreeShift) [ ] ll ] homogenize /arg1 set
78: } {
79: ll { ecart.homogenize01 } map /arg1 set
80: } ifelse
81: } {
82: [(degreeShift) [ ] ll ] homogenize /arg1 set
1.12 ! takayama 83: } ifelse
1.1 takayama 84: ] pop
85: popVariables
86: arg1
87: } def
88: [(ecart.homogenize01)
89: [(obj ecart.homogenize01 r)
90: (Example: )
91: ( [(x1,x2) ring_of_differential_operators )
92: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
93: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
94: ( [(Dx1) 1 (Dx2) 1] )
95: ( [(x1) -1 (x2) -1])
96: ( ] weight_vector )
97: ( 0 )
1.11 takayama 98: ( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
1.1 takayama 99: ( ] define_ring)
100: ( ecart.begin)
101: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
102: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
1.11 takayama 103: ( {ecart.homogenize01} map /eqs2 set)
1.1 takayama 104: ( [eqs2] groebner )
105: ]] putUsages
106:
107: /ecart.homogenize01_with_shiftVector {
108: /arg2.set
109: /arg1 set
1.11 takayama 110: [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
1.1 takayama 111: [
112: /sv arg2 def
113: /ll arg1 def
1.11 takayama 114: ll tag ArrayP eq {
115: ll 0 get tag ArrayP eq not {
116: [(degreeShift) sv ll ] homogenize /arg1 set
117: } {
118: ll { ecart.homogenize01_with_shiftVector } map /arg1 set
119: } ifelse
120: } {
121: [(degreeShift) sv ll ] homogenize /arg1 set
1.12 ! takayama 122: } ifelse
1.1 takayama 123: ] pop
124: popVariables
125: arg1
126: } def
127: [(ecart.dehomogenize01_with_degreeShift)
128: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
1.11 takayama 129: (cf. homogenize)
1.1 takayama 130: ]] putUsages
131:
132: %% Aux functions to return the default weight vectors.
133: /ecart.wv1 {
134: /arg1 set
135: [/in.ecart.wv1 /v] pushVariables
136: [
137: /v arg1 def
138: [(H) (h) v to_records pop] /v set
139: v { 1 } map /v set
140: /arg1 v def
141: ] pop
142: popVariables
143: arg1
144: } def
145: /ecart.wv2 {
146: /arg1 set
147: [/in.ecart.wv2 /v] pushVariables
148: [
149: /v arg1 def
150: [v to_records pop] /v set
151: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
152: [(h) 1 ] v join /v set
153: /arg1 v def
154: ] pop
155: popVariables
156: arg1
157: } def
158:
1.7 takayama 159: /ecart.gb {ecartd.gb} def
160:
161: [(ecart.gb)
162: [(a ecart.gb b)
163: (array a; array b;)
164: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
165: ( in the ring of differential operators.)
166: (The computation is done by using Ecart division algorithm and )
167: (the double homogenization.)
168: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
169: $ ii is the initial ideal in case of w is given or <<a>> belongs$
170: $ to a ring. In the other cases, it returns the initial monominal.$
171: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
172: (a : [f v]; array f; string v; v is the variables. )
173: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
174: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
1.11 takayama 175: ( array ds; ds is the degree shift for the ring. )
176: (a : [f v w ds hdShift]; array f; string v; array of array w; w is the weight matirx.)
177: ( array ds; ds is the degree shift for the ring. )
178: ( array hsShift is the degree shift for the homogenization. cf.homogenize )
179: $a : [f v w ds (no)]; array f; string v; array of array w; w is the weight matirx.$
180: ( No automatic homogenization.)
1.7 takayama 181: ( )
182: $cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize) $
183: ( )
184: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
185: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
186: (Example 2: )
187: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.9 takayama 188: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /ff set ff pmat ;$
189: (To set the current ring to the ring in which ff belongs )
190: ( ff getRing ring_def )
1.7 takayama 191: ( )
192: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
193: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
1.10 takayama 194: ( This example will cause an error on order.)
1.7 takayama 195: ( )
196: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
197: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.10 takayama 198: ( This example will cause an error on order.)
1.7 takayama 199: ( )
200: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
201: $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
202: ( )
203: (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
204: ( ecart.dehomogenize, ecart.dehomogenizeH)
205: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
206: ( define_ring )
207: (/ecart.autoHomogenize 0 def )
208: ( not to dehomogenize and homogenize)
209: ]] putUsages
210:
1.1 takayama 211: /ecart.gb.verbose 1 def
1.12 ! takayama 212: %ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb.
1.7 takayama 213: /ecarth.gb {
1.1 takayama 214: /arg1 set
1.7 takayama 215: [/in-ecarth.gb /aa /typev /setarg /f /v
1.1 takayama 216: /gg /wv /vec /ans /rr /mm
217: /degreeShift /env2 /opt /ans.gb
1.12 ! takayama 218: /hdShift
1.1 takayama 219: ] pushVariables
220: [(CurrentRingp) (KanGBmessage)] pushEnv
221: [
222: /aa arg1 def
223: aa isArray { } { ( << array >> gb) error } ifelse
224: /setarg 0 def
225: /wv 0 def
226: /degreeShift 0 def
1.12 ! takayama 227: /hdShift 0 def
1.1 takayama 228: /opt [(weightedHomogenization) 1] def
229: aa { tag } map /typev set
230: typev [ ArrayP ] eq
231: { /f aa 0 get def
232: /v gb.v def
233: /setarg 1 def
234: } { } ifelse
235: typev [ArrayP StringP] eq
236: { /f aa 0 get def
237: /v aa 1 get def
238: /setarg 1 def
239: } { } ifelse
240: typev [ArrayP RingP] eq
241: { /f aa 0 get def
242: /v aa 1 get def
243: /setarg 1 def
244: } { } ifelse
245: typev [ArrayP ArrayP] eq
246: { /f aa 0 get def
247: /v aa 1 get from_records def
248: /setarg 1 def
249: } { } ifelse
250: typev [ArrayP StringP ArrayP] eq
251: { /f aa 0 get def
252: /v aa 1 get def
253: /wv aa 2 get def
254: /setarg 1 def
255: } { } ifelse
256: typev [ArrayP ArrayP ArrayP] eq
257: { /f aa 0 get def
258: /v aa 1 get from_records def
259: /wv aa 2 get def
260: /setarg 1 def
261: } { } ifelse
262: typev [ArrayP StringP ArrayP ArrayP] eq
263: { /f aa 0 get def
264: /v aa 1 get def
265: /wv aa 2 get def
266: /degreeShift aa 3 get def
267: /setarg 1 def
268: } { } ifelse
1.12 ! takayama 269:
! 270: typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
! 271: { /f aa 0 get def
! 272: /v aa 1 get def
! 273: /wv aa 2 get def
! 274: /degreeShift aa 3 get def
! 275: /hdShift aa 4 get def
! 276: /setarg 1 def
! 277: } { } ifelse
1.1 takayama 278: typev [ArrayP ArrayP ArrayP ArrayP] eq
279: { /f aa 0 get def
280: /v aa 1 get from_records def
281: /wv aa 2 get def
282: /degreeShift aa 3 get def
283: /setarg 1 def
284: } { } ifelse
1.12 ! takayama 285: typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
! 286: { /f aa 0 get def
! 287: /v aa 1 get from_records def
! 288: /wv aa 2 get def
! 289: /degreeShift aa 3 get def
! 290: /hdShift aa 4 get def
! 291: /setarg 1 def
! 292: } { } ifelse
! 293: typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
! 294: { /f aa 0 get def
! 295: /v aa 1 get from_records def
! 296: /wv aa 2 get def
! 297: /degreeShift aa 3 get def
! 298: aa 4 get (no) eq {
! 299: /hdShift -1 def
! 300: } {
! 301: (Unknown keyword for the 5th argument) error
! 302: } ifelse
! 303: /setarg 1 def
! 304: } { } ifelse
1.1 takayama 305:
306: /env1 getOptions def
307:
1.12 ! takayama 308: ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } { } ifelse
! 309: setarg { } { (ecarth.gb : Argument mismatch) error } ifelse
1.1 takayama 310:
311: [(KanGBmessage) ecart.gb.verbose ] system_variable
312:
313: %%% Start of the preprocess
314: v tag RingP eq {
315: /rr v def
316: }{
317: f getRing /rr set
318: } ifelse
319: %% To the normal form : matrix expression.
320: f gb.toMatrixOfString /f set
321: /mm gb.itWasMatrix def
322:
323: rr tag 0 eq {
324: %% Define our own ring
325: v isInteger {
326: (Error in gb: Specify variables) error
327: } { } ifelse
328: wv isInteger {
329: [v ring_of_differential_operators
1.6 takayama 330: % [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3 takayama 331: gb.characteristic
1.1 takayama 332: opt
333: ] define_ring
334: }{
335: degreeShift isInteger {
336: [v ring_of_differential_operators
1.6 takayama 337: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
338: wv weight_vector
1.3 takayama 339: gb.characteristic
1.1 takayama 340: opt
341: ] define_ring
342:
343: }{
344: [v ring_of_differential_operators
1.6 takayama 345: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
346: wv weight_vector
1.3 takayama 347: gb.characteristic
1.1 takayama 348: [(degreeShift) degreeShift] opt join
349: ] define_ring
350:
351: } ifelse
352: } ifelse
353: } {
354: %% Use the ring structre given by the input.
355: v isInteger not {
356: gb.warning {
357: (Warning : the given ring definition is not used.) message
358: } { } ifelse
359: } { } ifelse
360: rr ring_def
361: /wv rr gb.getWeight def
362:
363: } ifelse
364: %%% Enf of the preprocess
365:
366: ecart.gb.verbose {
1.6 takayama 367: (The first and the second weight vectors for automatic homogenization: )
1.1 takayama 368: message
369: v ecart.wv1 message
370: v ecart.wv2 message
371: degreeShift isInteger { }
372: {
373: (The degree shift is ) messagen
374: degreeShift message
375: } ifelse
376: } { } ifelse
377:
1.5 takayama 378: %%BUG: case of v is integer
379: v ecart.checkOrder
380:
1.1 takayama 381: ecart.begin
382:
383: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
384: ecart.autoHomogenize {
1.12 ! takayama 385: (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized.)
1.1 takayama 386: message
387: } { } ifelse
1.12 ! takayama 388:
! 389: hdShift tag 1 eq {
! 390: ecart.autoHomogenize not hdShift -1 eq or {
! 391: % No automatic h-s-homogenization.
! 392: f { {. } map} map /f set
! 393: } {
! 394: % Automatic h-s-homogenization without degreeShift
! 395: f { {. ecart.dehomogenize} map} map /f set
! 396: f ecart.homogenize01 /f set
! 397: } ifelse
! 398: } {
! 399: % Automatic h-s-homogenization with degreeShift
! 400: f { {. ecart.dehomogenize} map} map /f set
! 401: f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
! 402: }ifelse
! 403:
1.1 takayama 404: ecart.needSyz {
405: [f [(needSyz)] gb.options join ] groebner /gg set
406: } {
407: [f gb.options] groebner 0 get /gg set
408: } ifelse
409:
410: ecart.needSyz {
411: mm {
412: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
1.11 takayama 413: } { /ans.gb gg 0 get def } ifelse
414: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
415: % ans pmat ;
1.1 takayama 416: } {
417: wv isInteger {
418: /ans [gg gg {init} map] def
419: }{
1.10 takayama 420: degreeShift isInteger {
421: /ans [gg gg {wv 0 get weightv init} map] def
422: } {
423: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
424: } ifelse
1.1 takayama 425: }ifelse
426:
427: %% Postprocess : recover the matrix expression.
428: mm {
429: ans { /tmp set [mm tmp] toVectors } map
430: /ans set
431: }{ }
432: ifelse
433: } ifelse
434:
435: ecart.end
436:
437: %%
438: env1 restoreOptions %% degreeShift changes "grade"
439:
440: /arg1 ans def
441: ] pop
442: popEnv
443: popVariables
444: arg1
445: } def
1.7 takayama 446: (ecarth.gb ) messagen-quiet
1.1 takayama 447:
1.7 takayama 448: [(ecarth.gb)
449: [(a ecarth.gb b)
1.1 takayama 450: (array a; array b;)
451: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
452: ( in the ring of differential operators.)
1.12 ! takayama 453: (The computation is done by using Ecart division algorithm.)
! 454: $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$
! 455: (they are not dehomogenized.)
1.1 takayama 456: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
457: $ ii is the initial ideal in case of w is given or <<a>> belongs$
458: $ to a ring. In the other cases, it returns the initial monominal.$
459: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
460: (a : [f v]; array f; string v; v is the variables. )
461: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
462: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
463: ( array ds; ds is the degree shift )
464: ( )
465: (/ecart.autoHomogenize 0 def )
466: ( not to dehomogenize and homogenize)
467: ( )
468: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 469: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 470: (Example 2: )
471: (To put H and h=1, type in, e.g., )
472: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.7 takayama 473: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
1.1 takayama 474: ( )
475: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 476: $ [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
1.1 takayama 477: ( )
478: $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 479: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 480: ( )
481: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.7 takayama 482: $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$
1.1 takayama 483: ( )
1.7 takayama 484: (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
1.1 takayama 485: ( ecart.dehomogenize, ecart.dehomogenizeH)
486: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
487: ( define_ring )
488: ]] putUsages
489:
490:
491: /ecart.syz {
492: /arg1 set
493: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
494: [
495: /ff arg1 def
496: /ecart.save.needSyz ecart.needSyz def
497: /ecart.needSyz 1 def
498: ff ecart.gb /ff.ans set
499: /ecart.needSyz ecart.save.needSyz def
500: /arg1 ff.ans def
501: ] pop
502: popVariables
503: arg1
504: } def
505: (ecart.syz ) messagen-quiet
506:
507: [(ecart.syz)
508: [(a ecart.syz b)
509: (array a; array b;)
510: $b : [syzygy gb tmat input]; gb = tmat * input $
511: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.8 takayama 512: $ [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
1.1 takayama 513: $ ff 0 get ff 3 get mul pmat $
514: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
515: ( )
1.9 takayama 516: (To set the current ring to the ring in which ff belongs )
517: ( ff getRing ring_def )
1.1 takayama 518: $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 519: $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
1.1 takayama 520: ( )
521: (cf. ecart.gb)
522: ( /ecart.autoHomogenize 0 def )
523: ]] putUsages
1.2 takayama 524:
1.3 takayama 525:
526: /ecartn.begin {
527: (red@) (standard) switch_function
528: %% (red@) (ecart) switch_function
529: [(Ecart) 1] system_variable
530: [(CheckHomogenization) 0] system_variable
531: [(ReduceLowerTerms) 0] system_variable
532: [(AutoReduce) 0] system_variable
533: [(EcartAutomaticHomogenization) 0] system_variable
534: } def
535: /ecartn.gb {
536: /arg1 set
537: [/in-ecartn.gb /aa /typev /setarg /f /v
538: /gg /wv /vec /ans /rr /mm
539: /degreeShift /env2 /opt /ans.gb
540: ] pushVariables
541: [(CurrentRingp) (KanGBmessage)] pushEnv
542: [
543: /aa arg1 def
544: aa isArray { } { ( << array >> gb) error } ifelse
545: /setarg 0 def
546: /wv 0 def
547: /degreeShift 0 def
548: /opt [(weightedHomogenization) 1] def
549: aa { tag } map /typev set
550: typev [ ArrayP ] eq
551: { /f aa 0 get def
552: /v gb.v def
553: /setarg 1 def
554: } { } ifelse
555: typev [ArrayP StringP] eq
556: { /f aa 0 get def
557: /v aa 1 get def
558: /setarg 1 def
559: } { } ifelse
560: typev [ArrayP RingP] eq
561: { /f aa 0 get def
562: /v aa 1 get def
563: /setarg 1 def
564: } { } ifelse
565: typev [ArrayP ArrayP] eq
566: { /f aa 0 get def
567: /v aa 1 get from_records def
568: /setarg 1 def
569: } { } ifelse
570: typev [ArrayP StringP ArrayP] eq
571: { /f aa 0 get def
572: /v aa 1 get def
573: /wv aa 2 get def
574: /setarg 1 def
575: } { } ifelse
576: typev [ArrayP ArrayP ArrayP] eq
577: { /f aa 0 get def
578: /v aa 1 get from_records def
579: /wv aa 2 get def
580: /setarg 1 def
581: } { } ifelse
582: typev [ArrayP StringP ArrayP ArrayP] eq
583: { /f aa 0 get def
584: /v aa 1 get def
585: /wv aa 2 get def
586: /degreeShift aa 3 get def
587: /setarg 1 def
588: } { } ifelse
589: typev [ArrayP ArrayP ArrayP ArrayP] eq
590: { /f aa 0 get def
591: /v aa 1 get from_records def
592: /wv aa 2 get def
593: /degreeShift aa 3 get def
594: /setarg 1 def
595: } { } ifelse
596:
597: /env1 getOptions def
598:
599: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
600:
601: [(KanGBmessage) ecart.gb.verbose ] system_variable
602:
603: %%% Start of the preprocess
604: v tag RingP eq {
605: /rr v def
606: }{
607: f getRing /rr set
608: } ifelse
609: %% To the normal form : matrix expression.
610: f gb.toMatrixOfString /f set
611: /mm gb.itWasMatrix def
612:
613: rr tag 0 eq {
614: %% Define our own ring
615: v isInteger {
616: (Error in gb: Specify variables) error
617: } { } ifelse
618: wv isInteger {
619: [v ring_of_differential_operators
620: [ v ecart.wv1 v ecart.wv2 ] weight_vector
621: gb.characteristic
622: opt
623: ] define_ring
624: }{
625: degreeShift isInteger {
626: [v ring_of_differential_operators
627: [v ecart.wv1 v ecart.wv2] wv join weight_vector
628: gb.characteristic
629: opt
630: ] define_ring
631:
632: }{
633: [v ring_of_differential_operators
634: [v ecart.wv1 v ecart.wv2] wv join weight_vector
635: gb.characteristic
636: [(degreeShift) degreeShift] opt join
637: ] define_ring
638:
639: } ifelse
640: } ifelse
641: } {
642: %% Use the ring structre given by the input.
643: v isInteger not {
644: gb.warning {
645: (Warning : the given ring definition is not used.) message
646: } { } ifelse
647: } { } ifelse
648: rr ring_def
649: /wv rr gb.getWeight def
650:
651: } ifelse
652: %%% Enf of the preprocess
653:
654: ecart.gb.verbose {
655: (The first and the second weight vectors are automatically set as follows)
656: message
657: v ecart.wv1 message
658: v ecart.wv2 message
659: degreeShift isInteger { }
660: {
661: (The degree shift is ) messagen
662: degreeShift message
663: } ifelse
664: } { } ifelse
665:
1.5 takayama 666: %%BUG: case of v is integer
667: v ecart.checkOrder
668:
1.3 takayama 669: ecartn.begin
670:
671: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
672: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
673: ecart.autoHomogenize {
674: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
675: message
676: } { } ifelse
677: ecart.autoHomogenize {
678: f { {. ecart.dehomogenize} map} map /f set
679: f ecart.homogenize01 /f set
680: }{
681: f { {. } map } map /f set
682: } ifelse
683: ecart.needSyz {
684: [f [(needSyz)] gb.options join ] groebner /gg set
685: } {
686: [f gb.options] groebner 0 get /gg set
687: } ifelse
688:
689: ecart.needSyz {
690: mm {
691: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
692: } { /ans.gb gg 0 get def } ifelse
693: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 takayama 694: % ans pmat ;
1.3 takayama 695: } {
696: wv isInteger {
697: /ans [gg gg {init} map] def
698: }{
1.10 takayama 699: degreeShift isInteger {
700: /ans [gg gg {wv 0 get weightv init} map] def
701: } {
702: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
703: } ifelse
1.3 takayama 704: }ifelse
705:
706: %% Postprocess : recover the matrix expression.
707: mm {
708: ans { /tmp set [mm tmp] toVectors } map
709: /ans set
710: }{ }
711: ifelse
712: } ifelse
713:
714: ecart.end
715:
716: %%
717: env1 restoreOptions %% degreeShift changes "grade"
718:
719: /arg1 ans def
720: ] pop
721: popEnv
722: popVariables
723: arg1
724: } def
725: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 takayama 726:
727: /ecartd.gb {
728: /arg1 set
729: [/in-ecart.gb /aa /typev /setarg /f /v
730: /gg /wv /vec /ans /rr /mm
731: /degreeShift /env2 /opt /ans.gb
1.11 takayama 732: /hdShift
1.4 takayama 733: ] pushVariables
734: [(CurrentRingp) (KanGBmessage)] pushEnv
735: [
736: /aa arg1 def
737: aa isArray { } { ( << array >> gb) error } ifelse
738: /setarg 0 def
739: /wv 0 def
740: /degreeShift 0 def
1.11 takayama 741: /hdShift 0 def
1.4 takayama 742: /opt [(weightedHomogenization) 1] def
743: aa { tag } map /typev set
744: typev [ ArrayP ] eq
745: { /f aa 0 get def
746: /v gb.v def
747: /setarg 1 def
748: } { } ifelse
749: typev [ArrayP StringP] eq
750: { /f aa 0 get def
751: /v aa 1 get def
752: /setarg 1 def
753: } { } ifelse
754: typev [ArrayP RingP] eq
755: { /f aa 0 get def
756: /v aa 1 get def
757: /setarg 1 def
758: } { } ifelse
759: typev [ArrayP ArrayP] eq
760: { /f aa 0 get def
761: /v aa 1 get from_records def
762: /setarg 1 def
763: } { } ifelse
764: typev [ArrayP StringP ArrayP] eq
765: { /f aa 0 get def
766: /v aa 1 get def
767: /wv aa 2 get def
768: /setarg 1 def
769: } { } ifelse
770: typev [ArrayP ArrayP ArrayP] eq
771: { /f aa 0 get def
772: /v aa 1 get from_records def
773: /wv aa 2 get def
774: /setarg 1 def
775: } { } ifelse
776: typev [ArrayP StringP ArrayP ArrayP] eq
777: { /f aa 0 get def
778: /v aa 1 get def
779: /wv aa 2 get def
780: /degreeShift aa 3 get def
781: /setarg 1 def
782: } { } ifelse
783: typev [ArrayP ArrayP ArrayP ArrayP] eq
784: { /f aa 0 get def
785: /v aa 1 get from_records def
786: /wv aa 2 get def
787: /degreeShift aa 3 get def
788: /setarg 1 def
789: } { } ifelse
1.11 takayama 790: typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
791: { /f aa 0 get def
792: /v aa 1 get def
793: /wv aa 2 get def
794: /degreeShift aa 3 get def
795: /hdShift aa 4 get def
796: /setarg 1 def
797: } { } ifelse
798: typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
799: { /f aa 0 get def
800: /v aa 1 get from_records def
801: /wv aa 2 get def
802: /degreeShift aa 3 get def
803: /hdShift aa 4 get def
804: /setarg 1 def
805: } { } ifelse
806: typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
807: { /f aa 0 get def
808: /v aa 1 get from_records def
809: /wv aa 2 get def
810: /degreeShift aa 3 get def
811: aa 4 get (no) eq {
812: /hdShift -1 def
813: } {
814: (Unknown keyword for the 5th argument) error
815: } ifelse
816: /setarg 1 def
817: } { } ifelse
1.4 takayama 818:
819: /env1 getOptions def
820:
821: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
822:
823: [(KanGBmessage) ecart.gb.verbose ] system_variable
824: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
825:
826: %%% Start of the preprocess
827: v tag RingP eq {
828: /rr v def
829: }{
830: f getRing /rr set
831: } ifelse
832: %% To the normal form : matrix expression.
833: f gb.toMatrixOfString /f set
834: /mm gb.itWasMatrix def
835:
836: rr tag 0 eq {
837: %% Define our own ring
838: v isInteger {
839: (Error in gb: Specify variables) error
840: } { } ifelse
841: wv isInteger {
842: (Give an weight vector such that x < 1) error
843: }{
844: degreeShift isInteger {
845: [v ring_of_differential_operators
846: wv weight_vector
847: gb.characteristic
848: opt
849: ] define_ring
850:
851: }{
852: [v ring_of_differential_operators
853: wv weight_vector
854: gb.characteristic
855: [(degreeShift) degreeShift] opt join
856: ] define_ring
857:
858: } ifelse
859: } ifelse
860: } {
861: %% Use the ring structre given by the input.
862: v isInteger not {
863: gb.warning {
864: (Warning : the given ring definition is not used.) message
865: } { } ifelse
866: } { } ifelse
867: rr ring_def
868: /wv rr gb.getWeight def
869:
870: } ifelse
871: %%% Enf of the preprocess
872:
873: ecart.gb.verbose {
874: degreeShift isInteger { }
875: {
876: (The degree shift is ) messagen
877: degreeShift message
878: } ifelse
879: } { } ifelse
880:
1.5 takayama 881: %%BUG: case of v is integer
882: v ecart.checkOrder
883:
1.8 takayama 884: ecartd.begin
1.4 takayama 885:
886: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
887:
1.11 takayama 888: hdShift tag 1 eq {
1.12 ! takayama 889: ecart.autoHomogenize not hdShift -1 eq or {
1.11 takayama 890: % No automatic h-homogenization.
891: f { {. } map} map /f set
892: } {
893: % Automatic h-homogenization without degreeShift
894: f { {. ecart.dehomogenize} map} map /f set
895: f ecart.homogenize01 /f set
896: f { { [[(H). (1).]] replace } map } map /f set
897: } ifelse
898: } {
899: % Automatic h-homogenization with degreeShift
900: f { {. ecart.dehomogenize} map} map /f set
901: f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
902: f { { [[(H). (1).]] replace } map } map /f set
903: }ifelse
1.4 takayama 904:
905: ecart.needSyz {
906: [f [(needSyz)] gb.options join ] groebner /gg set
907: } {
908: [f gb.options] groebner 0 get /gg set
909: } ifelse
910:
911: ecart.needSyz {
912: mm {
913: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
914: } { /ans.gb gg 0 get def } ifelse
915: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 takayama 916: % ans pmat ;
1.4 takayama 917: } {
918: wv isInteger {
919: /ans [gg gg {init} map] def
920: }{
1.11 takayama 921: %% Get the initial ideal
1.10 takayama 922: degreeShift isInteger {
923: /ans [gg gg {wv 0 get weightv init} map] def
924: } {
925: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
926: } ifelse
1.4 takayama 927: }ifelse
928:
929: %% Postprocess : recover the matrix expression.
930: mm {
931: ans { /tmp set [mm tmp] toVectors } map
932: /ans set
933: }{ }
934: ifelse
935: } ifelse
936:
1.8 takayama 937: ecartd.end
1.4 takayama 938:
939: %%
940: env1 restoreOptions %% degreeShift changes "grade"
941:
942: /arg1 ans def
943: ] pop
944: popEnv
945: popVariables
946: arg1
947: } def
948: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 949:
1.5 takayama 950: /ecart.checkOrder {
951: /arg1 set
952: [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
953: [
954: /vv arg1 def
955: vv isArray
956: { } { [vv to_records pop] /vv set } ifelse
957: vv {toString} map /vv set
958: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
959: % Starting the checks.
960: 0 1 vv length 1 sub {
961: /i set
962: vv i get . dd i get . mul /tt set
963: tt @@@.hsymbol . add init tt eq { }
964: { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
965: } for
966:
967: 0 1 vv length 1 sub {
968: /i set
969: vv i get . /tt set
970: tt (1). add init (1). eq { }
1.6 takayama 971: { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5 takayama 972: } for
973: /arg1 1 def
974: ] pop
975: popVariables
976: arg1
977: } def
978: [(ecart.checkOrder)
979: [(v ecart.checkOrder bool checks if the given order is relevant)
980: (for the ecart division.)
981: (cf. ecartd.gb, ecart.gb, ecartn.gb)
982: ]
983: ] putUsages
984:
985: /ecart.wv_last {
986: /arg1 set
987: [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
988: [
989: /vv arg1 def
990: vv isArray
991: { } { [vv to_records pop] /vv set } ifelse
992: vv {toString} map /vv set
993: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
994: vv { -1 } map
995: dd { 1 } map join /arg1 set
996: ] pop
997: popVariables
998: arg1
999: } def
1000: [(ecart.wv_last)
1001: [(v ecart.wv_last wt )
1002: (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
1003: (Use this weight vector as the last weight vector for ecart division)
1004: (if ecart.checkOrder complains about the order given.)
1005: ]
1006: ] putUsages
1007:
1.2 takayama 1008: ( ) message-quiet
1.5 takayama 1009:
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