Annotation of OpenXM/src/kan96xx/Doc/appell.sm1, Revision 1.4
1.1 maekawa 1: %% appell.sm1, 1998, 11/8
1.4 ! takayama 2: % $OpenXM: OpenXM/src/kan96xx/Doc/appell.sm1,v 1.3 2003/07/29 08:37:16 takayama Exp $
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:
1.4 ! takayama 165: /appell4r {
! 166: /arg1 set
! 167: [/in-appell4r /typev /setarg /b /n /vv /i /a /c /bb /ans
! 168: ] pushVariables
! 169: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
! 170: [
! 171: /aa arg1 def
! 172: aa isArray { } { (array appell) message (appell4) usage error } ifelse
! 173: /setarg 0 def
! 174: aa { tag } map /typev set
! 175: typev [ ArrayP ] eq
! 176: { /b aa 0 get def
! 177: /setarg 1 def
! 178: } { } ifelse
! 179: typev [ ] eq
! 180: {
! 181: /b appell.b def
! 182: /setarg 1 def
! 183: } { } ifelse
! 184: setarg { } { (Argument mismatch) message (appell4) usage error } ifelse
! 185:
! 186: [(KanGBmessage) appell.verbose] system_variable
! 187:
! 188: /n b length 2 sub def %% Lauricella F_C^n
! 189:
! 190: %% vv = [(x1) (x2)]
! 191: [
! 192: 1 1 n {
! 193: /i set
! 194: (x) i gensym
! 195: } for
! 196: ] /vv set
! 197:
! 198: [vv from_records ring_of_differential_operators 0] define_ring
! 199:
! 200: %% b = [a b c_1 ... c_n ]
! 201: /a b 0 get def
! 202: /c b 1 get def
! 203: /bb b rest rest def
! 204:
! 205: [ 1 1 n {
! 206: /i set
! 207: [@@@.Dsymbol (x)] cat i gensym .
! 208: i i appellr.euler . bb i 1 sub get (1).. sub add
! 209: mul
! 210:
! 211: 1 n appellr.euler . (0).. a add add
! 212: 1 n appellr.euler . (0).. c add add
! 213: mul
! 214:
! 215: sub
! 216: (numerator) dc cancelCoeff dehomogenize
! 217: toString
! 218: } for
! 219: ] /ans set
! 220: /arg1 [ans vv] def
! 221: ] pop
! 222: popEnv
! 223: popVariables
! 224: arg1
! 225: } def
! 226: %% [ [(1).. (2).. div -4 -2 5 6] ] appell4r
1.1 maekawa 227:
228:
229: /appell.euler {
230: /arg2 set
231: /arg1 set
232: [/n /i /n0] pushVariables
233: [
234: /n0 arg1 def
235: /n arg2 def
236: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym ( + ) } for ] cat
237: /arg1 set
238: ] pop
239: popVariables
240: arg1
241: } def
242:
1.4 ! takayama 243: /appellr.euler {
! 244: /arg2 set
! 245: /arg1 set
! 246: [/n /i /n0] pushVariables
! 247: [
! 248: /n0 arg1 def
! 249: /n arg2 def
! 250: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym
! 251: i n eq not { ( + ) } { } ifelse } for ] cat
! 252: /arg1 set
! 253: ] pop
! 254: popVariables
! 255: arg1
! 256: } def
! 257:
1.2 takayama 258: /appell2 {
259: /arg1 set
260: [/in-appell2 /typev /setarg /b /n /vv /i /a /c /bb /ans
261: ] pushVariables
262: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
263: [
264: /aa arg1 def
265: aa isArray { } { (array appell) message (appell2) usage error } ifelse
266: /setarg 0 def
267: aa { tag } map /typev set
268: typev [ ArrayP ] eq
269: { /b aa 0 get def
270: /setarg 1 def
271: } { } ifelse
272: typev [ ] eq
273: {
274: /b [1 [2 3] [4 5]] def
275: /setarg 1 def
276: } { } ifelse
277: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
278:
279: [(KanGBmessage) appell.verbose] system_variable
280:
281: /n b 1 get length def %% Lauricella F_A^n
282:
283: %% vv = [(x1) (x2)]
284: [
285: 1 1 n {
286: /i set
287: (x) i gensym
288: } for
289: ] /vv set
290:
291: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
292: /a b 0 get def
293: /c b 2 get def
294: /bb b 1 get def
295:
296: [ 1 1 n {
297: /i set
298: [ [@@@.Dsymbol (x)] cat i gensym
299: $ ($ i i appell.euler c i 1 sub get 1 sub $) - ( $
300: 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
301: } for
302: ] /ans set
303: /arg1 [ans vv] def
304: ] pop
305: popEnv
306: popVariables
307: arg1
308: } def
309: (appell2 ) messagen-quiet
310: [(appell2)
311: [(param appell2 c)
312: (array param; array c;)
313: (appell2 returns the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
314: (for the parameter << param >> = [a, [b_1, ..., b_n],[c_1, ..., c_n]].)
315: (In case of n=2, the function is called the Appell function F_2.)
316: (c = [ generators, variables ])
317: (Example: [ [1 [-4 -2] [5 6]] ] appell2 rank ::)
318: ]
319: ] putUsages
320:
1.4 ! takayama 321: /appell2r {
! 322: /arg1 set
! 323: [/in-appell2r /typev /setarg /b /n /vv /i /a /c /bb /ans
! 324: ] pushVariables
! 325: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
! 326: [
! 327: /aa arg1 def
! 328: aa isArray { } { (array appell) message (appell2) usage error } ifelse
! 329: /setarg 0 def
! 330: aa { tag } map /typev set
! 331: typev [ ArrayP ] eq
! 332: { /b aa 0 get def
! 333: /setarg 1 def
! 334: } { } ifelse
! 335: typev [ ] eq
! 336: {
! 337: /b [1 [2 3] [4 5]] def
! 338: /setarg 1 def
! 339: } { } ifelse
! 340: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
! 341:
! 342: [(KanGBmessage) appell.verbose] system_variable
! 343:
! 344: /n b 1 get length def %% Lauricella F_A^n
! 345:
! 346: %% vv = [(x1) (x2)]
! 347: [
! 348: 1 1 n {
! 349: /i set
! 350: (x) i gensym
! 351: } for
! 352: ] /vv set
! 353:
! 354: [vv from_records ring_of_differential_operators 0] define_ring
! 355:
! 356: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
! 357: /a b 0 get def
! 358: /c b 2 get def
! 359: /bb b 1 get def
! 360:
! 361: [ 1 1 n {
! 362: /i set
! 363: [@@@.Dsymbol (x)] cat i gensym .
! 364: i i appellr.euler . c i 1 sub get (1).. sub add
! 365: mul
! 366:
! 367: 1 n appellr.euler . (0).. a add add
! 368: i i appellr.euler . (0).. bb i 1 sub get add add
! 369: mul
! 370:
! 371: sub
! 372: (numerator) dc cancelCoeff dehomogenize
! 373: toString
! 374: } for
! 375: ] /ans set
! 376: /arg1 [ans vv] def
! 377: ] pop
! 378: popEnv
! 379: popVariables
! 380: arg1
! 381: } def
! 382: %%[[(1).. (2).. div [(1).. (2).. div (1).. (2).. div] [1 1]] ] appell2r rank ::
1.1 maekawa 383:
1.3 takayama 384: ( ) 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