=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/appell.sm1,v retrieving revision 1.1.1.1 retrieving revision 1.7 diff -u -p -r1.1.1.1 -r1.7 --- OpenXM/src/kan96xx/Doc/appell.sm1 1999/10/08 02:12:02 1.1.1.1 +++ OpenXM/src/kan96xx/Doc/appell.sm1 2008/06/03 00:04:43 1.7 @@ -1,4 +1,5 @@ %% appell.sm1, 1998, 11/8 +% $OpenXM: OpenXM/src/kan96xx/Doc/appell.sm1,v 1.6 2003/08/18 11:59:57 takayama Exp $ /appell.version (2.981108) def appell.version [(Version)] system_variable gt { (This package requires the latest version of kan/sm1) message @@ -81,7 +82,8 @@ $appell.sm1 generates Appell hypergeometric differenti [(appell1) [(param appell1 c) (array param; array c;) - (appell1 returns the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n)) + (appell1 returns an annihilating ideal for ) + (the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n)) (for the parameter << param >> = [a, c, b_1, ..., b_n].) (In case of n=2, the function is called the Appell function F_1.) (c = [ generators, variables ]) @@ -95,6 +97,111 @@ $appell.sm1 generates Appell hypergeometric differenti ] ] putUsages +/appell1r { + /arg1 set + [/in-appell1r /typev /setarg /b /n /vv /i /a /c /bb /ans /rr /j + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment. + [ + /aa arg1 def + aa isArray { } { (array appell) message (appell1r) usage error } ifelse + /setarg 0 def + aa { tag } map /typev set + /rr 0 def + typev [ ArrayP ] eq + { /b aa 0 get def + /setarg 1 def + } { } ifelse + typev [ ArrayP RingP] eq + { /b aa 0 get def + /rr aa 1 get def + /setarg 1 def + } { } ifelse + typev [ ] eq + { + /b appell.b def + /setarg 1 def + } { } ifelse + setarg { } { (Argument mismatch) message (appell1r) usage error } ifelse + + [(KanGBmessage) appell.verbose] system_variable + + /n b length 2 sub def %% Lauricella F_D^n + + %% vv = [(x1) (x2)] + [ + 1 1 n { + /i set + (x) i gensym + } for + ] /vv set + + rr tag 1 eq { + [vv from_records ring_of_differential_operators 0] define_ring + } { + rr ring_def + } ifelse + + %% b = [a c b_1 ... b_n ] + /a b 0 get def + /c b 1 get def + /bb b rest rest def + + [ 1 1 n { + /i set + [@@@.Dsymbol (x)] cat i gensym . + 1 n appellr.euler . (0).. c add (1).. sub add + mul + + 1 n appellr.euler . (0).. a add add + i i appellr.euler . (0).. , bb i 1 sub get, add, add + mul + + sub + (numerator) dc cancelCoeff dehomogenize + toString + } for + % (xi-xj) Di Dj - bj Di + bi Dj + 1 1 n 1 sub { + /i set + i 1 add, 1, n { + /j set + (x) i gensym . , (x) j gensym . sub + [@@@.Dsymbol (x)] cat i gensym . + [@@@.Dsymbol (x)] cat j gensym . mul mul + + (0).. , bb j 1 sub get, add + [@@@.Dsymbol (x)] cat i gensym . mul + sub + + (0).. , bb i 1 sub get, add + [@@@.Dsymbol (x)] cat j gensym . mul + add + (numerator) dc cancelCoeff dehomogenize + toString + } for + } for + ] /ans set + /arg1 [ans vv] def + ] pop + popEnv + popVariables + arg1 +} def +[(appell1r) + [(param appell1r c) + (array param; array c;) + (appell1r returns an annihilating ideal for ) + (the Lauricella function F_D(a,b_1, ..., b_n,c; x_1,...,x_n)) + (for the parameter << param >> = [a, c, b_1, ..., b_n].) + (In case of n=2, the function is called the Appell function F_1.) + (c = [ generators, variables ]) + (Example 1. [ [(1).. (2).. div -4 -2 5 6] ] appell1r rank ::) + $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $ + $ [ [(a). (2).. div (a). (1). (1).] r] appell1r $ + ] +] putUsages + /appell4 { /arg1 set [/in-appell4 /typev /setarg /b /n /vv /i /a /c /bb /ans @@ -151,8 +258,9 @@ $appell.sm1 generates Appell hypergeometric differenti [(appell4) [(param appell4 c) (array param; array c;) - (appell4 returns the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n)) - (for the parameter << param >> = [a, c, b_1, ..., b_n].) + (appell4 returns an annihilating ideal for ) + (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n)) + (for the parameter << param >> = [a, b, c_1, ..., c_n].) (In case of n=2, the function is called the Appell function F_4.) (c = [ generators, variables ]) (Note that for a special set of parameters, the returned differential equation) @@ -161,8 +269,93 @@ $appell.sm1 generates Appell hypergeometric differenti ] ] putUsages +/appell4r { + /arg1 set + [/in-appell4r /typev /setarg /b /n /vv /i /a /c /bb /ans /rr + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment. + [ + /aa arg1 def + aa isArray { } { (array appell) message (appell4r) usage error } ifelse + /setarg 0 def + aa { tag } map /typev set + /rr 0 def + typev [ ArrayP ] eq + { /b aa 0 get def + /setarg 1 def + } { } ifelse + typev [ ArrayP RingP] eq + { /b aa 0 get def + /rr aa 1 get def + /setarg 1 def + } { } ifelse + typev [ ] eq + { + /b appell.b def + /setarg 1 def + } { } ifelse + setarg { } { (Argument mismatch) message (appell4r) usage error } ifelse + + [(KanGBmessage) appell.verbose] system_variable + /n b length 2 sub def %% Lauricella F_C^n + + %% vv = [(x1) (x2)] + [ + 1 1 n { + /i set + (x) i gensym + } for + ] /vv set + rr tag 1 eq { + [vv from_records ring_of_differential_operators 0] define_ring + } { + rr ring_def + } ifelse + + %% b = [a b c_1 ... c_n ] + /a b 0 get def + /c b 1 get def + /bb b rest rest def + + [ 1 1 n { + /i set + [@@@.Dsymbol (x)] cat i gensym . + i i appellr.euler . bb i 1 sub get (1).. sub add + mul + + 1 n appellr.euler . (0).. a add add + 1 n appellr.euler . (0).. c add add + mul + + sub + (numerator) dc cancelCoeff dehomogenize + toString + } for + ] /ans set + /arg1 [ans vv] def + ] pop + popEnv + popVariables + arg1 +} def +%% [ [(1).. (2).. div -4 -2 5 6] ] appell4r +[(appell4r) + [(param appell4r c) + (array param; array c;) + (appell4r returns an annihilating ideal for ) + (the Lauricella function F_C(a,b, c_1, ..., c_n; x_1,...,x_n)) + (for the parameter << param >> = [a, b, c_1, ..., c_n].) + (In case of n=2, the function is called the Appell function F_4.) + (c = [ generators, variables ]) + (Example 1. [ [(1).. (2).. div -4 -2 5 6] ] appell4r rank ::) + $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $ + $ [ [(a). (2).. div (a). (1). (1).] r] appell4r $ + ] +] putUsages + + /appell.euler { /arg2 set /arg1 set @@ -177,5 +370,169 @@ $appell.sm1 generates Appell hypergeometric differenti arg1 } def +/appellr.euler { + /arg2 set + /arg1 set + [/n /i /n0] pushVariables + [ + /n0 arg1 def + /n arg2 def + [ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym + i n eq not { ( + ) } { } ifelse } for ] cat + /arg1 set + ] pop + popVariables + arg1 +} def + +/appell2 { + /arg1 set + [/in-appell2 /typev /setarg /b /n /vv /i /a /c /bb /ans + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment. + [ + /aa arg1 def + aa isArray { } { (array appell) message (appell2) usage error } ifelse + /setarg 0 def + aa { tag } map /typev set + typev [ ArrayP ] eq + { /b aa 0 get def + /setarg 1 def + } { } ifelse + typev [ ] eq + { + /b [1 [2 3] [4 5]] def + /setarg 1 def + } { } ifelse + setarg { } { (Argument mismatch) message (appell2) usage error } ifelse + + [(KanGBmessage) appell.verbose] system_variable + + /n b 1 get length def %% Lauricella F_A^n + + %% vv = [(x1) (x2)] + [ + 1 1 n { + /i set + (x) i gensym + } for + ] /vv set + + %% b = [a [b_1 ... b_n] [c_1 ... c_n] ] + /a b 0 get def + /c b 2 get def + /bb b 1 get def + + [ 1 1 n { + /i set + [ [@@@.Dsymbol (x)] cat i gensym + $ ($ i i appell.euler c i 1 sub get 1 sub $) - ( $ + 1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat + } for + ] /ans set + /arg1 [ans vv] def + ] pop + popEnv + popVariables + arg1 +} def +(appell2 ) messagen-quiet +[(appell2) + [(param appell2 c) + (array param; array c;) + (appell2 returns an annihilating ideal for ) + (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n)) + (for the parameter << param >> = [a, [b_1, ..., b_n],[c_1, ..., c_n]].) + (In case of n=2, the function is called the Appell function F_2.) + (c = [ generators, variables ]) + (Example: [ [1 [-4 -2] [5 6]] ] appell2 rank ::) + ] +] putUsages + +/appell2r { + /arg1 set + [/in-appell2r /typev /setarg /b /n /vv /i /a /c /bb /ans /r + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment. + [ + /aa arg1 def + aa isArray { } { (array appell) message (appell2r) usage error } ifelse + /setarg 0 def + aa { tag } map /typev set + /r 0 def + typev [ ArrayP ] eq + { /b aa 0 get def + /setarg 1 def + } { } ifelse + typev [ ArrayP RingP] eq + { /b aa 0 get def + /setarg 1 def + /r aa 1 get def + } { } ifelse + typev [ ] eq + { + /b [1 [2 3] [4 5]] def + /setarg 1 def + } { } ifelse + setarg { } { (Argument mismatch) message (appell2r) usage error } ifelse + + [(KanGBmessage) appell.verbose] system_variable + + /n b 1 get length def %% Lauricella F_A^n + + %% vv = [(x1) (x2)] + [ + 1 1 n { + /i set + (x) i gensym + } for + ] /vv set + + r tag 1 eq { + [vv from_records ring_of_differential_operators 0] define_ring + } { + r ring_def + } ifelse + + %% b = [a [b_1 ... b_n] [c_1 ... c_n] ] + /a b 0 get def + /c b 2 get def + /bb b 1 get def + + [ 1 1 n { + /i set + [@@@.Dsymbol (x)] cat i gensym . + i i appellr.euler . c i 1 sub get (1).. sub add + mul + + 1 n appellr.euler . (0).. a add add + i i appellr.euler . (0).. bb i 1 sub get add add + mul + + sub + (numerator) dc cancelCoeff dehomogenize + toString + } for + ] /ans set + /arg1 [ans vv] def + ] pop + popEnv + popVariables + arg1 +} def +%%[[(1).. (2).. div [(1).. (2).. div (1).. (2).. div] [1 1]] ] appell2r rank :: +[(appell2r) + [(param appell2r c) + (array param; array c;) + (appell2r returns an annihilating ideal for ) + (the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n)) + (for the parameter << param >> = [a, [b_1, ..., b_n], [c_1, ..., c_n]].) + (In case of n=2, the function is called the Appell function F_2.) + (c = [ generators, variables ]) + (Example 1. [ [(1).. (2).. div [-4 -2] [5 6]] ] appell2r rank ::) + $Example 2. [(a,x1,x2) ring_of_differential_operators 0] define_ring /r set $ + $ [ [(a). (2).. div [(a). (1).. (3).. div] [(1). (1).]] r] appell2r $ + ] +] putUsages -( ) message-quiet ; \ No newline at end of file +( ) message-quiet ;