Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.11
1.11 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.10 2003/08/23 02:28:40 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
! 83: }
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
! 122: }
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.7 takayama 212: /ecarth.gb {
1.1 takayama 213: /arg1 set
1.7 takayama 214: [/in-ecarth.gb /aa /typev /setarg /f /v
1.1 takayama 215: /gg /wv /vec /ans /rr /mm
216: /degreeShift /env2 /opt /ans.gb
217: ] pushVariables
218: [(CurrentRingp) (KanGBmessage)] pushEnv
219: [
220: /aa arg1 def
221: aa isArray { } { ( << array >> gb) error } ifelse
222: /setarg 0 def
223: /wv 0 def
224: /degreeShift 0 def
225: /opt [(weightedHomogenization) 1] def
226: aa { tag } map /typev set
227: typev [ ArrayP ] eq
228: { /f aa 0 get def
229: /v gb.v def
230: /setarg 1 def
231: } { } ifelse
232: typev [ArrayP StringP] eq
233: { /f aa 0 get def
234: /v aa 1 get def
235: /setarg 1 def
236: } { } ifelse
237: typev [ArrayP RingP] eq
238: { /f aa 0 get def
239: /v aa 1 get def
240: /setarg 1 def
241: } { } ifelse
242: typev [ArrayP ArrayP] eq
243: { /f aa 0 get def
244: /v aa 1 get from_records def
245: /setarg 1 def
246: } { } ifelse
247: typev [ArrayP StringP ArrayP] eq
248: { /f aa 0 get def
249: /v aa 1 get def
250: /wv aa 2 get def
251: /setarg 1 def
252: } { } ifelse
253: typev [ArrayP ArrayP ArrayP] eq
254: { /f aa 0 get def
255: /v aa 1 get from_records def
256: /wv aa 2 get def
257: /setarg 1 def
258: } { } ifelse
259: typev [ArrayP StringP ArrayP ArrayP] eq
260: { /f aa 0 get def
261: /v aa 1 get def
262: /wv aa 2 get def
263: /degreeShift aa 3 get def
264: /setarg 1 def
265: } { } ifelse
266: typev [ArrayP ArrayP ArrayP ArrayP] eq
267: { /f aa 0 get def
268: /v aa 1 get from_records def
269: /wv aa 2 get def
270: /degreeShift aa 3 get def
271: /setarg 1 def
272: } { } ifelse
273:
274: /env1 getOptions def
275:
276: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
277:
278: [(KanGBmessage) ecart.gb.verbose ] system_variable
279:
280: %%% Start of the preprocess
281: v tag RingP eq {
282: /rr v def
283: }{
284: f getRing /rr set
285: } ifelse
286: %% To the normal form : matrix expression.
287: f gb.toMatrixOfString /f set
288: /mm gb.itWasMatrix def
289:
290: rr tag 0 eq {
291: %% Define our own ring
292: v isInteger {
293: (Error in gb: Specify variables) error
294: } { } ifelse
295: wv isInteger {
296: [v ring_of_differential_operators
1.6 takayama 297: % [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3 takayama 298: gb.characteristic
1.1 takayama 299: opt
300: ] define_ring
301: }{
302: degreeShift isInteger {
303: [v ring_of_differential_operators
1.6 takayama 304: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
305: wv weight_vector
1.3 takayama 306: gb.characteristic
1.1 takayama 307: opt
308: ] define_ring
309:
310: }{
311: [v ring_of_differential_operators
1.6 takayama 312: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
313: wv weight_vector
1.3 takayama 314: gb.characteristic
1.1 takayama 315: [(degreeShift) degreeShift] opt join
316: ] define_ring
317:
318: } ifelse
319: } ifelse
320: } {
321: %% Use the ring structre given by the input.
322: v isInteger not {
323: gb.warning {
324: (Warning : the given ring definition is not used.) message
325: } { } ifelse
326: } { } ifelse
327: rr ring_def
328: /wv rr gb.getWeight def
329:
330: } ifelse
331: %%% Enf of the preprocess
332:
333: ecart.gb.verbose {
1.6 takayama 334: (The first and the second weight vectors for automatic homogenization: )
1.1 takayama 335: message
336: v ecart.wv1 message
337: v ecart.wv2 message
338: degreeShift isInteger { }
339: {
340: (The degree shift is ) messagen
341: degreeShift message
342: } ifelse
343: } { } ifelse
344:
1.5 takayama 345: %%BUG: case of v is integer
346: v ecart.checkOrder
347:
1.1 takayama 348: ecart.begin
349:
350: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
351: ecart.autoHomogenize {
352: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
353: message
354: } { } ifelse
355: ecart.autoHomogenize {
356: f { {. ecart.dehomogenize} map} map /f set
357: f ecart.homogenize01 /f set
358: }{
359: f { {. } map } map /f set
360: } ifelse
361: ecart.needSyz {
362: [f [(needSyz)] gb.options join ] groebner /gg set
363: } {
364: [f gb.options] groebner 0 get /gg set
365: } ifelse
366:
367: ecart.needSyz {
368: mm {
369: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
1.11 ! takayama 370: } { /ans.gb gg 0 get def } ifelse
! 371: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
! 372: % ans pmat ;
1.1 takayama 373: } {
374: wv isInteger {
375: /ans [gg gg {init} map] def
376: }{
1.10 takayama 377: degreeShift isInteger {
378: /ans [gg gg {wv 0 get weightv init} map] def
379: } {
380: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
381: } ifelse
1.1 takayama 382: }ifelse
383:
384: %% Postprocess : recover the matrix expression.
385: mm {
386: ans { /tmp set [mm tmp] toVectors } map
387: /ans set
388: }{ }
389: ifelse
390: } ifelse
391:
392: ecart.end
393:
394: %%
395: env1 restoreOptions %% degreeShift changes "grade"
396:
397: /arg1 ans def
398: ] pop
399: popEnv
400: popVariables
401: arg1
402: } def
1.7 takayama 403: (ecarth.gb ) messagen-quiet
1.1 takayama 404:
1.7 takayama 405: [(ecarth.gb)
406: [(a ecarth.gb b)
1.1 takayama 407: (array a; array b;)
408: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
409: ( in the ring of differential operators.)
410: (The computation is done by using Ecart division algorithm and )
411: (the double homogenization.)
412: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
413: $ ii is the initial ideal in case of w is given or <<a>> belongs$
414: $ to a ring. In the other cases, it returns the initial monominal.$
415: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
416: (a : [f v]; array f; string v; v is the variables. )
417: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
418: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
419: ( array ds; ds is the degree shift )
420: ( )
421: (/ecart.autoHomogenize 0 def )
422: ( not to dehomogenize and homogenize)
423: ( )
424: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 425: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 426: (Example 2: )
427: (To put H and h=1, type in, e.g., )
428: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.7 takayama 429: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
1.1 takayama 430: ( )
431: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7 takayama 432: $ [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
1.1 takayama 433: ( )
434: $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 435: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1 takayama 436: ( )
437: $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 438: $ [ [(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 439: ( )
1.7 takayama 440: (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
1.1 takayama 441: ( ecart.dehomogenize, ecart.dehomogenizeH)
442: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
443: ( define_ring )
444: ]] putUsages
445:
446: %% BUG: " f weight init " works well in case of vectors with degree shift ?
447:
448: /ecart.syz {
449: /arg1 set
450: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
451: [
452: /ff arg1 def
453: /ecart.save.needSyz ecart.needSyz def
454: /ecart.needSyz 1 def
455: ff ecart.gb /ff.ans set
456: /ecart.needSyz ecart.save.needSyz def
457: /arg1 ff.ans def
458: ] pop
459: popVariables
460: arg1
461: } def
462: (ecart.syz ) messagen-quiet
463:
464: [(ecart.syz)
465: [(a ecart.syz b)
466: (array a; array b;)
467: $b : [syzygy gb tmat input]; gb = tmat * input $
468: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.8 takayama 469: $ [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
1.1 takayama 470: $ ff 0 get ff 3 get mul pmat $
471: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
472: ( )
1.9 takayama 473: (To set the current ring to the ring in which ff belongs )
474: ( ff getRing ring_def )
1.1 takayama 475: $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 476: $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
1.1 takayama 477: ( )
478: (cf. ecart.gb)
479: ( /ecart.autoHomogenize 0 def )
480: ]] putUsages
1.2 takayama 481:
1.3 takayama 482:
483: /ecartn.begin {
484: (red@) (standard) switch_function
485: %% (red@) (ecart) switch_function
486: [(Ecart) 1] system_variable
487: [(CheckHomogenization) 0] system_variable
488: [(ReduceLowerTerms) 0] system_variable
489: [(AutoReduce) 0] system_variable
490: [(EcartAutomaticHomogenization) 0] system_variable
491: } def
492: /ecartn.gb {
493: /arg1 set
494: [/in-ecartn.gb /aa /typev /setarg /f /v
495: /gg /wv /vec /ans /rr /mm
496: /degreeShift /env2 /opt /ans.gb
497: ] pushVariables
498: [(CurrentRingp) (KanGBmessage)] pushEnv
499: [
500: /aa arg1 def
501: aa isArray { } { ( << array >> gb) error } ifelse
502: /setarg 0 def
503: /wv 0 def
504: /degreeShift 0 def
505: /opt [(weightedHomogenization) 1] def
506: aa { tag } map /typev set
507: typev [ ArrayP ] eq
508: { /f aa 0 get def
509: /v gb.v def
510: /setarg 1 def
511: } { } ifelse
512: typev [ArrayP StringP] eq
513: { /f aa 0 get def
514: /v aa 1 get def
515: /setarg 1 def
516: } { } ifelse
517: typev [ArrayP RingP] eq
518: { /f aa 0 get def
519: /v aa 1 get def
520: /setarg 1 def
521: } { } ifelse
522: typev [ArrayP ArrayP] eq
523: { /f aa 0 get def
524: /v aa 1 get from_records def
525: /setarg 1 def
526: } { } ifelse
527: typev [ArrayP StringP ArrayP] eq
528: { /f aa 0 get def
529: /v aa 1 get def
530: /wv aa 2 get def
531: /setarg 1 def
532: } { } ifelse
533: typev [ArrayP ArrayP ArrayP] eq
534: { /f aa 0 get def
535: /v aa 1 get from_records def
536: /wv aa 2 get def
537: /setarg 1 def
538: } { } ifelse
539: typev [ArrayP StringP ArrayP ArrayP] eq
540: { /f aa 0 get def
541: /v aa 1 get def
542: /wv aa 2 get def
543: /degreeShift aa 3 get def
544: /setarg 1 def
545: } { } ifelse
546: typev [ArrayP ArrayP ArrayP ArrayP] eq
547: { /f aa 0 get def
548: /v aa 1 get from_records def
549: /wv aa 2 get def
550: /degreeShift aa 3 get def
551: /setarg 1 def
552: } { } ifelse
553:
554: /env1 getOptions def
555:
556: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
557:
558: [(KanGBmessage) ecart.gb.verbose ] system_variable
559:
560: %%% Start of the preprocess
561: v tag RingP eq {
562: /rr v def
563: }{
564: f getRing /rr set
565: } ifelse
566: %% To the normal form : matrix expression.
567: f gb.toMatrixOfString /f set
568: /mm gb.itWasMatrix def
569:
570: rr tag 0 eq {
571: %% Define our own ring
572: v isInteger {
573: (Error in gb: Specify variables) error
574: } { } ifelse
575: wv isInteger {
576: [v ring_of_differential_operators
577: [ v ecart.wv1 v ecart.wv2 ] weight_vector
578: gb.characteristic
579: opt
580: ] define_ring
581: }{
582: degreeShift isInteger {
583: [v ring_of_differential_operators
584: [v ecart.wv1 v ecart.wv2] wv join weight_vector
585: gb.characteristic
586: opt
587: ] define_ring
588:
589: }{
590: [v ring_of_differential_operators
591: [v ecart.wv1 v ecart.wv2] wv join weight_vector
592: gb.characteristic
593: [(degreeShift) degreeShift] opt join
594: ] define_ring
595:
596: } ifelse
597: } ifelse
598: } {
599: %% Use the ring structre given by the input.
600: v isInteger not {
601: gb.warning {
602: (Warning : the given ring definition is not used.) message
603: } { } ifelse
604: } { } ifelse
605: rr ring_def
606: /wv rr gb.getWeight def
607:
608: } ifelse
609: %%% Enf of the preprocess
610:
611: ecart.gb.verbose {
612: (The first and the second weight vectors are automatically set as follows)
613: message
614: v ecart.wv1 message
615: v ecart.wv2 message
616: degreeShift isInteger { }
617: {
618: (The degree shift is ) messagen
619: degreeShift message
620: } ifelse
621: } { } ifelse
622:
1.5 takayama 623: %%BUG: case of v is integer
624: v ecart.checkOrder
625:
1.3 takayama 626: ecartn.begin
627:
628: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
629: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
630: ecart.autoHomogenize {
631: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
632: message
633: } { } ifelse
634: ecart.autoHomogenize {
635: f { {. ecart.dehomogenize} map} map /f set
636: f ecart.homogenize01 /f set
637: }{
638: f { {. } map } map /f set
639: } ifelse
640: ecart.needSyz {
641: [f [(needSyz)] gb.options join ] groebner /gg set
642: } {
643: [f gb.options] groebner 0 get /gg set
644: } ifelse
645:
646: ecart.needSyz {
647: mm {
648: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
649: } { /ans.gb gg 0 get def } ifelse
650: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 ! takayama 651: % ans pmat ;
1.3 takayama 652: } {
653: wv isInteger {
654: /ans [gg gg {init} map] def
655: }{
1.10 takayama 656: degreeShift isInteger {
657: /ans [gg gg {wv 0 get weightv init} map] def
658: } {
659: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
660: } ifelse
1.3 takayama 661: }ifelse
662:
663: %% Postprocess : recover the matrix expression.
664: mm {
665: ans { /tmp set [mm tmp] toVectors } map
666: /ans set
667: }{ }
668: ifelse
669: } ifelse
670:
671: ecart.end
672:
673: %%
674: env1 restoreOptions %% degreeShift changes "grade"
675:
676: /arg1 ans def
677: ] pop
678: popEnv
679: popVariables
680: arg1
681: } def
682: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 takayama 683:
684: /ecartd.gb {
685: /arg1 set
686: [/in-ecart.gb /aa /typev /setarg /f /v
687: /gg /wv /vec /ans /rr /mm
688: /degreeShift /env2 /opt /ans.gb
1.11 ! takayama 689: /hdShift
1.4 takayama 690: ] pushVariables
691: [(CurrentRingp) (KanGBmessage)] pushEnv
692: [
693: /aa arg1 def
694: aa isArray { } { ( << array >> gb) error } ifelse
695: /setarg 0 def
696: /wv 0 def
697: /degreeShift 0 def
1.11 ! takayama 698: /hdShift 0 def
1.4 takayama 699: /opt [(weightedHomogenization) 1] def
700: aa { tag } map /typev set
701: typev [ ArrayP ] eq
702: { /f aa 0 get def
703: /v gb.v def
704: /setarg 1 def
705: } { } ifelse
706: typev [ArrayP StringP] eq
707: { /f aa 0 get def
708: /v aa 1 get def
709: /setarg 1 def
710: } { } ifelse
711: typev [ArrayP RingP] eq
712: { /f aa 0 get def
713: /v aa 1 get def
714: /setarg 1 def
715: } { } ifelse
716: typev [ArrayP ArrayP] eq
717: { /f aa 0 get def
718: /v aa 1 get from_records def
719: /setarg 1 def
720: } { } ifelse
721: typev [ArrayP StringP ArrayP] eq
722: { /f aa 0 get def
723: /v aa 1 get def
724: /wv aa 2 get def
725: /setarg 1 def
726: } { } ifelse
727: typev [ArrayP ArrayP ArrayP] eq
728: { /f aa 0 get def
729: /v aa 1 get from_records def
730: /wv aa 2 get def
731: /setarg 1 def
732: } { } ifelse
733: typev [ArrayP StringP ArrayP ArrayP] eq
734: { /f aa 0 get def
735: /v aa 1 get def
736: /wv aa 2 get def
737: /degreeShift aa 3 get def
738: /setarg 1 def
739: } { } ifelse
740: typev [ArrayP ArrayP ArrayP ArrayP] eq
741: { /f aa 0 get def
742: /v aa 1 get from_records def
743: /wv aa 2 get def
744: /degreeShift aa 3 get def
745: /setarg 1 def
746: } { } ifelse
1.11 ! takayama 747: typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
! 748: { /f aa 0 get def
! 749: /v aa 1 get def
! 750: /wv aa 2 get def
! 751: /degreeShift aa 3 get def
! 752: /hdShift aa 4 get def
! 753: /setarg 1 def
! 754: } { } ifelse
! 755: typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
! 756: { /f aa 0 get def
! 757: /v aa 1 get from_records def
! 758: /wv aa 2 get def
! 759: /degreeShift aa 3 get def
! 760: /hdShift aa 4 get def
! 761: /setarg 1 def
! 762: } { } ifelse
! 763: typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
! 764: { /f aa 0 get def
! 765: /v aa 1 get from_records def
! 766: /wv aa 2 get def
! 767: /degreeShift aa 3 get def
! 768: aa 4 get (no) eq {
! 769: /hdShift -1 def
! 770: } {
! 771: (Unknown keyword for the 5th argument) error
! 772: } ifelse
! 773: /setarg 1 def
! 774: } { } ifelse
1.4 takayama 775:
776: /env1 getOptions def
777:
778: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
779:
780: [(KanGBmessage) ecart.gb.verbose ] system_variable
781: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
782:
783: %%% Start of the preprocess
784: v tag RingP eq {
785: /rr v def
786: }{
787: f getRing /rr set
788: } ifelse
789: %% To the normal form : matrix expression.
790: f gb.toMatrixOfString /f set
791: /mm gb.itWasMatrix def
792:
793: rr tag 0 eq {
794: %% Define our own ring
795: v isInteger {
796: (Error in gb: Specify variables) error
797: } { } ifelse
798: wv isInteger {
799: (Give an weight vector such that x < 1) error
800: }{
801: degreeShift isInteger {
802: [v ring_of_differential_operators
803: wv weight_vector
804: gb.characteristic
805: opt
806: ] define_ring
807:
808: }{
809: [v ring_of_differential_operators
810: wv weight_vector
811: gb.characteristic
812: [(degreeShift) degreeShift] opt join
813: ] define_ring
814:
815: } ifelse
816: } ifelse
817: } {
818: %% Use the ring structre given by the input.
819: v isInteger not {
820: gb.warning {
821: (Warning : the given ring definition is not used.) message
822: } { } ifelse
823: } { } ifelse
824: rr ring_def
825: /wv rr gb.getWeight def
826:
827: } ifelse
828: %%% Enf of the preprocess
829:
830: ecart.gb.verbose {
831: degreeShift isInteger { }
832: {
833: (The degree shift is ) messagen
834: degreeShift message
835: } ifelse
836: } { } ifelse
837:
1.5 takayama 838: %%BUG: case of v is integer
839: v ecart.checkOrder
840:
1.8 takayama 841: ecartd.begin
1.4 takayama 842:
843: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
844:
1.11 ! takayama 845: hdShift tag 1 eq {
! 846: hdShift -1 eq {
! 847: % No automatic h-homogenization.
! 848: f { {. } map} map /f set
! 849: } {
! 850: % Automatic h-homogenization without degreeShift
! 851: f { {. ecart.dehomogenize} map} map /f set
! 852: f ecart.homogenize01 /f set
! 853: f { { [[(H). (1).]] replace } map } map /f set
! 854: } ifelse
! 855: } {
! 856: % Automatic h-homogenization with degreeShift
! 857: f { {. ecart.dehomogenize} map} map /f set
! 858: f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
! 859: f { { [[(H). (1).]] replace } map } map /f set
! 860: }ifelse
1.4 takayama 861:
862: ecart.needSyz {
863: [f [(needSyz)] gb.options join ] groebner /gg set
864: } {
865: [f gb.options] groebner 0 get /gg set
866: } ifelse
867:
868: ecart.needSyz {
869: mm {
870: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
871: } { /ans.gb gg 0 get def } ifelse
872: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11 ! takayama 873: % ans pmat ;
1.4 takayama 874: } {
875: wv isInteger {
876: /ans [gg gg {init} map] def
877: }{
1.11 ! takayama 878: %% Get the initial ideal
1.10 takayama 879: degreeShift isInteger {
880: /ans [gg gg {wv 0 get weightv init} map] def
881: } {
882: /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
883: } ifelse
1.4 takayama 884: }ifelse
885:
886: %% Postprocess : recover the matrix expression.
887: mm {
888: ans { /tmp set [mm tmp] toVectors } map
889: /ans set
890: }{ }
891: ifelse
892: } ifelse
893:
1.8 takayama 894: ecartd.end
1.4 takayama 895:
896: %%
897: env1 restoreOptions %% degreeShift changes "grade"
898:
899: /arg1 ans def
900: ] pop
901: popEnv
902: popVariables
903: arg1
904: } def
905: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 906:
1.5 takayama 907: /ecart.checkOrder {
908: /arg1 set
909: [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
910: [
911: /vv arg1 def
912: vv isArray
913: { } { [vv to_records pop] /vv set } ifelse
914: vv {toString} map /vv set
915: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
916: % Starting the checks.
917: 0 1 vv length 1 sub {
918: /i set
919: vv i get . dd i get . mul /tt set
920: tt @@@.hsymbol . add init tt eq { }
921: { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
922: } for
923:
924: 0 1 vv length 1 sub {
925: /i set
926: vv i get . /tt set
927: tt (1). add init (1). eq { }
1.6 takayama 928: { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5 takayama 929: } for
930: /arg1 1 def
931: ] pop
932: popVariables
933: arg1
934: } def
935: [(ecart.checkOrder)
936: [(v ecart.checkOrder bool checks if the given order is relevant)
937: (for the ecart division.)
938: (cf. ecartd.gb, ecart.gb, ecartn.gb)
939: ]
940: ] putUsages
941:
942: /ecart.wv_last {
943: /arg1 set
944: [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
945: [
946: /vv arg1 def
947: vv isArray
948: { } { [vv to_records pop] /vv set } ifelse
949: vv {toString} map /vv set
950: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
951: vv { -1 } map
952: dd { 1 } map join /arg1 set
953: ] pop
954: popVariables
955: arg1
956: } def
957: [(ecart.wv_last)
958: [(v ecart.wv_last wt )
959: (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
960: (Use this weight vector as the last weight vector for ecart division)
961: (if ecart.checkOrder complains about the order given.)
962: ]
963: ] putUsages
964:
1.2 takayama 965: ( ) message-quiet
1.5 takayama 966:
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