Annotation of OpenXM/src/kan96xx/Doc/appell.sm1, Revision 1.7
1.1 maekawa 1: %% appell.sm1, 1998, 11/8
1.7 ! takayama 2: % $OpenXM: OpenXM/src/kan96xx/Doc/appell.sm1,v 1.6 2003/08/18 11:59:57 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:
1.7 ! takayama 100: /appell1r {
! 101: /arg1 set
! 102: [/in-appell1r /typev /setarg /b /n /vv /i /a /c /bb /ans /rr /j
! 103: ] pushVariables
! 104: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
! 105: [
! 106: /aa arg1 def
! 107: aa isArray { } { (array appell) message (appell1r) usage error } ifelse
! 108: /setarg 0 def
! 109: aa { tag } map /typev set
! 110: /rr 0 def
! 111: typev [ ArrayP ] eq
! 112: { /b aa 0 get def
! 113: /setarg 1 def
! 114: } { } ifelse
! 115: typev [ ArrayP RingP] eq
! 116: { /b aa 0 get def
! 117: /rr aa 1 get def
! 118: /setarg 1 def
! 119: } { } ifelse
! 120: typev [ ] eq
! 121: {
! 122: /b appell.b def
! 123: /setarg 1 def
! 124: } { } ifelse
! 125: setarg { } { (Argument mismatch) message (appell1r) usage error } ifelse
! 126:
! 127: [(KanGBmessage) appell.verbose] system_variable
! 128:
! 129: /n b length 2 sub def %% Lauricella F_D^n
! 130:
! 131: %% vv = [(x1) (x2)]
! 132: [
! 133: 1 1 n {
! 134: /i set
! 135: (x) i gensym
! 136: } for
! 137: ] /vv set
! 138:
! 139: rr tag 1 eq {
! 140: [vv from_records ring_of_differential_operators 0] define_ring
! 141: } {
! 142: rr ring_def
! 143: } ifelse
! 144:
! 145: %% b = [a c b_1 ... b_n ]
! 146: /a b 0 get def
! 147: /c b 1 get def
! 148: /bb b rest rest def
! 149:
! 150: [ 1 1 n {
! 151: /i set
! 152: [@@@.Dsymbol (x)] cat i gensym .
! 153: 1 n appellr.euler . (0).. c add (1).. sub add
! 154: mul
! 155:
! 156: 1 n appellr.euler . (0).. a add add
! 157: i i appellr.euler . (0).. , bb i 1 sub get, add, add
! 158: mul
! 159:
! 160: sub
! 161: (numerator) dc cancelCoeff dehomogenize
! 162: toString
! 163: } for
! 164: % (xi-xj) Di Dj - bj Di + bi Dj
! 165: 1 1 n 1 sub {
! 166: /i set
! 167: i 1 add, 1, n {
! 168: /j set
! 169: (x) i gensym . , (x) j gensym . sub
! 170: [@@@.Dsymbol (x)] cat i gensym .
! 171: [@@@.Dsymbol (x)] cat j gensym . mul mul
! 172:
! 173: (0).. , bb j 1 sub get, add
! 174: [@@@.Dsymbol (x)] cat i gensym . mul
! 175: sub
! 176:
! 177: (0).. , bb i 1 sub get, add
! 178: [@@@.Dsymbol (x)] cat j gensym . mul
! 179: add
! 180: (numerator) dc cancelCoeff dehomogenize
! 181: toString
! 182: } for
! 183: } for
! 184: ] /ans set
! 185: /arg1 [ans vv] def
! 186: ] pop
! 187: popEnv
! 188: popVariables
! 189: arg1
! 190: } def
! 191: [(appell1r)
! 192: [(param appell1r c)
! 193: (array param; array c;)
! 194: (appell1r returns an annihilating ideal for )
! 195: (the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n))
! 196: (for the parameter << param >> = [a, c, b_1, ..., b_n].)
! 197: (In case of n=2, the function is called the Appell function F_1.)
! 198: (c = [ generators, variables ])
! 199: (Example 1. [ [(1).. (2).. div -4 -2 5 6] ] appell1r rank ::)
! 200: $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $
! 201: $ [ [(a). (2).. div (a). (1). (1).] r] appell1r $
! 202: ]
! 203: ] putUsages
! 204:
1.1 maekawa 205: /appell4 {
206: /arg1 set
207: [/in-appell4 /typev /setarg /b /n /vv /i /a /c /bb /ans
208: ] pushVariables
209: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
210: [
211: /aa arg1 def
212: aa isArray { } { (array appell) message (appell4) usage error } ifelse
213: /setarg 0 def
214: aa { tag } map /typev set
215: typev [ ArrayP ] eq
216: { /b aa 0 get def
217: /setarg 1 def
218: } { } ifelse
219: typev [ ] eq
220: {
221: /b appell.b def
222: /setarg 1 def
223: } { } ifelse
224: setarg { } { (Argument mismatch) message (appell4) usage error } ifelse
225:
226: [(KanGBmessage) appell.verbose] system_variable
227:
228: /n b length 2 sub def %% Lauricella F_C^n
229:
230: %% vv = [(x1) (x2)]
231: [
232: 1 1 n {
233: /i set
234: (x) i gensym
235: } for
236: ] /vv set
237:
238: %% b = [a b c_1 ... c_n ]
239: /a b 0 get def
240: /c b 1 get def
241: /bb b rest rest def
242:
243: [ 1 1 n {
244: /i set
245: [ [@@@.Dsymbol (x)] cat i gensym
246: $ ($ i i appell.euler bb i 1 sub get 1 sub $) - ( $
247: 1 n appell.euler a $) ($ 1 n appell.euler c $ ) $] cat
248: } for
249: ] /ans set
250: /arg1 [ans vv] def
251: ] pop
252: popEnv
253: popVariables
254: arg1
255: } def
256: (appell4 ) messagen-quiet
257:
258: [(appell4)
259: [(param appell4 c)
260: (array param; array c;)
1.5 takayama 261: (appell4 returns an annihilating ideal for )
262: (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n))
263: (for the parameter << param >> = [a, b, c_1, ..., c_n].)
1.1 maekawa 264: (In case of n=2, the function is called the Appell function F_4.)
265: (c = [ generators, variables ])
266: (Note that for a special set of parameters, the returned differential equation)
267: (is not holonomic, e.g., [[1 2 3 4]] appell4 rank ::)
268: (Example: [ [1 -4 -2 5 6] ] appell4 rank ::)
269: ]
270: ] putUsages
271:
1.4 takayama 272: /appell4r {
273: /arg1 set
1.5 takayama 274: [/in-appell4r /typev /setarg /b /n /vv /i /a /c /bb /ans /rr
1.4 takayama 275: ] pushVariables
276: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
277: [
278: /aa arg1 def
1.6 takayama 279: aa isArray { } { (array appell) message (appell4r) usage error } ifelse
1.4 takayama 280: /setarg 0 def
281: aa { tag } map /typev set
1.5 takayama 282: /rr 0 def
1.4 takayama 283: typev [ ArrayP ] eq
284: { /b aa 0 get def
285: /setarg 1 def
286: } { } ifelse
1.5 takayama 287: typev [ ArrayP RingP] eq
288: { /b aa 0 get def
289: /rr aa 1 get def
290: /setarg 1 def
291: } { } ifelse
1.4 takayama 292: typev [ ] eq
293: {
294: /b appell.b def
295: /setarg 1 def
296: } { } ifelse
1.6 takayama 297: setarg { } { (Argument mismatch) message (appell4r) usage error } ifelse
1.4 takayama 298:
299: [(KanGBmessage) appell.verbose] system_variable
300:
301: /n b length 2 sub def %% Lauricella F_C^n
302:
303: %% vv = [(x1) (x2)]
304: [
305: 1 1 n {
306: /i set
307: (x) i gensym
308: } for
309: ] /vv set
310:
1.5 takayama 311: rr tag 1 eq {
312: [vv from_records ring_of_differential_operators 0] define_ring
313: } {
314: rr ring_def
315: } ifelse
1.4 takayama 316:
317: %% b = [a b c_1 ... c_n ]
318: /a b 0 get def
319: /c b 1 get def
320: /bb b rest rest def
321:
322: [ 1 1 n {
323: /i set
324: [@@@.Dsymbol (x)] cat i gensym .
325: i i appellr.euler . bb i 1 sub get (1).. sub add
326: mul
327:
328: 1 n appellr.euler . (0).. a add add
329: 1 n appellr.euler . (0).. c add add
330: mul
331:
332: sub
333: (numerator) dc cancelCoeff dehomogenize
334: toString
335: } for
336: ] /ans set
337: /arg1 [ans vv] def
338: ] pop
339: popEnv
340: popVariables
341: arg1
342: } def
343: %% [ [(1).. (2).. div -4 -2 5 6] ] appell4r
1.5 takayama 344: [(appell4r)
345: [(param appell4r c)
346: (array param; array c;)
347: (appell4r returns an annihilating ideal for )
348: (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n))
349: (for the parameter << param >> = [a, b, c_1, ..., c_n].)
350: (In case of n=2, the function is called the Appell function F_4.)
351: (c = [ generators, variables ])
352: (Example 1. [ [(1).. (2).. div -4 -2 5 6] ] appell4r rank ::)
353: $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $
354: $ [ [(a). (2).. div (a). (1). (1).] r] appell4r $
355: ]
356: ] putUsages
1.1 maekawa 357:
358:
359: /appell.euler {
360: /arg2 set
361: /arg1 set
362: [/n /i /n0] pushVariables
363: [
364: /n0 arg1 def
365: /n arg2 def
366: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym ( + ) } for ] cat
367: /arg1 set
368: ] pop
369: popVariables
370: arg1
371: } def
372:
1.4 takayama 373: /appellr.euler {
374: /arg2 set
375: /arg1 set
376: [/n /i /n0] pushVariables
377: [
378: /n0 arg1 def
379: /n arg2 def
380: [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym
381: i n eq not { ( + ) } { } ifelse } for ] cat
382: /arg1 set
383: ] pop
384: popVariables
385: arg1
386: } def
387:
1.2 takayama 388: /appell2 {
389: /arg1 set
390: [/in-appell2 /typev /setarg /b /n /vv /i /a /c /bb /ans
391: ] pushVariables
392: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
393: [
394: /aa arg1 def
395: aa isArray { } { (array appell) message (appell2) usage error } ifelse
396: /setarg 0 def
397: aa { tag } map /typev set
398: typev [ ArrayP ] eq
399: { /b aa 0 get def
400: /setarg 1 def
401: } { } ifelse
402: typev [ ] eq
403: {
404: /b [1 [2 3] [4 5]] def
405: /setarg 1 def
406: } { } ifelse
407: setarg { } { (Argument mismatch) message (appell2) usage error } ifelse
408:
409: [(KanGBmessage) appell.verbose] system_variable
410:
411: /n b 1 get length def %% Lauricella F_A^n
412:
413: %% vv = [(x1) (x2)]
414: [
415: 1 1 n {
416: /i set
417: (x) i gensym
418: } for
419: ] /vv set
420:
421: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
422: /a b 0 get def
423: /c b 2 get def
424: /bb b 1 get def
425:
426: [ 1 1 n {
427: /i set
428: [ [@@@.Dsymbol (x)] cat i gensym
429: $ ($ i i appell.euler c i 1 sub get 1 sub $) - ( $
430: 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
431: } for
432: ] /ans set
433: /arg1 [ans vv] def
434: ] pop
435: popEnv
436: popVariables
437: arg1
438: } def
439: (appell2 ) messagen-quiet
440: [(appell2)
441: [(param appell2 c)
442: (array param; array c;)
1.5 takayama 443: (appell2 returns an annihilating ideal for )
444: (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
1.2 takayama 445: (for the parameter << param >> = [a, [b_1, ..., b_n],[c_1, ..., c_n]].)
446: (In case of n=2, the function is called the Appell function F_2.)
447: (c = [ generators, variables ])
448: (Example: [ [1 [-4 -2] [5 6]] ] appell2 rank ::)
449: ]
450: ] putUsages
451:
1.4 takayama 452: /appell2r {
453: /arg1 set
1.5 takayama 454: [/in-appell2r /typev /setarg /b /n /vv /i /a /c /bb /ans /r
1.4 takayama 455: ] pushVariables
456: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
457: [
458: /aa arg1 def
1.6 takayama 459: aa isArray { } { (array appell) message (appell2r) usage error } ifelse
1.4 takayama 460: /setarg 0 def
461: aa { tag } map /typev set
1.5 takayama 462: /r 0 def
1.4 takayama 463: typev [ ArrayP ] eq
464: { /b aa 0 get def
465: /setarg 1 def
466: } { } ifelse
1.5 takayama 467: typev [ ArrayP RingP] eq
468: { /b aa 0 get def
469: /setarg 1 def
470: /r aa 1 get def
471: } { } ifelse
1.4 takayama 472: typev [ ] eq
473: {
474: /b [1 [2 3] [4 5]] def
475: /setarg 1 def
476: } { } ifelse
1.6 takayama 477: setarg { } { (Argument mismatch) message (appell2r) usage error } ifelse
1.4 takayama 478:
479: [(KanGBmessage) appell.verbose] system_variable
480:
481: /n b 1 get length def %% Lauricella F_A^n
482:
483: %% vv = [(x1) (x2)]
484: [
485: 1 1 n {
486: /i set
487: (x) i gensym
488: } for
489: ] /vv set
490:
1.5 takayama 491: r tag 1 eq {
492: [vv from_records ring_of_differential_operators 0] define_ring
493: } {
494: r ring_def
495: } ifelse
1.4 takayama 496:
497: %% b = [a [b_1 ... b_n] [c_1 ... c_n] ]
498: /a b 0 get def
499: /c b 2 get def
500: /bb b 1 get def
501:
502: [ 1 1 n {
503: /i set
504: [@@@.Dsymbol (x)] cat i gensym .
505: i i appellr.euler . c i 1 sub get (1).. sub add
506: mul
507:
508: 1 n appellr.euler . (0).. a add add
509: i i appellr.euler . (0).. bb i 1 sub get add add
510: mul
511:
512: sub
513: (numerator) dc cancelCoeff dehomogenize
514: toString
515: } for
516: ] /ans set
517: /arg1 [ans vv] def
518: ] pop
519: popEnv
520: popVariables
521: arg1
522: } def
523: %%[[(1).. (2).. div [(1).. (2).. div (1).. (2).. div] [1 1]] ] appell2r rank ::
1.5 takayama 524: [(appell2r)
525: [(param appell2r c)
526: (array param; array c;)
527: (appell2r returns an annihilating ideal for )
528: (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
529: (for the parameter << param >> = [a, [b_1, ..., b_n], [c_1, ..., c_n]].)
530: (In case of n=2, the function is called the Appell function F_2.)
531: (c = [ generators, variables ])
532: (Example 1. [ [(1).. (2).. div [-4 -2] [5 6]] ] appell2r rank ::)
533: $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $
534: $ [ [(a). (2).. div [(a). (1).. (3).. div] [(1). (1).]] r] appell2r $
535: ]
536: ] putUsages
1.1 maekawa 537:
1.3 takayama 538: ( ) 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