===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/appell.sm1,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- OpenXM/src/kan96xx/Doc/appell.sm1	2003/08/18 11:59:57	1.6
+++ 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/src/kan96xx/Doc/appell.sm1,v 1.5 2003/08/18 11:28:15 takayama Exp $
+% $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
@@ -94,6 +94,111 @@ $appell.sm1 generates Appell hypergeometric differenti
   (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