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