Annotation of OpenXM/src/kan96xx/Doc/appell.sm1, Revision 1.5
1.1 maekawa 1: %% appell.sm1, 1998, 11/8
1.5 ! takayama 2: % $OpenXM: OpenXM/src/kan96xx/Doc/appell.sm1,v 1.4 2003/08/18 06:36:49 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;)
1.5 ! takayama 85: (appell1 returns an annihilating ideal for )
! 86: (the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n))
1.1 maekawa 87: (for the parameter << param >> = [a, c, b_1, ..., b_n].)
88: (In case of n=2, the function is called the Appell function F_1.)
89: (c = [ generators, variables ])
90: (Note that for a special set of parameters, the returned differential equation)
91: (is not holonomic, e.g., [[1 2 3 4]] appell1 rank ::)
92: (This happens because we do not included the Euler-Darboux operators)
93: (in the return value of appell1. It will be included in a future.)
94: (Example: [ [1 -4 -2 5 6] ] appell1 rank ::)
95: (For details, see P.Appell et Kampe de Feriet, Fonction hypergeometrique)
96: (et hyperspheriques -- polynomes d'Hermite, Gauthier-Villars, 1926.)
97: ]
98: ] putUsages
99:
100: /appell4 {
101: /arg1 set
102: [/in-appell4 /typev /setarg /b /n /vv /i /a /c /bb /ans
103: ] pushVariables
104: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
105: [
106: /aa arg1 def
107: aa isArray { } { (array appell) message (appell4) usage error } ifelse
108: /setarg 0 def
109: aa { tag } map /typev set
110: typev [ ArrayP ] eq
111: { /b aa 0 get def
112: /setarg 1 def
113: } { } ifelse
114: typev [ ] eq
115: {
116: /b appell.b def
117: /setarg 1 def
118: } { } ifelse
119: setarg { } { (Argument mismatch) message (appell4) usage error } ifelse
120:
121: [(KanGBmessage) appell.verbose] system_variable
122:
123: /n b length 2 sub def %% Lauricella F_C^n
124:
125: %% vv = [(x1) (x2)]
126: [
127: 1 1 n {
128: /i set
129: (x) i gensym
130: } for
131: ] /vv set
132:
133: %% b = [a b c_1 ... c_n ]
134: /a b 0 get def
135: /c b 1 get def
136: /bb b rest rest def
137:
138: [ 1 1 n {
139: /i set
140: [ [@@@.Dsymbol (x)] cat i gensym
141: $ ($ i i appell.euler bb i 1 sub get 1 sub $) - ( $
142: 1 n appell.euler a $) ($ 1 n appell.euler c $ ) $] cat
143: } for
144: ] /ans set
145: /arg1 [ans vv] def
146: ] pop
147: popEnv
148: popVariables
149: arg1
150: } def
151: (appell4 ) messagen-quiet
152:
153: [(appell4)
154: [(param appell4 c)
155: (array param; array c;)
1.5 ! takayama 156: (appell4 returns an annihilating ideal for )
! 157: (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n))
! 158: (for the parameter << param >> = [a, b, c_1, ..., c_n].)
1.1 maekawa 159: (In case of n=2, the function is called the Appell function F_4.)
160: (c = [ generators, variables ])
161: (Note that for a special set of parameters, the returned differential equation)
162: (is not holonomic, e.g., [[1 2 3 4]] appell4 rank ::)
163: (Example: [ [1 -4 -2 5 6] ] appell4 rank ::)
164: ]
165: ] putUsages
166:
1.4 takayama 167: /appell4r {
168: /arg1 set
1.5 ! takayama 169: [/in-appell4r /typev /setarg /b /n /vv /i /a /c /bb /ans /rr
1.4 takayama 170: ] pushVariables
171: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
172: [
173: /aa arg1 def
174: aa isArray { } { (array appell) message (appell4) usage error } ifelse
175: /setarg 0 def
176: aa { tag } map /typev set
1.5 ! takayama 177: /rr 0 def
1.4 takayama 178: typev [ ArrayP ] eq
179: { /b aa 0 get def
180: /setarg 1 def
181: } { } ifelse
1.5 ! takayama 182: typev [ ArrayP RingP] eq
! 183: { /b aa 0 get def
! 184: /rr aa 1 get def
! 185: /setarg 1 def
! 186: } { } ifelse
1.4 takayama 187: typev [ ] eq
188: {
189: /b appell.b def
190: /setarg 1 def
191: } { } ifelse
192: setarg { } { (Argument mismatch) message (appell4) usage error } ifelse
193:
194: [(KanGBmessage) appell.verbose] system_variable
195:
196: /n b length 2 sub def %% Lauricella F_C^n
197:
198: %% vv = [(x1) (x2)]
199: [
200: 1 1 n {
201: /i set
202: (x) i gensym
203: } for
204: ] /vv set
205:
1.5 ! takayama 206: rr tag 1 eq {
! 207: [vv from_records ring_of_differential_operators 0] define_ring
! 208: } {
! 209: rr ring_def
! 210: } ifelse
1.4 takayama 211:
212: %% b = [a b c_1 ... c_n ]
213: /a b 0 get def
214: /c b 1 get def
215: /bb b rest rest def
216:
217: [ 1 1 n {
218: /i set
219: [@@@.Dsymbol (x)] cat i gensym .
220: i i appellr.euler . bb i 1 sub get (1).. sub add
221: mul
222:
223: 1 n appellr.euler . (0).. a add add
224: 1 n appellr.euler . (0).. c add add
225: mul
226:
227: sub
228: (numerator) dc cancelCoeff dehomogenize
229: toString
230: } for
231: ] /ans set
232: /arg1 [ans vv] def
233: ] pop
234: popEnv
235: popVariables
236: arg1
237: } def
238: %% [ [(1).. (2).. div -4 -2 5 6] ] appell4r
1.5 ! takayama 239: [(appell4r)
! 240: [(param appell4r c)
! 241: (array param; array c;)
! 242: (appell4r returns an annihilating ideal for )
! 243: (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n))
! 244: (for the parameter << param >> = [a, b, c_1, ..., c_n].)
! 245: (In case of n=2, the function is called the Appell function F_4.)
! 246: (c = [ generators, variables ])
! 247: (Example 1. [ [(1).. (2).. div -4 -2 5 6] ] appell4r rank ::)
! 248: $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $
! 249: $ [ [(a). (2).. div (a). (1). (1).] r] appell4r $
! 250: ]
! 251: ] putUsages
1.1 maekawa 252:
253:
254: /appell.euler {
255: /arg2 set
256: /arg1 set
257: [/n /i /n0] pushVariables
258: [
259: /n0 arg1 def
260: /n arg2 def
261: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym ( + ) } for ] cat
262: /arg1 set
263: ] pop
264: popVariables
265: arg1
266: } def
267:
1.4 takayama 268: /appellr.euler {
269: /arg2 set
270: /arg1 set
271: [/n /i /n0] pushVariables
272: [
273: /n0 arg1 def
274: /n arg2 def
275: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym
276: i n eq not { ( + ) } { } ifelse } for ] cat
277: /arg1 set
278: ] pop
279: popVariables
280: arg1
281: } def
282:
1.2 takayama 283: /appell2 {
284: /arg1 set
285: [/in-appell2 /typev /setarg /b /n /vv /i /a /c /bb /ans
286: ] pushVariables
287: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
288: [
289: /aa arg1 def
290: aa isArray { } { (array appell) message (appell2) usage error } ifelse
291: /setarg 0 def
292: aa { tag } map /typev set
293: typev [ ArrayP ] eq
294: { /b aa 0 get def
295: /setarg 1 def
296: } { } ifelse
297: typev [ ] eq
298: {
299: /b [1 [2 3] [4 5]] def
300: /setarg 1 def
301: } { } ifelse
302: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
303:
304: [(KanGBmessage) appell.verbose] system_variable
305:
306: /n b 1 get length def %% Lauricella F_A^n
307:
308: %% vv = [(x1) (x2)]
309: [
310: 1 1 n {
311: /i set
312: (x) i gensym
313: } for
314: ] /vv set
315:
316: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
317: /a b 0 get def
318: /c b 2 get def
319: /bb b 1 get def
320:
321: [ 1 1 n {
322: /i set
323: [ [@@@.Dsymbol (x)] cat i gensym
324: $ ($ i i appell.euler c i 1 sub get 1 sub $) - ( $
325: 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
326: } for
327: ] /ans set
328: /arg1 [ans vv] def
329: ] pop
330: popEnv
331: popVariables
332: arg1
333: } def
334: (appell2 ) messagen-quiet
335: [(appell2)
336: [(param appell2 c)
337: (array param; array c;)
1.5 ! takayama 338: (appell2 returns an annihilating ideal for )
! 339: (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
1.2 takayama 340: (for the parameter << param >> = [a, [b_1, ..., b_n],[c_1, ..., c_n]].)
341: (In case of n=2, the function is called the Appell function F_2.)
342: (c = [ generators, variables ])
343: (Example: [ [1 [-4 -2] [5 6]] ] appell2 rank ::)
344: ]
345: ] putUsages
346:
1.4 takayama 347: /appell2r {
348: /arg1 set
1.5 ! takayama 349: [/in-appell2r /typev /setarg /b /n /vv /i /a /c /bb /ans /r
1.4 takayama 350: ] pushVariables
351: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
352: [
353: /aa arg1 def
354: aa isArray { } { (array appell) message (appell2) usage error } ifelse
355: /setarg 0 def
356: aa { tag } map /typev set
1.5 ! takayama 357: /r 0 def
1.4 takayama 358: typev [ ArrayP ] eq
359: { /b aa 0 get def
360: /setarg 1 def
361: } { } ifelse
1.5 ! takayama 362: typev [ ArrayP RingP] eq
! 363: { /b aa 0 get def
! 364: /setarg 1 def
! 365: /r aa 1 get def
! 366: } { } ifelse
1.4 takayama 367: typev [ ] eq
368: {
369: /b [1 [2 3] [4 5]] def
370: /setarg 1 def
371: } { } ifelse
372: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
373:
374: [(KanGBmessage) appell.verbose] system_variable
375:
376: /n b 1 get length def %% Lauricella F_A^n
377:
378: %% vv = [(x1) (x2)]
379: [
380: 1 1 n {
381: /i set
382: (x) i gensym
383: } for
384: ] /vv set
385:
1.5 ! takayama 386: r tag 1 eq {
! 387: [vv from_records ring_of_differential_operators 0] define_ring
! 388: } {
! 389: r ring_def
! 390: } ifelse
1.4 takayama 391:
392: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
393: /a b 0 get def
394: /c b 2 get def
395: /bb b 1 get def
396:
397: [ 1 1 n {
398: /i set
399: [@@@.Dsymbol (x)] cat i gensym .
400: i i appellr.euler . c i 1 sub get (1).. sub add
401: mul
402:
403: 1 n appellr.euler . (0).. a add add
404: i i appellr.euler . (0).. bb i 1 sub get add add
405: mul
406:
407: sub
408: (numerator) dc cancelCoeff dehomogenize
409: toString
410: } for
411: ] /ans set
412: /arg1 [ans vv] def
413: ] pop
414: popEnv
415: popVariables
416: arg1
417: } def
418: %%[[(1).. (2).. div [(1).. (2).. div (1).. (2).. div] [1 1]] ] appell2r rank ::
1.5 ! takayama 419: [(appell2r)
! 420: [(param appell2r c)
! 421: (array param; array c;)
! 422: (appell2r returns an annihilating ideal for )
! 423: (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
! 424: (for the parameter << param >> = [a, [b_1, ..., b_n], [c_1, ..., c_n]].)
! 425: (In case of n=2, the function is called the Appell function F_2.)
! 426: (c = [ generators, variables ])
! 427: (Example 1. [ [(1).. (2).. div [-4 -2] [5 6]] ] appell2r rank ::)
! 428: $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $
! 429: $ [ [(a). (2).. div [(a). (1).. (3).. div] [(1). (1).]] r] appell2r $
! 430: ]
! 431: ] putUsages
1.1 maekawa 432:
1.3 takayama 433: ( ) 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