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