Annotation of OpenXM/src/kan96xx/Doc/intw.sm1, Revision 1.3
1.3 ! takayama 1: %% $OpenXM$
1.1 maekawa 2: %% When you use wIntegration0, you need oxasir.sm1.
3: %% Load this package after you have loaded cohom.sm1.
4: %% Annihilating ideal, 0-th integral and restriction with weight vector.
5: %% 1998, 11/6, 11/9, 11/18
6: %% 1999, 1/25, 6/5.
7: %% It was at gbhg3/Int/intw.sm1 <-- s linked from lib/intw.sm1
8: %% This file is error clean.
9: /intw.verbose 0 def
10: /intw.stat 0 def %% statistics.
11:
12: %% cf. gbhg3/Demo/ann.sm1
13: /intw.version (2.981105) def
14: (lib/intw.sm1, Version 1999, 6/13. Package for integration with a generic weight.) message
15: oxasir.ccc tag 0 eq {
16: (Warning: The functions *wbfRoots, wdeRham0, wIntegration0 does not work without oxasir.) message
17: ( This package requires oxasir.sm1 and ox_asir server.) message
18: } { } ifelse
19: cohom.sm1.loaded tag 0 eq {
20: (Warning: This package requires cohom.sm1 ) message
21: } { } ifelse
22: oxasir.sm1.loaded tag 0 eq {
23: (Warning: This package requires oxasir.sm1 ) message
24: } { } ifelse
25:
26: intw.version [(Version)] system_variable gt
27: { [(This package requires the latest version of kan/sm1) nl
28: (Please get it from http://www.math.kobe-u.ac.jp/KAN) ] cat
29: error
30: } { } ifelse
31:
32:
33: [(integral-k1)
34: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp] k1] integral0 )
35: ( [[g1 ... gq],[e1,...,er]])
36: (poly|string f1 ...fm; string v1 ... vn;)
37: (string v1 ... vp; integer w1 ... wp;)
38: (integer k1;)
39: (poly g1 ... gq; poly e1, ..., er;)
40: (f1 ... fm are annihilors, v1 ... vn are variables,)
41: (w1 is the weight of the variable v1, ...)
42: (k1 is the maximal degree of the filtration: maximal integral root)
43: (of b-function. cf. intwbf)
44: (g1, ..., gq are integral. e1, ..., er are basis of the free module to which)
45: (the g1, ..., gq belong.)
46: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
47: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
48: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1] 1] integral-k1$
49: $Example 2: [[(x (x-1)) (x)] annfs 0 get [(x)] [(x) -1 (Dx) 1] 1] integral-k1$
1.2 takayama 50: $Example 3: [[ (Dt- (2 t x1 + x2)) (Dx1 - t^2) (Dx2 - t) ] $
51: $ [(t) (x1) (x2)] [(t) -1 (Dt) 1] 0] integral-k1 $
52: $ The resulting ideal annihilates f(x1,x2)=int(x1*t^2+x2*t,dt) $
1.1 maekawa 53: ]
54: ] putUsages (integral-k1 ) messagen
55: /integral-k1 {
56: /arg1 set
57: [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
58: /dt-list /nn /ii /dt-ii /mm /jj /xvars /dvars /ans1 /k1 /kk /ans2
59: /vec-input /vec-length
60: ] pushVariables
61: [(CurrentRingp) (KanGBmessage)] pushEnv
62: [
63: /ff arg1 0 get def
64: /vv arg1 1 get def
65: /ww arg1 2 get def
66: /k1 arg1 3 get def
67: /vec-length 1 def
68: intw.verbose
69: { [ff vv ww k1] messagen ( is the input. ) message } { } ifelse
70: ff 0 get isArray {
71: ff { {toString} map } map /ff set
72: /vec-input 1 def
73: %% Compute the length of the input vector
74: ff { length dup vec-length gt { /vec-length set } { pop } ifelse } map
75: }{
76: ff {toString} map /ff set
77: /vec-input 0 def
78: } ifelse
79: /vv vv { (,) 2 cat_n } map aload length cat_n def
80: intw.verbose { vv message } { } ifelse
81: [(KanGBmessage) intw.verbose] system_variable
82: [vv ring_of_differential_operators
83: [ww] weight_vector 0] define_ring
84: ww getxvars2 /xvars set
85: ww getdvars2 /dvars set
86: intw.verbose {
87: (xvars = ) messagen xvars message
88: (dvars = ) messagen dvars message
89: } { } ifelse
90: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
91: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
92: %% xvars = [(x) (z)]
93: /integral0.ff ff def %% keep variable for debug.
94:
95: vec-input {
96: ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
97: } {
98: ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
99: %% recompute the lenth of the vector. For e input.
100: ff { @@@.esymbol . degree 1 add dup vec-length gt
101: { /vec-length set } { pop } ifelse } map
102:
103: } ifelse
104:
105: intw.verbose {
106: (Computing Groebner basis with the weight vector ) messagen
107: ww message
108: } { } ifelse
109: [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
110: intw.verbose {
111: gg1 message %% keep variable for debug.
112: } { } ifelse
113: %% gg1 is the (-w,w)-adapted basis.
114: /integral0.gg1 gg1 def
115:
116:
117: intw.verbose {
118: (Computing gr 0-k1 of I in D v^0 + D v^1 + ... + D v^{k1} : shifting)
119: message
120: } { } ifelse
121: /ans1 [ ] def
122: 0 1 k1 {
123: /kk set
124: intw.verbose {
125: (kk = ) messagen kk message
126: } { } ifelse
127: /ord-vec gg1 { ww ord_w kk sub} map def
128: intw.verbose { ord-vec message } { } ifelse
129: %% ww = [(x) -1 (Dx) 1], kk == 0
130: %% gg1 = [ (x Dx). (y Dx). (x).]
131: %% ord-vec = [ 0 1 -1 ]
132: %% dt-list = [ [ 1] [ 0 ] [ (Dx^1).] ]
133: ord-vec { 0 2 1 roll sub } map
134: {
135: dvars 0 get { . } map %% [(Dx). (Dz).]
136: dvars 1 get { dup (type?) dc 5 eq { pop } { } ifelse } map %% [1 1]
137: 3 -1 roll ip1
138: } map /dt-list set
139: %% dt-list [ [ 1 ] [ ] [ (Dx^1).] ]
140: dt-list { dup length 0 eq { pop [ (0). ] } { } ifelse } map /dt-list set
141: intw.verbose {
142: (dt-list = ) messagen dt-list message
143: } { } ifelse
144: %%% t1, -1 ; t2 , -1;
145: %% dt-list = [ [ (Dt1). (Dt2). ] [ (1). ] ]
146: %% gg1 = [ (t1+t2). (t1 Dt2). ]
147: /nn gg1 length def
148: [
149: 0 1 nn 1 sub {
150: /ii set
151: dt-list ii get /dt-ii set
152: /mm dt-ii length def
153: 0 1 mm 1 sub {
154: /jj set
155: dt-ii jj get
156: gg1 ii get mul
157: [[(h). (1).]] replace
158: xvars { [ 2 1 roll . (0). ] } map replace ww laplace0
159: } for
160: } for
161: ] ans1 join /ans1 set
162: } for
163: intw.verbose {
164: ( ans1 = [ degree-k1, ..., degree-0] = ) messagen
165: ans1 message
166: } { } ifelse
167:
168: intw.verbose
169: { (Eliminating xvars (variable of integration.) ) message }
170: { } ifelse
171: ans1 { dup (0). eq { pop } { } ifelse } map /ans1 set
172: ans1 [ ] eq
173: { [ $There is no relation. It means that there are ($
174: k1 1 add
175: $)*(length-of-the-input-vector) free basis.$
176: ] {toString messagen} map
177: ( ) message
178: /ans2 [ ] def /integral-k1.L1 goto
179: } { } ifelse
180: [vv ring_of_differential_operators
181: %% elimination order.
182: [ xvars { 1 } map ] weight_vector 0] define_ring
183: [(NN)
184: [(NN)] system_variable xvars length sub
185: ] system_variable
186: %%%% xvars are regarded as vector index by this trick!!
187: %%%% NN should be recovered to the original value or
188: %%%% Each ring should have a flag --- <<the constant might be changed(rw)>>
189: %%%% In a future version of sm1, when setUpRing is called, sm1 looks for
190: %%%% ring data base and if it finds the same ring and the flag of the ring
191: %%%% is (ro), then it does not generate a new ring structure. 1998, 11/19.
192: (isSameComponent) (xd) switch_function %% for test.
193:
194: [ ans1 { toString . } map ] groebner_sugar 0 get /ans2 set
195: /integral0.ans ans2 def
196:
197: intw.stat
198: { (Size of GB integral0.gg1 is ) messagen integral0.gg1 length message
199: (Size of the generators of the submodule integral0.ans is ) messagen
200: integral0.ans length message
201: } { } ifelse
202:
203: /integral-k1.L1
204: %%%% Compute the vector space basis
205: %%% /www2 /vbase /ebase /vbase2
206: %% xvars = [(x) (z)], www2 = [1 1], k1=2, vec-length=2
207: %% [1 e] [1, x, z, x^2, x z, z^2]
208: /www2 dvars 1 get { dup isString { pop } { } ifelse } map def
209: [xvars www2 k1] ip1a /vbase set
210: vbase { toString . } map /vbase set
211: [0 1 vec-length 1 sub { @@@.esymbol . 2 1 roll npower } for] /ebase set
212: /vbase2 [ ] def ebase { vbase mul vbase2 join /vbase2 set} map
213: intw.verbose {
214: (base is ) messagen vbase2 message
215: } { } ifelse
216:
217: /arg1 [ans2 vbase2] def
218: ] pop
219: popEnv
220: popVariables
221: arg1
222: } def
223:
224: /homogenize2 {
225: /arg1 set
226: [/in-homogenize2 /f /ans] pushVariables
227: [
228: /f arg1 def
229: f isArray {
230: f { homogenize } map /ans set
231: }
232: { /ans f homogenize def
233: } ifelse
234: /arg1 ans def
235: ] pop
236: popVariables
237: arg1
238: } def
239:
240:
241: %%% aux functions.
242: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
243: %% getdvars2 ==> dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
244: %% getxvars2 ==> xvars = [(x) (z)]
245: /getxvars2 {
246: /arg1 set
247: [/in-getxvars2 /ww /vv /ans /ii /nn /ans] pushVariables
248: [ /ww arg1 def
249: /ans [ ] def
250: /nn ww length def
251: 0 1 nn 1 sub {
252: /ii set
253: ww ii get (type?) dc 1 eq
254: { } % skip, may be weight [(x) 2 ] is OK.
255: {
256: /vv ww ii get (string) dc def
257: vv (array) dc 0 get
258: @@@.Dsymbol (array) dc 0 get
259: eq %% If the first character is D?
260: { } % skip
261: { ans [ vv ] join /ans set }
262: ifelse
263: } ifelse
264: } for
265: /arg1 ans def
266: ] pop
267: popVariables
268: arg1
269: } def
270: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
271: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
272: %% xvars = [(x) (z)]
273: /getdvars2 {
274: /arg1 set
275: [/in-getdvars2 /ww /vv /ans /ii /nn /ans1 /ans2] pushVariables
276: [ /ww arg1 def
277: /ans1 [ ] def /ans2 [ ] def
278: /nn ww length def
279: 0 1 nn 1 sub {
280: /ii set
281: ww ii get (type?) dc 1 eq
282: { } % skip, may be weight [(x) 2 ] is OK.
283: {
284: /vv ww ii get (string) dc def
285: vv (array) dc 0 get
286: @@@.Dsymbol (array) dc 0 get
287: eq %% If the first character is D?
288: { ans1 [ vv ] join /ans1 set
289: ans2 [ vv ww ii 1 add get ] join /ans2 set
290: }
291: { } %% skip
292: ifelse
293: } ifelse
294: } for
295: /arg1 [ans1 ans2] def
296: ] pop
297: popVariables
298: arg1
299: } def
300:
301: [(wbf)
302: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] wbf [g1 ... gq])
303: (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
304: (<string> v1 ... vp; <integer> w1 ... wp;)
305: (<poly> g1 ... gq;)
306: (f1 ... fm are generators, v1 ... vn are variables,)
307: (w1 is the weight of the variable v1, ...)
308: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
309: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
310: (If the weight is not generic, then the function exits with error.)
311: (cf. bf-111 for w=(1 1 1 1 ...) )
312: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] wbf$
313: $ restrict only for y.$
314: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
315: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbf$
316: $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
317: $ [(x) -1 (Dx) 1]] wbf$
318: ]
319: ] putUsages ( wbf ) messagen
320: /wbf {
321: /arg1 set
322: [/in-wbf /aaa] pushVariables
323: [ /aaa arg1 def
324: aaa [1] join intwbf /arg1 set
325: ] pop
326: popVariables
327: arg1
328: } def
329:
330: [(intwbf)
331: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] intwbf [g1 ... gq])
332: (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
333: (<string> v1 ... vp; <integer> w1 ... wp;)
334: (<poly> g1 ... gq;)
335: (f1 ... fm are generators, v1 ... vn are variables,)
336: (w1 is the weight of the variable v1, ...)
337: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
338: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
339: (If the weight is not generic, then the function exits with error.)
340: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] intwbf$
341: $ integrate only for y.$
342: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
343: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbf$
344: $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
345: $ [(x) -1 (Dx) 1]] intwbf$
346: ]
347: ] putUsages ( intwbf ) messagen
348:
349: /intwbf {
350: /arg1 set
351: [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
352: /dt-list /nn /ii /dt-ii /mm /jj /xvars /dvars /ans1 /k1 /kk /ans2
353: /vec-input /gg1.init /gg1.init2 /complementxvars /gg1.init3
354: /rest-bf
355: ] pushVariables
356: [(CurrentRingp) (KanGBmessage)] pushEnv
357: [
358: /ff arg1 0 get def
359: /vv arg1 1 get def
360: /ww arg1 2 get def
361: arg1 length 4 eq {
362: /rest-bf 1 def
363: intw.verbose { (bf for restriction.) message } { } ifelse
364: } {
365: /rest-bf 0 def
366: intw.verbose { (bf for integration.) message } { } ifelse
367: } ifelse
368: intw.verbose
369: { [ff vv ww ] messagen ( is the input. ) message } { } ifelse
370: ff 0 get isArray {
371: ff { {toString} map } map /ff set
372: /vec-input 1 def
373: }{
374: ff {toString} map /ff set
375: /vec-input 0 def
376: } ifelse
377: /vv vv { (,) 2 cat_n } map aload length cat_n def
378: intw.verbose { vv message } { } ifelse
379: [(KanGBmessage) intw.verbose] system_variable
380: [vv ring_of_differential_operators
381: [ww] weight_vector 0] define_ring
382: ww getxvars2 /xvars set
383: ww getdvars2 /dvars set
384: intw.verbose {
385: (xvars = ) messagen xvars message
386: (dvars = ) messagen dvars message
387: } { } ifelse
388: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
389: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
390: %% xvars = [(x) (z)]
391: /integral0.ff ff def %% keep variable for debug.
392:
393: rest-bf {
394: %% No Laplace transform for the restriction.
395: vec-input {
396: ff { { . [[(h). (1).]] replace } map homogenize } map /ff set
397: } {
398: ff { . [[(h). (1).]] replace homogenize } map /ff set
399: } ifelse
400: }{
401: vec-input {
402: ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
403: } {
404: ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
405: } ifelse
406: } ifelse
407:
408: intw.verbose {
409: (Computing Groebner basis with the weight vector ) messagen
410: ww message
411: } { } ifelse
412: [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
413: intw.verbose {
414: gg1 message %% keep variable for debug.
415: } { } ifelse
416: %% gg1 is the (-w,w)-adapted basis.
417: /integral0.gg1 gg1 def
418: %%% The above code is as same as that of integral-k1
419:
420: intwbf.aux1
421: /arg1 set
422: ] pop
423: popEnv
424: popVariables
425: arg1
426: } def
427:
428: /intwbf.aux1 {
429: [/gg1.init /gg1.init2 /complementxvars /gg1.init3] pushVariables
430: [(CurrentRingp)] pushEnv
431: [
432: %%% It uses local variables in intwbf or integral-k1
433: %%%%%%% Let's compute the b-function. It only works for full integration
434: %%%%%%% and generic weight vector.
435: %% order must be defined by (1) www and (2) [@@@.esymbol 1]
436: %% (x Dx^2 e + Dx e + x e + Dx) -->x Dx^2 e + Dx e + Dx --> (x Dx^2 + Dx)e
437: intw.verbose {
438: [(-------------- computing the b-ideal for generic initial. ---------)
439: $-------- if the output is [(e f_1(x,y)) (e f_2(x,y)) g_1(x,y) g_2(x,y) --$
440: $-------- then (f_1,f_2) cap (g_1,g_2) would be the b-ideal. $
441: ]{message} map
442: } { } ifelse
443: /complementxvars xvars [vv to_records pop] complement def
444: intw.verbose {
445: (vv = ) messagen vv message
446: (step1. complementxvars = ) messagen complementxvars message
447: } { } ifelse
448: complementxvars { dup @@@.Dsymbol 2 1 roll 2 cat_n } map
449: /complementxvars set
450: intw.verbose {
451: (step2. complementxvars = ) messagen complementxvars message
452: } { } ifelse
453: %% vv = (x,y,z)
454: %% xvars = [(x) (z)]
455: %% complementxvars = [(y) (Dy)]
456:
457: gg1 {ww weightv init [@@@.esymbol 1] weightv init} map /gg1.init set
458: intw.verbose {
459: gg1.init message
460: } { } ifelse
461: gg1.init { xvars {.} map dvars 0 get {.} map xvars {.} map
462: distraction2 } map /gg1.init2 set
463: %% remove 0
464: gg1.init2 { dup (0). eq { pop } { } ifelse } map /gg1.init2 set
465:
466: %% Let's eliminate complementxvars
467: complementxvars [ ] eq { }
468: {
469: [vv ring_of_differential_operators
470: [ complementxvars { 1 } map ] weight_vector 0] define_ring
471: [gg1.init2 { dehomogenize toString . } map] groebner_sugar
472: 0 get /gg1.init3 set
473: gg1.init3 complementxvars eliminatev /gg1.init2 set
474: } ifelse
475:
476: intw.verbose {
477: (b-ideal is --------) message
478: gg1.init2 message
479: } { } ifelse
480:
481: gg1.init2 /arg1 set
482: ] pop
483: popEnv
484: popVariables
485: arg1
486: } def
487:
488: %%% see, gbhg3/Int/int1.sm1
489:
490:
491: [(ip1a)
492: [([vlist wlist k] ip1a slist)
493: ( x^i ; i_1 w_1 + ... + i_p w_p <= k )
494: (Example 1: [[(x) (y) (z)] [1 1 1] 3] ip1a )
495: (Example 2: [[(x)] [1] 4] ip1a )
496: ]] putUsages
497: /ip1a {
498: /arg1 set
499: [/in-ip1a /vlist /wlist /kk /ans /i] pushVariables
500: [(CurrentRingp)] pushEnv
501: [
502: /vlist arg1 0 get def
503: /wlist arg1 1 get def
504: /kk arg1 2 get def
505:
506: [vlist from_records ring_of_polynomials 0] define_ring
507: vlist { toString . } map /vlist set
508: /ans [ ] def
509: 0 1 kk {
510: /i set
511: vlist wlist i ip1 ans join /ans set
512: } for
513: ans /arg1 set
514: ] pop
515: popEnv
516: popVariables
517: arg1
518: } def
519:
520:
521: %% [(x1) (x2)] typeL [ [[(Dx1) (Dx1+D_z1)] [(Dx2) (Dx2+D_z2)]]
522: %% [(_z1) (_z2)] ]
523: /typeL {
524: /arg1 set
525: [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
526: [
527: /xvars arg1 def
528: xvars length /n set
529: [ 1 1 n { toString } for ] /zlist set
530: zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
531: %% [(_z1) (_z2) ... ]
532: /rule [ 1 1 n { pop 0 } for ] def
533: 0 1 n 1 sub {
534: /i set
535: [ @@@.Dsymbol xvars i get 2 cat_n
536: [@@@.Dsymbol xvars i get
537: (+)
538: @@@.Dsymbol zlist i get
539: ] cat
540: ] /tmpr set
541: rule i tmpr put
542: } for
543: /arg1 [rule zlist] def
544: ] pop
545: popVariables
546: arg1
547: } def
548:
549: %% [(x1) (x2)] typeR [ [[(x1) (x1-_z1)] [(x2) (x2-_z2)]
550: %% [(Dx1) (-D_z1)] [(Dx2) (-D_z2)]]
551: %% [(_z1) (_z2)] ]
552: /typeR {
553: /arg1 set
554: [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
555: [
556: /xvars arg1 def
557: xvars length /n set
558: [ 1 1 n { toString } for ] /zlist set
559: zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
560: %% [(_z1) (_z2) ... ]
561: /rule [ 1 1 n 2 mul { pop 0 } for ] def
562: 0 1 n 1 sub {
563: /i set
564: [ @@@.Dsymbol xvars i get 2 cat_n
565: [
566: (-)
567: @@@.Dsymbol zlist i get
568: ] cat
569: ] /tmpr set
570: rule << i n add >> tmpr put
571: [ xvars i get
572: [ xvars i get
573: (-)
574: zlist i get
575: ] cat
576: ] /tmpr set
577: rule i tmpr put
578: } for
579: /arg1 [rule zlist] def
580: ] pop
581: popVariables
582: arg1
583: } def
584:
585: /tensor0 {
586: /arg1 set
587: [/in-tensor0 /vlist
588: /vlist2 /exteriorTensor /aaa /ans
589: ] pushVariables
590: [
591: arg1 tensor0.aux /aaa set
592: /exteriorTensor aaa 0 get def
593: /vlist aaa 1 get def
594: /vlist2 aaa 2 get def
595: [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] message
596: [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] restriction
597: /ans set
598: ans 0 get toVectors2 /arg1 set
599: ]pop
600: popVariables
601: arg1
602: } def
603:
604: /tensor1 {
605: /arg1 set
606: [/in-tensor0 /vlist
607: /vlist2 /exteriorTensor /aaa /ans
608: ] pushVariables
609: [
610: arg1 tensor0.aux /aaa set
611: /exteriorTensor aaa 0 get def
612: /vlist aaa 1 get def
613: /vlist2 aaa 2 get def
614: [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] message
615: [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] restriction
616: /ans set
617: ans {toVectors2} map /arg1 set
618: ]pop
619: popVariables
620: arg1
621: } def
622:
623:
624:
625: /tensor0.aux {
626: /arg1 set
627: [/in-tensor0.aux /mLeft /mRight /vlist
628: /ruleL /ruleR /vlist2 /exteriorTensor
629: ] pushVariables
630: [(CurrentRingp)] pushEnv
631: [
632: /mLeft arg1 0 get def
633: /mRight arg1 1 get def
634: /vlist arg1 2 get def
635:
636: mLeft {toString} map /mLeft set
637: mRight {toString} map /mRight set
638: vlist isString {
639: [vlist to_records pop ] /vlist set
640: } { } ifelse
641:
642: /ruleL vlist typeL 0 get def
643: /ruleR vlist typeR 0 get def
644: /vlist2 vlist typeL 1 get def
645:
646: [vlist vlist2 join from_records
647: ring_of_differential_operators 0] define_ring
648: ruleL { { . } map } map /ruleL set
649: ruleR { { . } map } map /ruleR set
650:
651: mLeft { . ruleL replace dehomogenize } map /mLeft set
652: mRight { . ruleR replace dehomogenize } map /mRight set
653:
654: /exteriorTensor mLeft mRight join { toString } map def
655:
656: /arg1 [exteriorTensor vlist vlist2] def
657: ] pop
658: popEnv
659: popVariables
660: arg1
661: } def
662:
663: [(tensor0)
664: [( [F G vlist] tensor0 )
665: (This function requires the package cohom.sm1.)
666: (Example 1:)
667: ( [[(2 x Dx - 1)] [(2 x Dx - 3)] (x)] tensor0 )
668: (Example 2:)
669: ( [[(-x*Dx^2+x-Dx+1)] [((x Dx + x +1)(Dx-1))] (x)] tensor0 )
670: (Example 3:)
671: ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y)] tensor0 )
672: ]] putUsages
673: (tensor0 ) messagen
674:
675: /wTensor0 {
676: /arg1 set
677: [/in-wTensor0 /vlist
678: /vlist2 /exteriorTensor /aaa /ans /weight /i /wlist
679: ] pushVariables
680: [
681: arg1 /aaa set
682: aaa 3 get /wlist set
683: [aaa 0 get aaa 1 get aaa 2 get] tensor0.aux /aaa set
684: /exteriorTensor aaa 0 get def
685: /vlist aaa 1 get def
686: /vlist2 aaa 2 get def
687:
688: [
689: 0 1 wlist length 1 sub {
690: /i set
691: vlist2 i get
692: 0 wlist i get sub
693: [@@@.Dsymbol vlist2 i get] cat
694: wlist i get
695: } for
696: ] /weight set
697: [exteriorTensor vlist vlist2 join weight] message
698: [exteriorTensor vlist vlist2 join weight] wRestriction0
699: /ans set
700: ans 0 get toVectors2 /arg1 set
701: ]pop
702: popVariables
703: arg1
704: } def
705: (wTensor0 ) messagen
706: [(wTensor0)
707: [([F G v weight] wTensor0)
708: (See tensor0)
709: (It calls wRestriction0 instead of restriction.)
710: (Example 1:)
711: ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y) [1 2]] wTensor0 )
712: ]] putUsages
713:
714: %% analyzing a given b-ideal.
715: /integralRoots001 {
716: /arg1 set
717: [/in-integralRoots00 /R /ff /n /i /j
718: /ans /ans2
719: ] pushVariables
720: [(CurrentRingp)] pushEnv
721: [
722: /ff arg1 def
723: /R ff 0 get (ring) dc def
724: [(CurrentRingp) R] system_variable
725:
726: ff toVectors /ff set
727: /n 0 def
728: 0 1 ff length 1 sub {
729: /i set
730: ff i get length n gt
731: { /n ff i get length def }
732: { } ifelse
733: } for %% n is the maximal length.
734:
735: [ 1 1 n { } for ] /ans set
736: 1 1 n {
737: /i set
738: /ans2 [ ] def
739: 0 1 ff length 1 sub {
740: /j set
741: ff j get length i eq {
742: ans2 [ ff j get i 1 sub get ] join /ans2 set
743: } { } ifelse
744: } for
745: ans << i 1 sub >> ans2 put
746: } for
747: /arg1 ans def
748: ] pop
749: popEnv
750: popVariables
751: arg1
752: } def
753:
754: /intwbfRoots {
755: /arg1 set
756: [/in-intwbfRoots /aaa /ggg /vvv /www] pushVariables
757: [
758: /aaa arg1 def
759: aaa 2 get getxvars2 { toString } map /vvv set
760: aaa 2 get getdvars2 1 get
761: { dup isString { pop } { } ifelse } map /www set
762: (vvv=) messagen vvv message
763: (www=) messagen www message
764: aaa length 3 {
765: %% integration.
766: aaa intwbf
767: /intwbf.bideal set %% global var
768: } {
769: %% restriction
770: aaa wbf
771: /intwbf.bideal set %% global var
772: } ifelse
773: intwbf.bideal integralRoots001
774: /intwbf.bideal2 set %% global var
775: (b-ideal is ) messagen intwbf.bideal2 message
776: (It is in the global variable intwbf.bideal2.) message
777: intwbf.bideal2
778: { /ggg set
779: %% [ggg vvv www] { { (type?) dc } map } map message error
780: [ggg vvv www] rationalRoots2
781: } map
782: /ggg set
783:
784: %% Integer 0 is returned as a null by ox_asir.
785: ggg {{ dup tag 0 eq { pop 0 } { } ifelse } map} map /ggg set
786:
787: (vvv = ) messagen vvv message
788: (www = ) messagen www message
789: (Roots are ) messagen ggg message
790:
791:
792: [-intInfinity] ggg flatten join shell rest /arg1 set
793: ] pop
794: popVariables
795: arg1
796: } def
797:
798: [(intwbfRoots)
799: [(This function needs oxasir --- rationalRoots2)
800: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
801: $Example 1: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
802: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbfRoots $
803: $Example 2: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
804: $ [(x) -1 (Dx) 1]] intwbfRoots $
805: ]] putUsages
806: (intwbfRoots ) messagen
807:
808: /wbfRoots {
809: /arg1 set
810: [/in-wbfRoots /aaa ]pushVariables
811: [
812: /aaa arg1 def
813: aaa [1] join intwbfRoots /arg1 set
814: ] pop
815: popVariables
816: arg1
817: } def
818: [(wbfRoots)
819: [(This function needs oxasir --- rationalRoots2)
820: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
821: $Example 1: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
822: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbfRoots $
823: $Example 2: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
824: $ [(x) -1 (Dx) 1]] wbfRoots $
825: ]] putUsages
826: (wbfRoots ) messagen
827:
828:
829:
830: /wIntegration0 {
831: /arg1 set
832: [/in-wIntegration /aaa /rrr /k1 /ans] pushVariables
833: [
834: /aaa arg1 def
835: aaa intwbfRoots /rrr set
836: rrr << rrr length 1 sub >> get /k1 set
837: k1 0 lt {
838: /ans [ ] def
839: } {
840: aaa [k1] join integral-k1 /ans set
841: } ifelse
842: (k1 = ) messagen k1 message
843: /arg1 ans def
844: ] pop
845: popVariables
846: arg1
847: } def
848:
849: (wIntegration0 ) message
850: [(wIntegration0)
851: [( [gg vlist weight] wIntegration0 [ igg bb] )
852: (list of strings gg; list of strings vlist;)
853: (list weight;)
854: (integer k1;)
855: (list of polys igg; list of polys base;)
856: (gg are input ideal or submodule.)
857: (igg are relations and bb are bases. They give the integral.)
858: (This function fails when weight is not generic.)
859: (cf. intwbf, intwbfRoots, integral-k1. )
860: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
861: $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
862: $ Section 5.5 for the algorithm.$
863: $Example 1: [ [(Dt - (3 t^2-x)) (Dx + t)] [(t) (x)] [(t) -1 (Dt) 1]] $
864: $ wIntegration0 $
865: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
866: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wIntegration0 $
867: $ The output [[-x, 1] [x,1]] implies the integral is $
868: $ (K x + K 1)/(K (-x) + K 1) = 0 where K is the base field and$
869: $ x and 1 is the vector space basis.$
870: $ Note that the order of weight and the order of the variables$
871: $ must be the same. Note also that the next of (x) must be (Dx)$
872: $ and so on.$
873: ]] putUsages
874:
875: /wRestriction0 {
876: /arg1 set
877: [/in-wRestriction0 /gg /vlist /v0 /vv /b /aaa /ans] pushVariables
878: [(CurrentRingp)] pushEnv
879: [
880: /aaa arg1 def
881: /gg aaa 0 get def
882: /vlist aaa 1 get def
883: vlist isArray
884: { vlist from_records /v0 set }
885: { /v0 vlist def vlist to_records /vlist set } ifelse
886: /vv vlist vlist { /b set [@@@.Dsymbol b] cat } map join def
887: [v0 ring_of_differential_operators 0] define_ring pop
888: gg 0 get isArray {
889: gg { { toString . vv laplace0 toString } map } map /gg set
890: }
891: {
892: gg { toString . vv laplace0 toString } map /gg set
893: } ifelse
894: /ans [gg] aaa rest join wIntegration0 def
895:
896: [v0 ring_of_differential_operators 0] define_ring pop
897: ans { { toString . vv laplace0 } map } map /ans set
898: /arg1 ans def
899: ] pop
900: popEnv
901: popVariables
902: arg1
903: } def
904:
905: (wRestriction0 ) messagen
906: [(wRestriction0)
907: [( [gg vlist weight] wRestriction0 [ igg bb] )
908: (list of strings gg; list of strings vlist;)
909: (list weight;)
910: (integer k1;)
911: (list of polys igg; list of polys base;)
912: (gg are input ideal or submodule.)
913: (igg are relations and bb are bases. They give the 0-th restriction.)
914: (This function fails when weight is not generic.)
915: (cf. intwbf, intwbfRoots, integral-k1. )
916: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
917: $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
918: $ Section 5.5 for the algorithm.$
919: $Example 1: [ [(Dt^2) (Dx^2)] [(t) (x)] [(t) -1 (Dt) 1]] $
920: $ wRestriction0 $
921: $Example 2: [[(Dx^2) (Dy^2)] [(x) (y)] $
922: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wRestriction0 $
923: $ The output [[-Dx, 1] [Dx,1]] implies the restriction is $
924: $ (K Dx + K 1)/(K (-Dx) + K 1) = 0 where K is the base field and$
925: $ Dx and 1 is the vector space basis.$
926: $ Note that the order of weight and the order of the variables$
927: $ must be the same. Note also that the next of (x) must be (Dx)$
928: $ and so on.$
929: ]] putUsages
930:
931:
932:
933: /ann-t-f {
934: /arg1 set
935: [/in-ann-t-f /f /vlist /s /vvv /nnn /rrr
936: /v1 /ops /ggg /ggg0
937: ] pushVariables
938: [(CurrentRingp) (KanGBmessage)] pushEnv
939: [
940: /f arg1 0 get def /vlist arg1 1 get def
941: f toString /f set
942: vlist { toString } map /vlist set
943: [(KanGBmessage) fs.verbose] system_variable
944: /s vlist 0 get def
945: /vvv (_u,_v,_t,) vlist rest { (,) 2 cat_n } map aload length /nnn set
946: s nnn 2 add cat_n def
947: fs.verbose { vvv message } { }ifelse
948: [vvv ring_of_differential_operators
949: [[(_u) 1 (_v) 1]] weight_vector 0] define_ring /rrr set
950:
951: [ (_t). f . sub ]
952: vlist rest { /v1 set
953: f . @@@.Dsymbol v1 2 cat_n . 1 diff0 [@@@.Dsymbol (_t)] cat . mul
954: @@@.Dsymbol v1 2 cat_n . add } map
955: join
956: /ops set
957: ops {[[(h). (1).]] replace } map /ops set
958: fs.verbose { ops message } { }ifelse
959: ops { [[(_t). s .] [[@@@.Dsymbol (_t)] cat . @@@.Dsymbol s 2 cat_n .]] replace dehomogenize } map
960: /arg1 set
961: ] pop
962: popEnv
963: popVariables
964: arg1
965: } def
966: [(ann-t-f)
967: [(ann-t-f returns the annihilating ideal of delta(t-f(x)))
968: $Example: [(x^3-y^2) [(t) (x) (y)]] ann-t-f $
969: ]] putUsages
970: (ann-t-f ) messagen
971:
972: /bf-111 {
973: /arg1 set
974: [/in-bf-111 /aa /vlist /rest-vlist] pushVariables
975: [(CurrentRingp) (KanGBmessage)] pushEnv
976: [
977: /aa arg1 def
978: aa 1 get /vlist set
979: aa 2 get /rest-vlist set
980: /vlist [vlist to_records pop] def
981: /rest-vlist [rest-vlist to_records pop] def
982: /BFvarlist vlist def /BFparlist [ ] def
983: aa 0 get { toString} map
984: rest-vlist bfm 0 get /bf-111.bfunc set
985: /arg1 bf-111.bfunc def
986: ] pop
987: popEnv
988: popVariables
989: arg1
990: } def
991: [(bf-111)
992: [( [ideal vlist rest-vlist bf-111] bf-111 )
993: (Compute the b-function for the weight vector 11111 for the variables)
994: (res-vlist. cf. wbf)
995: (Example: [ [((x Dx -1 ) x Dx (x Dx + 2)) (y Dy)] (x,y) (x)] bf-111 )
996: ]] putUsages
997: (bf-111 ) messagen
998:
999: /wdeRham0 {
1000: /arg1 set
1001: [/in-wdeRham0 /aaa /ff0 /vlist /myweight] pushVariables
1002: [
1003: /aaa arg1 def
1004: /ff0 arg1 0 get def
1005: /vlist arg1 1 get def
1006: /myweight arg1 2 get def
1007: [ff0 vlist] annfs /ff0 set
1008:
1009: /vlist [vlist to_records pop ] def
1010: [ff0 0 get vlist myweight] wIntegration0
1011: /arg1 set
1012: ] pop
1013: popVariables
1014: arg1
1015: } def
1016: (wdeRham0 ) messagen
1017: [(wdeRham0)
1018: [ $It computes the midle dimensional cohomology groups and bases.$
1019: $A generic weight vector is used for the computation.$
1020: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
1021: $ Example 1 : [(x^3-y^2) (x,y) [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wdeRham0 $
1022: $ Example 2 : [(x^3+y^3+z^3) (x,y,z) $
1023: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
1024: $ Example 3 : [(x^3 -y z^2) (x,y,z) $
1025: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
1026: $ Example 4 : [(x^3 -y^2 z^2) (x,y,z) $
1027: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
1028: ]] putUsages
1029:
1030: /intw.sm1.loaded 1 def
1031:
1032: ( ) message ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to intw.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc