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