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