===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/appell.sm1,v
retrieving revision 1.3
retrieving revision 1.7
diff -u -p -r1.3 -r1.7
--- OpenXM/src/kan96xx/Doc/appell.sm1	2003/07/29 08:37:16	1.3
+++ OpenXM/src/kan96xx/Doc/appell.sm1	2008/06/03 00:04:43	1.7
@@ -1,5 +1,5 @@
 %% appell.sm1, 1998,  11/8
-% $OpenXM$
+% $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
@@ -82,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 ])
@@ -96,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
@@ -152,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)
@@ -162,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
@@ -178,6 +370,21 @@ $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
@@ -233,7 +440,8 @@ $appell.sm1 generates Appell hypergeometric differenti
 [(appell2)
  [(param appell2 c)
   (array param; array c;)
-  (appell2 returns the Lauricella function F_A(a,b_1, ..., b_n, c_1, ..., c_n; x_1,...,x_n))
+  (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 ])
@@ -241,5 +449,90 @@ $appell.sm1 generates Appell hypergeometric differenti
  ]
 ] 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 ;