Annotation of OpenXM/src/kan96xx/Doc/appell.sm1, Revision 1.3
1.1 maekawa 1: %% appell.sm1, 1998, 11/8
1.3 ! takayama 2: % $OpenXM$
1.1 maekawa 3: /appell.version (2.981108) def
4: appell.version [(Version)] system_variable gt
5: { (This package requires the latest version of kan/sm1) message
6: (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
7: error
8: } { } ifelse
9:
10: $appell.sm1 generates Appell hypergeometric differential equations (C) N.Takayama, 1998, 11/8, cf. rank in hol.sm1 $ message-quiet
11: /appell.verbose 0 def
12: /appell.b [1 3 2 11] def
13:
14: /appell1 {
15: /arg1 set
16: [/in-appell1 /typev /setarg /b /n /vv /i /a /c /bb /ans /ans2
17: ] pushVariables
18: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
19: [
20: /aa arg1 def
21: aa isArray { } { (array appell) message (appell1) usage error } ifelse
22: /setarg 0 def
23: aa { tag } map /typev set
24: typev [ ArrayP ] eq
25: { /b aa 0 get def
26: /setarg 1 def
27: } { } ifelse
28: typev [ ] eq
29: {
30: /b appell.b def
31: /setarg 1 def
32: } { } ifelse
33: setarg { } { (Argument mismatch) message (appell1) usage error } ifelse
34:
35: [(KanGBmessage) appell.verbose] system_variable
36:
37: /n b length 2 sub def %% Lauricella F_D^n
38:
39: %% vv = [(x1) (x2)]
40: [
41: 1 1 n {
42: /i set
43: (x) i gensym
44: } for
45: ] /vv set
46:
47: %% b = [a c b_1 ... b_n ]
48: /a b 0 get def
49: /c b 1 get 1 sub def
50: /bb b rest rest def
51:
52: [ 1 1 n {
53: /i set
54: [ [@@@.Dsymbol (x)] cat i gensym
55: $ ($ 1 n appell.euler c $) - ( $
56: 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
57: } for
58: ] /ans set
59: %% Euler-Darboux equations are necessary. Otherwise, the system is
60: %% not holonomic for some parameters.
61: [ 1 1 n {
62: /i set
63: i 1 add 1 n {
64: /j set
65: [$($ $x$ i gensym $-x$ j gensym $) $
66: [@@@.Dsymbol (x)] cat i gensym $ $
67: [@@@.Dsymbol (x)] cat j gensym
68: $ - $ bb j 1 sub get $ $ [@@@.Dsymbol (x)] cat i gensym
69: $ + $ bb i 1 sub get $ $ [@@@.Dsymbol (x)] cat j gensym
70: ] cat
71: } for
72: }for
73: ] /ans2 set
74: /arg1 [ans ans2 join vv] def
75: ] pop
76: popEnv
77: popVariables
78: arg1
79: } def
80: (appell1 ) messagen-quiet
81:
82: [(appell1)
83: [(param appell1 c)
84: (array param; array c;)
85: (appell1 returns the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n))
86: (for the parameter << param >> = [a, c, b_1, ..., b_n].)
87: (In case of n=2, the function is called the Appell function F_1.)
88: (c = [ generators, variables ])
89: (Note that for a special set of parameters, the returned differential equation)
90: (is not holonomic, e.g., [[1 2 3 4]] appell1 rank ::)
91: (This happens because we do not included the Euler-Darboux operators)
92: (in the return value of appell1. It will be included in a future.)
93: (Example: [ [1 -4 -2 5 6] ] appell1 rank ::)
94: (For details, see P.Appell et Kampe de Feriet, Fonction hypergeometrique)
95: (et hyperspheriques -- polynomes d'Hermite, Gauthier-Villars, 1926.)
96: ]
97: ] putUsages
98:
99: /appell4 {
100: /arg1 set
101: [/in-appell4 /typev /setarg /b /n /vv /i /a /c /bb /ans
102: ] pushVariables
103: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
104: [
105: /aa arg1 def
106: aa isArray { } { (array appell) message (appell4) usage error } ifelse
107: /setarg 0 def
108: aa { tag } map /typev set
109: typev [ ArrayP ] eq
110: { /b aa 0 get def
111: /setarg 1 def
112: } { } ifelse
113: typev [ ] eq
114: {
115: /b appell.b def
116: /setarg 1 def
117: } { } ifelse
118: setarg { } { (Argument mismatch) message (appell4) usage error } ifelse
119:
120: [(KanGBmessage) appell.verbose] system_variable
121:
122: /n b length 2 sub def %% Lauricella F_C^n
123:
124: %% vv = [(x1) (x2)]
125: [
126: 1 1 n {
127: /i set
128: (x) i gensym
129: } for
130: ] /vv set
131:
132: %% b = [a b c_1 ... c_n ]
133: /a b 0 get def
134: /c b 1 get def
135: /bb b rest rest def
136:
137: [ 1 1 n {
138: /i set
139: [ [@@@.Dsymbol (x)] cat i gensym
140: $ ($ i i appell.euler bb i 1 sub get 1 sub $) - ( $
141: 1 n appell.euler a $) ($ 1 n appell.euler c $ ) $] cat
142: } for
143: ] /ans set
144: /arg1 [ans vv] def
145: ] pop
146: popEnv
147: popVariables
148: arg1
149: } def
150: (appell4 ) messagen-quiet
151:
152: [(appell4)
153: [(param appell4 c)
154: (array param; array c;)
155: (appell4 returns the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n))
156: (for the parameter << param >> = [a, c, b_1, ..., b_n].)
157: (In case of n=2, the function is called the Appell function F_4.)
158: (c = [ generators, variables ])
159: (Note that for a special set of parameters, the returned differential equation)
160: (is not holonomic, e.g., [[1 2 3 4]] appell4 rank ::)
161: (Example: [ [1 -4 -2 5 6] ] appell4 rank ::)
162: ]
163: ] putUsages
164:
165:
166:
167: /appell.euler {
168: /arg2 set
169: /arg1 set
170: [/n /i /n0] pushVariables
171: [
172: /n0 arg1 def
173: /n arg2 def
174: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym ( + ) } for ] cat
175: /arg1 set
176: ] pop
177: popVariables
178: arg1
179: } def
180:
1.2 takayama 181: /appell2 {
182: /arg1 set
183: [/in-appell2 /typev /setarg /b /n /vv /i /a /c /bb /ans
184: ] pushVariables
185: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
186: [
187: /aa arg1 def
188: aa isArray { } { (array appell) message (appell2) usage error } ifelse
189: /setarg 0 def
190: aa { tag } map /typev set
191: typev [ ArrayP ] eq
192: { /b aa 0 get def
193: /setarg 1 def
194: } { } ifelse
195: typev [ ] eq
196: {
197: /b [1 [2 3] [4 5]] def
198: /setarg 1 def
199: } { } ifelse
200: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
201:
202: [(KanGBmessage) appell.verbose] system_variable
203:
204: /n b 1 get length def %% Lauricella F_A^n
205:
206: %% vv = [(x1) (x2)]
207: [
208: 1 1 n {
209: /i set
210: (x) i gensym
211: } for
212: ] /vv set
213:
214: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
215: /a b 0 get def
216: /c b 2 get def
217: /bb b 1 get def
218:
219: [ 1 1 n {
220: /i set
221: [ [@@@.Dsymbol (x)] cat i gensym
222: $ ($ i i appell.euler c i 1 sub get 1 sub $) - ( $
223: 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
224: } for
225: ] /ans set
226: /arg1 [ans vv] def
227: ] pop
228: popEnv
229: popVariables
230: arg1
231: } def
232: (appell2 ) messagen-quiet
233: [(appell2)
234: [(param appell2 c)
235: (array param; array c;)
236: (appell2 returns the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
237: (for the parameter << param >> = [a, [b_1, ..., b_n],[c_1, ..., c_n]].)
238: (In case of n=2, the function is called the Appell function F_2.)
239: (c = [ generators, variables ])
240: (Example: [ [1 [-4 -2] [5 6]] ] appell2 rank ::)
241: ]
242: ] putUsages
243:
1.1 maekawa 244:
1.3 ! takayama 245: ( ) message-quiet ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to appell.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc