Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.3
1.3 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.2 2003/07/25 01:03:00 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
10:
11: /ecart.dehomogenize {
12: /arg1 set
13: [/in.ecart.dehomogenize /ll /rr] pushVariables
14: [
15: /ll arg1 def
16: ll tag 6 eq {
17: ll { ecart.dehomogenize } map /ll set
18: } {
19: ll (0). eq {
20: } {
21: ll getRing /rr set
22: ll [ [ (H) rr ,, (1) rr ,, ]
23: [ (h) rr ,, (1) rr ,, ]] replace
24: /ll set
25: } ifelse
26: } ifelse
27: /arg1 ll def
28: ] pop
29: popVariables
30: arg1
31: } def
32: [(ecart.dehomogenize)
33: [(obj ecart.dehomogenize r)
34: (h->1, H->1)
35: ]] putUsages
36:
37: /ecart.dehomogenizeH {
38: /arg1 set
39: [/in.ecart.dehomogenize /ll /rr] pushVariables
40: [
41: /ll arg1 def
42: ll tag 6 eq {
43: ll { ecart.dehomogenize } map /ll set
44: } {
45: ll (0). eq {
46: } {
47: ll getRing /rr set
48: ll [ [ (H) rr ,, (1) rr ,, ] ] replace
49: /ll set
50: } ifelse
51: } ifelse
52: /arg1 ll def
53: ] pop
54: popVariables
55: arg1
56: } def
57: [(ecart.dehomogenizeH)
58: [(obj ecart.dehomogenizeH r)
59: (H->1, h is not changed.)
60: ]] putUsages
61:
62: /ecart.homogenize01 {
63: /arg1 set
64: [/in.ecart.homogenize01 /ll ] pushVariables
65: [
66: /ll arg1 def
67: [(degreeShift) [ ] ll ] homogenize
68: /arg1 set
69: ] pop
70: popVariables
71: arg1
72: } def
73: [(ecart.homogenize01)
74: [(obj ecart.homogenize01 r)
75: (Example: )
76: ( [(x1,x2) ring_of_differential_operators )
77: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
78: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
79: ( [(Dx1) 1 (Dx2) 1] )
80: ( [(x1) -1 (x2) -1])
81: ( ] weight_vector )
82: ( 0 )
83: ( [(degreeShift) [[0 0 0]]])
84: ( ] define_ring)
85: ( ecart.begin)
86: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
87: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
88: ( ecart.homogenize01 /eqs2 set)
89: ( [eqs2] groebner )
90: ]] putUsages
91:
92: /ecart.homogenize01_with_shiftVector {
93: /arg2.set
94: /arg1 set
95: [/in.ecart.homogenize01 /ll /sv] pushVariables
96: [
97: /sv arg2 def
98: /ll arg1 def
99: [(degreeShift) sv ll ] homogenize
100: /arg1 set
101: ] pop
102: popVariables
103: arg1
104: } def
105: [(ecart.dehomogenize01_with_degreeShift)
106: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
107: ]] putUsages
108:
109: %% Aux functions to return the default weight vectors.
110: /ecart.wv1 {
111: /arg1 set
112: [/in.ecart.wv1 /v] pushVariables
113: [
114: /v arg1 def
115: [(H) (h) v to_records pop] /v set
116: v { 1 } map /v set
117: /arg1 v def
118: ] pop
119: popVariables
120: arg1
121: } def
122: /ecart.wv2 {
123: /arg1 set
124: [/in.ecart.wv2 /v] pushVariables
125: [
126: /v arg1 def
127: [v to_records pop] /v set
128: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
129: [(h) 1 ] v join /v set
130: /arg1 v def
131: ] pop
132: popVariables
133: arg1
134: } def
135:
136: /ecart.gb.verbose 1 def
137: /ecart.gb {
138: /arg1 set
139: [/in-ecart.gb /aa /typev /setarg /f /v
140: /gg /wv /vec /ans /rr /mm
141: /degreeShift /env2 /opt /ans.gb
142: ] pushVariables
143: [(CurrentRingp) (KanGBmessage)] pushEnv
144: [
145: /aa arg1 def
146: aa isArray { } { ( << array >> gb) error } ifelse
147: /setarg 0 def
148: /wv 0 def
149: /degreeShift 0 def
150: /opt [(weightedHomogenization) 1] def
151: aa { tag } map /typev set
152: typev [ ArrayP ] eq
153: { /f aa 0 get def
154: /v gb.v def
155: /setarg 1 def
156: } { } ifelse
157: typev [ArrayP StringP] eq
158: { /f aa 0 get def
159: /v aa 1 get def
160: /setarg 1 def
161: } { } ifelse
162: typev [ArrayP RingP] eq
163: { /f aa 0 get def
164: /v aa 1 get def
165: /setarg 1 def
166: } { } ifelse
167: typev [ArrayP ArrayP] eq
168: { /f aa 0 get def
169: /v aa 1 get from_records def
170: /setarg 1 def
171: } { } ifelse
172: typev [ArrayP StringP ArrayP] eq
173: { /f aa 0 get def
174: /v aa 1 get def
175: /wv aa 2 get def
176: /setarg 1 def
177: } { } ifelse
178: typev [ArrayP ArrayP ArrayP] eq
179: { /f aa 0 get def
180: /v aa 1 get from_records def
181: /wv aa 2 get def
182: /setarg 1 def
183: } { } ifelse
184: typev [ArrayP StringP ArrayP ArrayP] eq
185: { /f aa 0 get def
186: /v aa 1 get def
187: /wv aa 2 get def
188: /degreeShift aa 3 get def
189: /setarg 1 def
190: } { } ifelse
191: typev [ArrayP ArrayP ArrayP ArrayP] eq
192: { /f aa 0 get def
193: /v aa 1 get from_records def
194: /wv aa 2 get def
195: /degreeShift aa 3 get def
196: /setarg 1 def
197: } { } ifelse
198:
199: /env1 getOptions def
200:
201: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
202:
203: [(KanGBmessage) ecart.gb.verbose ] system_variable
204:
205: %%% Start of the preprocess
206: v tag RingP eq {
207: /rr v def
208: }{
209: f getRing /rr set
210: } ifelse
211: %% To the normal form : matrix expression.
212: f gb.toMatrixOfString /f set
213: /mm gb.itWasMatrix def
214:
215: rr tag 0 eq {
216: %% Define our own ring
217: v isInteger {
218: (Error in gb: Specify variables) error
219: } { } ifelse
220: wv isInteger {
221: [v ring_of_differential_operators
222: [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3 ! takayama 223: gb.characteristic
1.1 takayama 224: opt
225: ] define_ring
226: }{
227: degreeShift isInteger {
228: [v ring_of_differential_operators
229: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 ! takayama 230: gb.characteristic
1.1 takayama 231: opt
232: ] define_ring
233:
234: }{
235: [v ring_of_differential_operators
236: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 ! takayama 237: gb.characteristic
1.1 takayama 238: [(degreeShift) degreeShift] opt join
239: ] define_ring
240:
241: } ifelse
242: } ifelse
243: } {
244: %% Use the ring structre given by the input.
245: v isInteger not {
246: gb.warning {
247: (Warning : the given ring definition is not used.) message
248: } { } ifelse
249: } { } ifelse
250: rr ring_def
251: /wv rr gb.getWeight def
252:
253: } ifelse
254: %%% Enf of the preprocess
255:
256: ecart.gb.verbose {
257: (The first and the second weight vectors are automatically set as follows)
258: message
259: v ecart.wv1 message
260: v ecart.wv2 message
261: degreeShift isInteger { }
262: {
263: (The degree shift is ) messagen
264: degreeShift message
265: } ifelse
266: } { } ifelse
267:
268: ecart.begin
269:
270: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
271: ecart.autoHomogenize {
272: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
273: message
274: } { } ifelse
275: ecart.autoHomogenize {
276: f { {. ecart.dehomogenize} map} map /f set
277: f ecart.homogenize01 /f set
278: }{
279: f { {. } map } map /f set
280: } ifelse
281: ecart.needSyz {
282: [f [(needSyz)] gb.options join ] groebner /gg set
283: } {
284: [f gb.options] groebner 0 get /gg set
285: } ifelse
286:
287: ecart.needSyz {
288: mm {
289: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
290: } { /ans.gb gg 0 get def } ifelse
291: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
292: ans pmat ;
293: } {
294: wv isInteger {
295: /ans [gg gg {init} map] def
296: }{
297: /ans [gg gg {wv 0 get weightv init} map] def
298: }ifelse
299:
300: %% Postprocess : recover the matrix expression.
301: mm {
302: ans { /tmp set [mm tmp] toVectors } map
303: /ans set
304: }{ }
305: ifelse
306: } ifelse
307:
308: ecart.end
309:
310: %%
311: env1 restoreOptions %% degreeShift changes "grade"
312:
313: /arg1 ans def
314: ] pop
315: popEnv
316: popVariables
317: arg1
318: } def
319: (ecart.gb ) messagen-quiet
320:
321: [(ecart.gb)
322: [(a ecart.gb b)
323: (array a; array b;)
324: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
325: ( in the ring of differential operators.)
326: (The computation is done by using Ecart division algorithm and )
327: (the double homogenization.)
328: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
329: $ ii is the initial ideal in case of w is given or <<a>> belongs$
330: $ to a ring. In the other cases, it returns the initial monominal.$
331: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
332: (a : [f v]; array f; string v; v is the variables. )
333: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
334: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
335: ( array ds; ds is the degree shift )
336: ( )
337: (/ecart.autoHomogenize 0 def )
338: ( not to dehomogenize and homogenize)
339: ( )
340: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
341: $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $
342: (Example 2: )
343: (To put H and h=1, type in, e.g., )
344: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
345: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
346: ( )
347: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
348: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
349: ( )
350: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
351: $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $
352: ( )
353: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
354: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
355: ( )
356: (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
357: ( ecart.dehomogenize, ecart.dehomogenizeH)
358: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
359: ( define_ring )
360: ]] putUsages
361:
362: %% BUG: " f weight init " works well in case of vectors with degree shift ?
363:
364: /ecart.syz {
365: /arg1 set
366: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
367: [
368: /ff arg1 def
369: /ecart.save.needSyz ecart.needSyz def
370: /ecart.needSyz 1 def
371: ff ecart.gb /ff.ans set
372: /ecart.needSyz ecart.save.needSyz def
373: /arg1 ff.ans def
374: ] pop
375: popVariables
376: arg1
377: } def
378: (ecart.syz ) messagen-quiet
379:
380: [(ecart.syz)
381: [(a ecart.syz b)
382: (array a; array b;)
383: $b : [syzygy gb tmat input]; gb = tmat * input $
384: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
385: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
386: $ ff 0 get ff 3 get mul pmat $
387: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
388: ( )
389: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
390: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
391: ( )
392: (cf. ecart.gb)
393: ( /ecart.autoHomogenize 0 def )
394: ]] putUsages
1.2 takayama 395:
1.3 ! takayama 396:
! 397: /ecartn.begin {
! 398: (red@) (standard) switch_function
! 399: %% (red@) (ecart) switch_function
! 400: [(Ecart) 1] system_variable
! 401: [(CheckHomogenization) 0] system_variable
! 402: [(ReduceLowerTerms) 0] system_variable
! 403: [(AutoReduce) 0] system_variable
! 404: [(EcartAutomaticHomogenization) 0] system_variable
! 405: } def
! 406: /ecartn.gb {
! 407: /arg1 set
! 408: [/in-ecartn.gb /aa /typev /setarg /f /v
! 409: /gg /wv /vec /ans /rr /mm
! 410: /degreeShift /env2 /opt /ans.gb
! 411: ] pushVariables
! 412: [(CurrentRingp) (KanGBmessage)] pushEnv
! 413: [
! 414: /aa arg1 def
! 415: aa isArray { } { ( << array >> gb) error } ifelse
! 416: /setarg 0 def
! 417: /wv 0 def
! 418: /degreeShift 0 def
! 419: /opt [(weightedHomogenization) 1] def
! 420: aa { tag } map /typev set
! 421: typev [ ArrayP ] eq
! 422: { /f aa 0 get def
! 423: /v gb.v def
! 424: /setarg 1 def
! 425: } { } ifelse
! 426: typev [ArrayP StringP] eq
! 427: { /f aa 0 get def
! 428: /v aa 1 get def
! 429: /setarg 1 def
! 430: } { } ifelse
! 431: typev [ArrayP RingP] eq
! 432: { /f aa 0 get def
! 433: /v aa 1 get def
! 434: /setarg 1 def
! 435: } { } ifelse
! 436: typev [ArrayP ArrayP] eq
! 437: { /f aa 0 get def
! 438: /v aa 1 get from_records def
! 439: /setarg 1 def
! 440: } { } ifelse
! 441: typev [ArrayP StringP ArrayP] eq
! 442: { /f aa 0 get def
! 443: /v aa 1 get def
! 444: /wv aa 2 get def
! 445: /setarg 1 def
! 446: } { } ifelse
! 447: typev [ArrayP ArrayP ArrayP] eq
! 448: { /f aa 0 get def
! 449: /v aa 1 get from_records def
! 450: /wv aa 2 get def
! 451: /setarg 1 def
! 452: } { } ifelse
! 453: typev [ArrayP StringP ArrayP ArrayP] eq
! 454: { /f aa 0 get def
! 455: /v aa 1 get def
! 456: /wv aa 2 get def
! 457: /degreeShift aa 3 get def
! 458: /setarg 1 def
! 459: } { } ifelse
! 460: typev [ArrayP ArrayP ArrayP ArrayP] eq
! 461: { /f aa 0 get def
! 462: /v aa 1 get from_records def
! 463: /wv aa 2 get def
! 464: /degreeShift aa 3 get def
! 465: /setarg 1 def
! 466: } { } ifelse
! 467:
! 468: /env1 getOptions def
! 469:
! 470: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
! 471:
! 472: [(KanGBmessage) ecart.gb.verbose ] system_variable
! 473:
! 474: %%% Start of the preprocess
! 475: v tag RingP eq {
! 476: /rr v def
! 477: }{
! 478: f getRing /rr set
! 479: } ifelse
! 480: %% To the normal form : matrix expression.
! 481: f gb.toMatrixOfString /f set
! 482: /mm gb.itWasMatrix def
! 483:
! 484: rr tag 0 eq {
! 485: %% Define our own ring
! 486: v isInteger {
! 487: (Error in gb: Specify variables) error
! 488: } { } ifelse
! 489: wv isInteger {
! 490: [v ring_of_differential_operators
! 491: [ v ecart.wv1 v ecart.wv2 ] weight_vector
! 492: gb.characteristic
! 493: opt
! 494: ] define_ring
! 495: }{
! 496: degreeShift isInteger {
! 497: [v ring_of_differential_operators
! 498: [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 499: gb.characteristic
! 500: opt
! 501: ] define_ring
! 502:
! 503: }{
! 504: [v ring_of_differential_operators
! 505: [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 506: gb.characteristic
! 507: [(degreeShift) degreeShift] opt join
! 508: ] define_ring
! 509:
! 510: } ifelse
! 511: } ifelse
! 512: } {
! 513: %% Use the ring structre given by the input.
! 514: v isInteger not {
! 515: gb.warning {
! 516: (Warning : the given ring definition is not used.) message
! 517: } { } ifelse
! 518: } { } ifelse
! 519: rr ring_def
! 520: /wv rr gb.getWeight def
! 521:
! 522: } ifelse
! 523: %%% Enf of the preprocess
! 524:
! 525: ecart.gb.verbose {
! 526: (The first and the second weight vectors are automatically set as follows)
! 527: message
! 528: v ecart.wv1 message
! 529: v ecart.wv2 message
! 530: degreeShift isInteger { }
! 531: {
! 532: (The degree shift is ) messagen
! 533: degreeShift message
! 534: } ifelse
! 535: } { } ifelse
! 536:
! 537: ecartn.begin
! 538:
! 539: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
! 540: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
! 541: ecart.autoHomogenize {
! 542: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
! 543: message
! 544: } { } ifelse
! 545: ecart.autoHomogenize {
! 546: f { {. ecart.dehomogenize} map} map /f set
! 547: f ecart.homogenize01 /f set
! 548: }{
! 549: f { {. } map } map /f set
! 550: } ifelse
! 551: ecart.needSyz {
! 552: [f [(needSyz)] gb.options join ] groebner /gg set
! 553: } {
! 554: [f gb.options] groebner 0 get /gg set
! 555: } ifelse
! 556:
! 557: ecart.needSyz {
! 558: mm {
! 559: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
! 560: } { /ans.gb gg 0 get def } ifelse
! 561: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
! 562: ans pmat ;
! 563: } {
! 564: wv isInteger {
! 565: /ans [gg gg {init} map] def
! 566: }{
! 567: /ans [gg gg {wv 0 get weightv init} map] def
! 568: }ifelse
! 569:
! 570: %% Postprocess : recover the matrix expression.
! 571: mm {
! 572: ans { /tmp set [mm tmp] toVectors } map
! 573: /ans set
! 574: }{ }
! 575: ifelse
! 576: } ifelse
! 577:
! 578: ecart.end
! 579:
! 580: %%
! 581: env1 restoreOptions %% degreeShift changes "grade"
! 582:
! 583: /arg1 ans def
! 584: ] pop
! 585: popEnv
! 586: popVariables
! 587: arg1
! 588: } def
! 589: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.2 takayama 590:
591: ( ) message-quiet
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