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