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