[oct-scm] [oct-git]OCT: A portable Lisp implementation for quad-double precision floats branch master updated. e10e402d446339130042607357b0129b35a1faa7

Raymond Toy rtoy at common-lisp.net
Fri Mar 23 04:13:15 UTC 2012


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "OCT:  A portable Lisp implementation for quad-double precision floats".

The branch, master has been updated
       via  e10e402d446339130042607357b0129b35a1faa7 (commit)
       via  1d9ec007bb4172eaccb8ca1db543c1218192cdb5 (commit)
      from  4b332ed2140e56c6fcaa689e6b8a48be36c988f6 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e10e402d446339130042607357b0129b35a1faa7
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Thu Mar 22 21:13:07 2012 -0700

    Correct the computation of s-exp-integral-e when v is an integer.  Add
    tests.

diff --git a/qd-gamma.lisp b/qd-gamma.lisp
index e5fc5f0..13f0bd9 100644
--- a/qd-gamma.lisp
+++ b/qd-gamma.lisp
@@ -501,16 +501,14 @@
 	  (- (* (/ (expt -z (- v 1))
 		   (gamma v))
 		(- (psi v) (log z)))
-	     (loop for k from 0 below n
-		   for term = 1 then (* term (/ -z k))
-		   for sum = (/ (- 1 v)) then (+ sum (/ term (+ k 1 -v)))
-		   when (< (abs term) (* (abs sum) eps))
-		     return sum)
-	     (loop for k from n
-		   for term = 1 then (* term (/ -z k))
-		   for sum = 0 then (+ sum (/ term (+ k 1 -v)))
-		   when (< (abs term) (* (abs sum) eps))
-		     return sum)))
+	     (loop for k from 0
+		       for term = 1 then (* term (/ -z k))
+		   for sum = (/ (- 1 v)) then (+ sum (let ((denom (+ k 1 (- n))))
+						       (if (zerop denom)
+							   0
+							   (/ term (+ k 1 -v)))))
+		       when (< (abs term) (* (abs sum) eps))
+			 return sum)))
 	(loop for k from 0
 	      for term = 1 then (* term (/ -z k))
 	      for sum = (/ (- 1 v)) then (+ sum (/ term (+ k 1 -v)))
diff --git a/rt-tests.lisp b/rt-tests.lisp
index fa6da81..173c528 100644
--- a/rt-tests.lisp
+++ b/rt-tests.lisp
@@ -1464,3 +1464,17 @@
 		    (expt x 4))))
       (check-accuracy 210.8 e true))
   nil)
+
+(rt:deftest expintegral-e.5d
+    (let* ((x .5d0)
+	   (e (exp-integral-e 2d0 x))
+	   (true #q0.3266438623245530177304015653336378358284946903290101))
+      (check-accuracy 51.2 e true))
+  nil)
+
+(rt:deftest expintegral-e.5q
+    (let* ((x #q.5)
+	   (e (exp-integral-e #q2 x))
+	   (true #q0.326643862324553017730401565333637835828494690329010198058745549181386569998611289568))
+      (check-accuracy 208.4 e true))
+  nil)
\ No newline at end of file

commit 1d9ec007bb4172eaccb8ca1db543c1218192cdb5
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Mar 21 22:24:48 2012 -0700

    Handle the case of negative v in exp-integral-e(v, z).  Add tests.

diff --git a/qd-gamma.lisp b/qd-gamma.lisp
index d49acf8..e5fc5f0 100644
--- a/qd-gamma.lisp
+++ b/qd-gamma.lisp
@@ -527,7 +527,12 @@
   ;; for |arg(z)| < pi.
   ;;
   ;;
-  (cond ((< (abs z) 1)
+  (cond ((and (realp v) (minusp v))
+	 ;; E(-v, z) = z^(-v-1)*incomplete_gamma_tail(v+1,z)
+	 (let ((-v (- v)))
+	   (* (expt z (- v 1))
+	      (incomplete-gamma-tail (+ -v 1) z))))
+	((< (abs z) 1)
 	 ;; Use series for small z
 	 (s-exp-integral-e v z))
 	((>= (abs (phase z)) 3.1)
diff --git a/rt-tests.lisp b/rt-tests.lisp
index c5b6743..fa6da81 100644
--- a/rt-tests.lisp
+++ b/rt-tests.lisp
@@ -1447,4 +1447,20 @@
     (let* ((e (exp-integral-e 2 1d0))
 	   (true 0.14849550677592204791835999d0))
       (check-accuracy 47.5 e true))
-  nil)
\ No newline at end of file
+  nil)
+
+(rt:deftest expintegral-e.4d
+    (let* ((x .5d0)
+	   (e (exp-integral-e -2 x))
+	   (true (/ (* (exp (- x)) (+ (* x x x) (* 2 x x) (* 2 x)))
+		    (expt x 4))))
+      (check-accuracy 53 e true))
+  nil)
+
+(rt:deftest expintegral-e.4q
+    (let* ((x #q.5)
+	   (e (exp-integral-e -2 x))
+	   (true (/ (* (exp (- x)) (+ (* x x x) (* 2 x x) (* 2 x)))
+		    (expt x 4))))
+      (check-accuracy 210.8 e true))
+  nil)

-----------------------------------------------------------------------

Summary of changes:
 qd-gamma.lisp |   25 ++++++++++++++-----------
 rt-tests.lisp |   30 ++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 11 deletions(-)


hooks/post-receive
-- 
OCT:  A portable Lisp implementation for quad-double precision floats




More information about the oct-cvs mailing list