Annotation of OpenXM/src/kan96xx/Doc/Old/int.sm1, Revision 1.1.1.1
1.1 maekawa 1: %% int.sm1, Aug 16, 1995.
2: %% demo.int is a template file to get integral of D-modules.
3: %%
4: (int.sm1: Aug 26, 1995.) message
5: ( New macros "integral" and "get0" are added.) message
6: ( Type in demo.int to see a demo.) message
7:
8: %% Usage, putUsages and showKeywords
9: %% The data should be automatically generated from int.txt
10: %% int.sm1 = int.sm + int.txt
11: [(integral)
12: [(ff n integral ffi )
13: ( ff is a list of operators,)
14: ( n is a number to specify the degree of approximation,)
15: ( ffi is the result list that will be the input to the "groebner")
16: ( to get the integral of the module ff.)
17: (Example: )
18: $ [(x) ring_of_differential_operators ( ) elimination_order 0] define_ring $
19: $ [(Dx h +e^2). (E h + 2 x e).] 3 integral /ffi set$
20: ( [ffi] groebner 0 get get0 ::)
21: ( )
22: (See also, groebner (option countdown) and get0.)
23: ]] putUsages
24:
25: [(get0)
26: [(ff get0 result)
27: ( ff is a list of operators. The operators in ff that does not)
28: ( contain "e" is stored in result.)
29: ( Note that "E" is set to zero and "h" is set to 1.)
30: (See also integral)
31: (Example: )
32: $ [ (x h + 1). (e+x).] get0 :: $
33: ( [ x + 1 ] )
34: ]] putUsages
35:
36: /demo.int {
37: %%%% Define the ring
38: [(x) ring_of_differential_operators ( ) elimination_order 0] define_ring
39:
40: %%%% Give the equations here.
41: %%%% E e = e E + 1 and "e" and "E" will be eliminated.
42: [(Dx h +e^2).
43: (E h + 2 x e).
44: ] /ff set
45:
46: %%%% Give a number. If you can't get the integral, increase the number.
47: /nnn 3 def
48:
49: %%% Let's compute
50: ff nnn integral /ffi set
51: %% Give the lower and the upper bound of the degree.
52: %% /from-degree 0 def /to-degree 5 def
53: %%[ffi [(from) from-degree (to) to-degree]]
54: [ffi]
55: groebner 0 get get0 /ans set
56: (Answer is in ans. ans = ) message
57: ans ::
58: } def
59:
60: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
61: %%%%%%%%%%%% Don't touch below %%%%%%%%%%%%%%%%%%%%%%%%
62: %%%%%%%%%%%%%% e-vectors, integral, get0 %%%%%%%%%%%%%%
63: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64: %% (Try [f1 f2 ...] nnn integral /ff set) message
65: %% ([ff] groebner 0 get get0) message
66: %% number e-vectors
67: /e-vectors {
68: /arg1 set
69: [/ans] pushVariables
70: [
71: /ans [(e).] def
72: 1 1 << arg1 1 sub >>
73: { pop
74: /ans
75: [(e).] ans {(e). mul} map join
76: def
77: } for
78: /arg1 ans def
79: ] pop
80: popVariables
81: arg1
82: } def
83:
84:
85: %% [f1 f2 ...] nnn integral
86: /integral {
87: /arg2 set
88: /arg1 set
89: [/nnn /gens /m /ans /fff] pushVariables
90: [
91: /gens arg1 def
92: /nnn arg2 def
93: /m gens length def
94: /ans [ ] def
95: 0 1 << m 1 sub >> {
96: gens 2 1 roll get /fff set
97: %%fff ::
98: /ans
99: ans [fff] join nnn e-vectors {fff mul} map join
100: def
101: %%ans ::
102: } for
103: /ans
104: ans nnn e-vectors {(E). 2 1 roll mul} map join
105: def
106: /ans ans {[[(h). (1).]] replace} map def
107: /ans ans {homogenize} map def
108: /arg1 ans def
109: ] pop
110: popVariables
111: arg1
112: } def
113:
114: % [g1 g2 g3 ...] get0
115: /get0 {
116: /arg1 set
117: [/gb /degs /ans /n /ff] pushVariables
118: [
119: /gb arg1 def
120: /degs gb {(e). degree} map def
121: /ans [
122: 0 1 << gb length 1 sub >> {
123: /n set
124: << degs n get >> 0 eq
125: { gb n get [[(E). (0).] [(h). (1).]] replace /ff set
126: ff (0). eq
127: { }
128: { ff } ifelse
129: }
130: { } ifelse
131: } for
132: ] def
133: /arg1 ans def
134: ] pop
135: popVariables
136: arg1
137: } def
138:
139: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
140: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>