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