OpenXM/src/kan96xx/Doc/appell.sm1 - diff

Return to appell.sm1 CVS log

Up to [local] / OpenXM / src / kan96xx / Doc

Diff for /OpenXM/src/kan96xx/Doc/appell.sm1 between version 1.6 and 1.7

-version 1.6, 2003/08/18 11:59:57
+version 1.7, 2008/06/03 00:04:43
 Line 1
 Line 1
 Line 1
  %% 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
 Line 94  $appell.sm1 generates Appell hypergeometric differenti
 Line 94  $appell.sm1 generates Appell hypergeometric differenti
 Line 94  $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 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  .
+n appellr.euler . (0).. c add (1).. sub  add
+            mul
+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 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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>