File: [local] / OpenXM / src / kan96xx / Doc / appell.sm1 (download)
Revision 1.7, Tue Jun 3 00:04:43 2008 UTC (16 years, 2 months ago) by takayama
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, HEAD Changes since 1.6: +106 -1
lines
Added a new function appell1r
which generates systems of differential operators for Lauricella F_D with
rational and polynomial parameters.
|
%% appell.sm1, 1998, 11/8
% $OpenXM: OpenXM/src/kan96xx/Doc/appell.sm1,v 1.7 2008/06/03 00:04:43 takayama Exp $
/appell.version (2.981108) def
appell.version [(Version)] system_variable gt
{ (This package requires the latest version of kan/sm1) message
(Please get it from http://www.math.kobe-u.ac.jp/KAN) message
error
} { } ifelse
$appell.sm1 generates Appell hypergeometric differential equations (C) N.Takayama, 1998, 11/8, cf. rank in hol.sm1 $ message-quiet
/appell.verbose 0 def
/appell.b [1 3 2 11] def
/appell1 {
/arg1 set
[/in-appell1 /typev /setarg /b /n /vv /i /a /c /bb /ans /ans2
] pushVariables
[(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
[
/aa arg1 def
aa isArray { } { (array appell) message (appell1) 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 appell.b def
/setarg 1 def
} { } ifelse
setarg { } { (Argument mismatch) message (appell1) 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
%% b = [a c b_1 ... b_n ]
/a b 0 get def
/c b 1 get 1 sub def
/bb b rest rest def
[ 1 1 n {
/i set
[ [@@@.Dsymbol (x)] cat i gensym
$ ($ 1 n appell.euler c $) - ( $
1 n appell.euler a $) ($ i i appell.euler bb i 1 sub get $ ) $] cat
} for
] /ans set
%% Euler-Darboux equations are necessary. Otherwise, the system is
%% not holonomic for some parameters.
[ 1 1 n {
/i set
i 1 add 1 n {
/j set
[$($ $x$ i gensym $-x$ j gensym $) $
[@@@.Dsymbol (x)] cat i gensym $ $
[@@@.Dsymbol (x)] cat j gensym
$ - $ bb j 1 sub get $ $ [@@@.Dsymbol (x)] cat i gensym
$ + $ bb i 1 sub get $ $ [@@@.Dsymbol (x)] cat j gensym
] cat
} for
}for
] /ans2 set
/arg1 [ans ans2 join vv] def
] pop
popEnv
popVariables
arg1
} def
(appell1 ) messagen-quiet
[(appell1)
[(param appell1 c)
(array param; array c;)
(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 ])
(Note that for a special set of parameters, the returned differential equation)
(is not holonomic, e.g., [[1 2 3 4]] appell1 rank ::)
(This happens because we do not included the Euler-Darboux operators)
(in the return value of appell1. It will be included in a future.)
(Example: [ [1 -4 -2 5 6] ] appell1 rank ::)
(For details, see P.Appell et Kampe de Feriet, Fonction hypergeometrique)
(et hyperspheriques -- polynomes d'Hermite, Gauthier-Villars, 1926.)
]
] 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
] pushVariables
[(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
[
/aa arg1 def
aa isArray { } { (array appell) message (appell4) 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 appell.b def
/setarg 1 def
} { } ifelse
setarg { } { (Argument mismatch) message (appell4) 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
%% 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 appell.euler bb i 1 sub get 1 sub $) - ( $
1 n appell.euler a $) ($ 1 n appell.euler c $ ) $] cat
} for
] /ans set
/arg1 [ans vv] def
] pop
popEnv
popVariables
arg1
} def
(appell4 ) messagen-quiet
[(appell4)
[(param appell4 c)
(array param; array c;)
(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)
(is not holonomic, e.g., [[1 2 3 4]] appell4 rank ::)
(Example: [ [1 -4 -2 5 6] ] appell4 rank ::)
]
] 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
[/n /i /n0] pushVariables
[
/n0 arg1 def
/n arg2 def
[ n0 1 n { /i set (x) i gensym ( ) [@@@.Dsymbol (x)] cat i gensym ( + ) } for ] cat
/arg1 set
] pop
popVariables
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 ;