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