Annotation of OpenXM/src/kan96xx/Doc/appell.sm1, Revision 1.1
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:
! 180:
! 181: ( ) 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