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