Annotation of OpenXM/src/kan96xx/Doc/r-interface.sm1, Revision 1.1.1.1
1.1 maekawa 1: %% oaku/Restriction/r-interface.sm1 1998, 4/30. 5/8. 5/12, 11/14
2: %% 1999, 9/9
3: %% lib/r-interface.sm1
4: %%
5: %% r-interface.sm1 is kept in this directory for the compatibility to
6: %% old demo programs and packages. It is being merged to
7: %% resol0.sm1 cf. tower.sm1, tower-sugar.sm1, restall_s.sm1,
8: %% restall.sm1
9: %% 1999, 9/9 : this file is stilled being modified for vector input.
10: %% wbfRoots (oxasir.sm1, intw.sm1) is used to get b-function
11: %% for modules. Note that wbfRoots works only for generic
12: %% weights.
13: %%
14: /r-interface.version (2.981105) def
15: /r-interface.verbose 0 def
16: /deRham.verbose 0 def
17: %% /BFnotruncate 1 def Controlled from cohom.sm1
18:
19: r-interface.version [(Version)] system_variable gt
20: { (This package requires the latest version of kan/sm1) message
21: (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
22: error
23: } { } ifelse
24:
25: [(restriction)
26: [
27: ( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] restriction )
28: ( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
29: ( )
30: ( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] restriction )
31: ( )
32: (This function can be used by loading the experimental package cohom.sm1.)
33: (Restriction of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
34: (vars is a list of the variables and params is a list of parameters. )
35: (k0 is the minimum integral root of the b-function and k1 is the maximum)
36: (integral root of the b-function. If these values are not given and)
37: (they are small, then they are automatically computed. The program returns)
38: ( 0-th, ..., -limitdeg-th cohomology groups.)
39: ([vars params] and [k0 k1 deg] are optional arguments.)
40: (If vars and params are not given, the values of the global variables)
41: (BFvarlist and BFparlist will be used.)
42: ( )
43: (For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
44: ( )
45: (Example 1: cf. math.AG/9801114, Example 1.4 )
46: $ [[(- 2 x Dx - 3 y Dy +1) (3 y Dx^2 - 2 x Dy)] $
47: $ [(x) (y)] [[(x) (y)] [ ]]] restriction :: $
48: $[ [ 0 , [ ] ] , [ 1 , [ ] ] , [ 1 , [ ] ] ] $
49: $ H^0 = 0, H^(-1)= C^1/(no relation), H^(-2)=C^1/(no relation).$
50: (Example 2: )
51: $[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]]] restriction ::$
52: $[ [ 2 , [ -x*Dx+1 , -x*e*Dx+e ] ] , [ 0 , [ ] ] ]$
53: $ H^0=D_1^2/([-x Dx+1,0],[0, -x Dx + 1]), H^(-1) = 0 $
54: $ where e^0, e^1, e^2, ..., e^(m-1) are standard basis vectors of$
55: $ rank m free module (D_1)^m. D_1 is the ring of differential$
56: $ opertors of one variable x.$
57: (Example 3: )
58: $[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]] 0] restriction ::$
59: (Example 4: )
60: $[[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] [[(x)] [ ]]] restriction ::$
61: $In case of vector input, RESTRICTION VARIABLES MUST APPEAR FIRST$
62: $in the list of variable. We are using wbfRoots to get the roots of $
63: $b-functions, so we can use only generic weight vector for now.$
64: ]
65: ] putUsages
66:
67: /restriction {
68: /arg1 set
69: [/in-restriction /ppp /verbose /nnn /k0 /k1 /limitdeg
70: /x-vars /params /mmm /zzz /rest.bfunc
71: /gg %% it is not used in restriction, but restall*.sm1 destroys gg.
72: /vectorInput /wvec
73: ] pushVariables
74: [(CurrentRingp) (KanGBmessage)] pushEnv
75: [
76: /ppp arg1 def
77: /verbose 1 def
78: ppp
79: (restriction: argument must be an array.)
80: rest.listq pop
81:
82: /nnn ppp length def
83: nnn 2 lt nnn 4 gt or
84: { (restriction: too many or too few arguments) message
85: (restriction) usage error } { } ifelse
86:
87: nnn 3 eq nnn 4 eq or
88: {
89: %% set up global variables.
90: ppp 2 get
91: (restriction: the third argument must be [vars params] or [vars]. For example, [[(x) (y)]].)
92: rest.listq pop
93:
94: ppp 2 get length 2 eq { }
95: { ppp 2 get length 1 eq {
96: ppp 2 << ppp 2 get [ ] append >> put
97: }
98: {
99: (restriction: the third argument must be [vars params]) message
100: error } ifelse
101: } ifelse
102: ppp 2 get 0 get (vars must be an array.) rest.listq
103: { toString} map /x-vars set
104: ppp 2 get 1 get (params must be an array.) rest.listq
105: { toString} map /params set
106: }
107: {/x-vars BFvarlist def /params BFparlist def } ifelse
108:
109:
110:
111: /mmm ppp 0 get def %% module
112: /zzz ppp 1 get def %% algebraic set (zero set)
113: mmm
114: (restriction: the first argument must be list of polynomials)
115: rest.listq pop
116:
117: mmm length 0 eq {
118: (restriction: the input matrix does not contain generators.) message
119: error
120: } { } ifelse
121: mmm 0 get isArray {
122: /vectorInput 1 def
123: } {
124: /vectorInput 0 def
125: } ifelse
126: %% (vectorInput=) messagen vectorInput message
127:
128: zzz
129: (restriction: the second argument must be list of polynomials)
130: rest.listq pop
131:
132: [x-vars params join from_records ring_of_differential_operators 0]
133: define_ring
134: vectorInput {
135: mmm { {toString . dehomogenize}map } map /mmm set
136:
137: mmm { {toString} map } map /mmm set
138: }{
139: mmm { toString . dehomogenize } map /mmm set
140:
141: mmm { toString } map /mmm set
142: } ifelse
143: zzz { toString } map /zzz set
144:
145: x-vars rest.checkReserved
146: params rest.checkReserved
147:
148: /BFvarlist x-vars def /BFparlist params def
149:
150: [(KanGBmessage) r-interface.verbose] system_variable
151:
152:
153: nnn 2 eq nnn 3 eq or
154: { %% set up k0, k1 and limitdeg by computing b-functions.
155: vectorInput {
156: r-interface.load.oxasir.wint
157: /wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
158: [mmm BFvarlist wvec] messagen ( wbfRoots ) message
159: [mmm BFvarlist wvec] wbfRoots /tmp set
160: }{
161: [mmm zzz] messagen (bfm ) message
162: mmm zzz bfm /rest.bfunc00 set
163: rest.bfunc00 length 0 eq {
164: (restriction: No b-function. The input may not be holonomic.) error
165: } { } ifelse
166: rest.bfunc00 0 get /rest.bfunc set
167: (b-function is ) messagen rest.bfunc message
168: rest.bfunc findIntegralRoots /tmp set
169: } ifelse
170: tmp length 0 eq
171: { (All cohomology groups are zero.) message
172: /arg1 null def
173: /r-interface.sortir goto
174: } { } ifelse
175: tmp 0 get /k0 set
176: tmp << tmp length 1 sub >> get /k1 set
177: /limitdeg zzz length def
178: }
179: {
180: ppp 3 get isInteger
181: {
182: /limitdeg ppp 3 get def
183: vectorInput {
184: r-interface.load.oxasir.wint
185: /wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
186: [mmm BFvarlist wvec] messagen ( wbfRoots ) message
187: [mmm BFvarlist wvec] wbfRoots /tmp set
188: }{
189: [mmm zzz] messagen (bfm ) message
190: mmm zzz bfm /rest.bfunc00 set
191: rest.bfunc00 length 0 eq {
192: (restriction: No b-function. The input may not be holonomic.) error
193: } { } ifelse
194: rest.bfunc00 0 get /rest.bfunc set
195: (b-function is ) messagen rest.bfunc message
196: rest.bfunc findIntegralRoots /tmp set
197: } ifelse
198: tmp length 0 eq
199: { (All cohomology groups are zero.) message
200: /arg1 null def
201: /r-interface.sortir goto
202: } { } ifelse
203: tmp 0 get /k0 set
204: tmp << tmp length 1 sub >> get /k1 set
205: } {
206: ppp 3 get
207: (restriction: the fourth argument must be [k0 k1 limitdeg])
208: rest.listq pop
209:
210: ppp 3 get length 3 eq { }
211: { (restriction: the fourth argument must be [k0 k1 limitdeg]) message
212: error } ifelse
213: ppp 3 get 0 get /k0 set
214: ppp 3 get 1 get /k1 set
215: ppp 3 get 2 get /limitdeg set
216: }ifelse
217: } ifelse
218:
219: BFnotruncate {
220: [mmm zzz k1 limitdeg] messagen ( restall1_s ) message
221: mmm zzz k1 limitdeg restall1_s /arg1 set
222: } {
223: [mmm zzz k0 k1 limitdeg] messagen ( restall_s ) message
224: mmm zzz k0 k1 limitdeg restall_s /arg1 set
225: } ifelse
226: /r-interface.sortir
227: ] pop
228: popEnv
229: popVariables
230: arg1
231: } def
232:
233: /rest.listq {
234: /arg2 set /arg1 set
235: [/in-rest.listq /sss /aaa] pushVariables
236: [
237: /aaa arg1 def /sss arg2 def
238: aaa isArray { }
239: { sss message
240: error
241: } ifelse
242: /arg1 aaa def
243: ]pop
244: popVariables
245: arg1
246: } def
247:
248: /rest.checkReserved {
249: % check if s is used.
250: /arg1 set
251: [/in-rest.checkReserved /vlist /tmp] pushVariables
252: [ /vlist arg1 def
253: vlist (s) position /tmp set
254: tmp -1 gt
255: { (s is the reserved variable.) error }
256: { } ifelse
257: ] pop
258: popVariables
259: } def
260:
261: [(integration)
262: [
263: ( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] integration )
264: ( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
265: ( )
266: ( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] integration )
267: ( )
268: (This function can be used by loading the experimental package cohom.sm1.)
269: (Integration of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
270: (vars is a list of the variables and params is a list of parameters. )
271: (k0 is the minimum integral root of the b-function and k1 is the maximum)
272: (integral root of the b-function. If these values are not given and)
273: (they are small, then they are automatically computed. The program returns)
274: ( 0-th, ..., -limitdeg-th cohomology groups.)
275: ([vars params] and [k0 k1 deg] are optional arguments.)
276: (If vars and params are not given, the values of the global variables)
277: (BFvarlist and BFparlist will be used.)
278: (The operator restriciton will be used after the laplace transformation.)
279: ( )
280: (For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
281: ( )
282: (Example 1: )
283: $[[(x (x-1)) (x) ] annfs 0 get
284: [(x)] [[(x)] [ ]]] integration ::$
285: (Example 2: )
286: $[ [(Dt - (3 t^2-x)) (Dx + t)] [(t)]
287: [[(t) (x)] [ ]] 0] integration ::$
288: (Example 3: )
289: $[ [[(Dt - (3 t^2-x)) (0)] [ (Dx + t) (0)]] [(t)]
290: [[(t) (x)] [ ]] 0] integration ::$
291: $In case of vector input, INTEGRAL VARIABLES MUST APPEAR FIRST$
292: $in the list of variable. We are using wbfRoots to get the roots of $
293: $b-functions, so we can use only generic weight vector for now.$
294: ]
295: ] putUsages
296:
297: /integration {
298: /arg1 set
299: [/in-integration /intvars /intvarsD /vars /params /inputs /aaa
300: /vectorInput
301: ] pushVariables
302: [
303: /aaa arg1 def
304: /inputs aaa 0 get def
305: /intvars aaa 1 get def
306: /vars aaa 2 get 0 get def
307: /params aaa 2 get 1 get def
308: [ vars params join from_records ring_of_differential_operators 0]
309: define_ring pop
310: inputs 0 get isArray {
311: /vectorInput 1 def
312: }{
313: /vectorInput 0 def
314: } ifelse
315: vectorInput {
316: inputs { {toString . dehomogenize} map } map /inputs set
317: }{
318: inputs { toString . dehomogenize } map /inputs set
319: } ifelse
320: /intvarsD intvars { @@@.Dsymbol 2 1 roll 2 cat_n } map def
321: vectorInput {
322: inputs { {intvars intvarsD join laplace0}map } map /inputs set
323: }{
324: inputs { intvars intvarsD join laplace0 } map /inputs set
325: } ifelse
326:
327: aaa 0 get messagen ( ==> ) messagen inputs message
328: aaa 0 inputs put
329: aaa restriction /arg1 set
330:
331: ] pop
332: arg1
333: } def
334:
335:
336: [(deRham)
337: [([f v] deRham c)
338: (string f; string v; f is a polynomial given by a string.)
339: (This function can be used by loading the experimental package cohom.sm1. )
340: (The dimensions of the deRham cohomology groups H^i(C^n - V(f),C) i=0, i=1, ..)
341: (.., n are returned in c.)
342: (For example, if c=[1 4 6 4], then it means that dim H^0(C^3-V(f),C) = 1,)
343: (dim H^1(C^3-V(f),C) = 4, and so on.)
344: (For the algorithm, see "An algorithm for de Rham cohomology groups of the)
345: (complement of an affine variety via D-module computation", )
346: $Journal of pure and applied algebra, 139 (1999), 201--233. math.AG/9801114$
347: ( )
348: (Example 0: [(x (x-1) (x-2)) (x)] deRham )
349: (Example 1: [(x y (x+y-1)(x-2)) (x,y)] deRham )
350: (Example 2: [(x^3-y^2) (x,y)] deRham )
351: (Example 3: [(x^3-y^2 z^2) (x,y,z)] deRham )
352: (Example 4: [(x y z (x+y+z-1)) (x,y,z)] deRham )
353: ]] putUsages
354: %% [(x+y+z) (x,y,z)] deRham ---> error in bfm, 1998, 11/27
355: /deRham {
356: /arg1 set
357: [/in-deRham /f /v /vlist /vlist0 /ff0 /ff2 /ttt
358: /r-interface.verbose /tower.verbose /fs.verbose /ans
359: ] pushVariables
360: [
361: /r-interface.verbose deRham.verbose def
362: /tower.verbose deRham.verbose def
363: /fs.verbose deRham.verbose def
364: /f arg1 0 get def
365: /v arg1 1 get def
366: v isArray {
367: /v v {toString} map from_records def
368: } { } ifelse
369: /vlist0 [v to_records pop] def
370: /vlist [v to_records pop] dup { /ttt set @@@.Dsymbol ttt 2 cat_n } map
371: join def
372: [f v] annfs 0 get /ff0 set
373:
374: ff0 { vlist laplace0 } map /ff2 set
375: [ff2 vlist0 [vlist0 [ ]]] restriction /ans set
376: /arg1 ans {deRham.simp} map reverse def
377: ] pop
378: popVariables
379: arg1
380: } def
381:
382: %% [3 , [1, e]] ==> 1
383: /deRham.simp {
384: /arg1 set
385: [/in-deRham.simp /gg /kk] pushVariables
386: [(KanGBmessage)] pushEnv
387: [
388: /kk arg1 0 get def
389: /gg arg1 1 get def
390: [(KanGBmessage) r-interface.verbose] system_variable
391: gg length 0 eq { }
392: {
393: kk [gg] groebner_sugar 0 get length sub /kk set
394: } ifelse
395: /arg1 kk def
396: ] pop
397: popEnv
398: popVariables
399: arg1
400: } def
401:
402:
403: /r-interface.load.oxasir.wint {
404: [
405: oxasir.sm1.loaded tag 0 eq {
406: (Loading oxasir.sm1 ) messagen
407: [(parse) (oxasir.sm1) pushfile] extension
408: }{
409: } ifelse
410: intw.sm1.loaded tag 0 eq {
411: (Loading intw.sm1 ) messagen
412: [(parse) (intw.sm1) pushfile] extension
413: }{
414: } ifelse
415: ] pop
416: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to r-interface.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc