diff --git a/test-unit/augment.lisp b/test-unit/augment.lisp index a8f1f9a662537da246795401f7ad7d12822ced90..d36748f58e2ac8f20bc04fba63d3b2d44f4f07f5 100644 --- a/test-unit/augment.lisp +++ b/test-unit/augment.lisp @@ -1,6 +1,6 @@ ;; Additional methods for lisp-unit ;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp -;; Time-stamp: <2010-05-27 19:21:42EDT augment.lisp> +;; Time-stamp: <2010-05-29 20:58:09EDT augment.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -36,15 +36,56 @@ (defconstant +test-tol5+ (* 131072 +dbl-epsilon+)) (defconstant +test-tol6+ (* 1048576 +dbl-epsilon+)) +;;; These are 1.0 if not "RELEASED" +(defconstant +test-sigma+ 1.5d0) +(defconstant +test-factor+ 100.0d0) + +(defun sf-frac-diff (x1 x2) + ;; After test_sf_frac_diff in specfunc/test_sf.c. + (cond ((and (zerop x1) (zerop x2)) + (coerce 0 (type-of x1))) + ((zerop x1) + (abs x2)) + ((and (<= x1 most-positive-double-float) + (<= x2 most-positive-double-float) + (not (zerop (+ x1 x2)))) + (abs (/ (- x1 x2) (+ x1 x2)))) + (t 1.0d0))) + +(defun sf-check-pair (result expected-value tolerance &optional error-estimate) + (or (eql result expected-value) ; catch expected inifinity/nan + (let ((diff (abs (- result expected-value)))) + (and + (<= (sf-frac-diff result expected-value) (* +test-factor+ tolerance)) + (if error-estimate + (and (not (minusp error-estimate)) ; redundant but signalled as separate error in C + (finitep error-estimate) + (<= diff (* 2 +test-sigma+ error-estimate))) + t))))) + +(defun sf-check-results (result-list expected-value tolerance) + ;; After test_sf_check_result in specfunc/test_sf.c. + (when (atom expected-value) + (setf expected-value (list expected-value))) + (when (= (length result-list) (* 2 (length expected-value))) + ;; Error information is returned + (loop for ind below (length expected-value) + always + (sf-check-pair + (elt result-list ind) + (elt expected-value ind) + tolerance + (elt result-list (+ ind (length expected-value))))))) + ;; (assert-to-tolerance (tdist-P 0.0d0 1.0d0) 0.5d0 +test-tol6+) (defmacro assert-to-tolerance (form expected-value tolerance) `(let ((lisp-unit:*epsilon* ,tolerance)) - (lisp-unit::assert-numerical-equal + (lisp-unit::assert-true ,expected-value - ,(if (listp expected-value) - `(subseq (multiple-value-list ,form) - 0 ,(length (eval expected-value))) - `(nth-value 0 ,form))))) + (sf-check-results + (multiple-value-list ,form) ,expected-value ,tolerance)))) + +;; lisp-unit::assert-true (defmacro assert-posinf (form) `(lisp-unit::assert-true diff --git a/tests/gamma.lisp b/tests/gamma.lisp index f82d5380356e6dcef7b3abf048dbe98b9a4482c5..d3ef048a996de3b96ca1f62835a0f94495cf8c30 100644 --- a/tests/gamma.lisp +++ b/tests/gamma.lisp @@ -20,7 +20,7 @@ (LISP-UNIT:DEFINE-TEST GAMMA ;; Semi-automatically converted from specfunc/test_gamma.c - ;(ASSERT-TO-TOLERANCE (LOG-GAMMA -0.1d0) 2.368961332728788655d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (LOG-GAMMA -0.1d0) 2.368961332728788655d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-GAMMA (- (/ 1.0d0 256.0d0))) 5.547444766967471595d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-GAMMA 1.0d-08) 18.420680738180208905d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-GAMMA 0.1d0) 2.252712651734205d0 +TEST-TOL0+) @@ -59,7 +59,7 @@ (ASSERT-TO-TOLERANCE (GAMMA -11.25d0) 6.027393816261931672d-08 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (GAMMA (+ (- 1.0d0) (/ 1.0d0 65536.0d0))) -65536.42280587818970d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (GAMMA* 1.0d-08) 3989.423555759890865d0 +TEST-TOL1+) - ;(ASSERT-TO-TOLERANCE (GAMMA* 1.0d-05) 126.17168469882690233d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (GAMMA* 1.0d-05) 126.17168469882690233d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (GAMMA* 0.001d0) 12.708492464364073506d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (GAMMA* 1.5d0) 1.0563442442685598666d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (GAMMA* 3.0d0) 1.0280645179187893045d0 +TEST-TOL0+) @@ -83,7 +83,6 @@ (ASSERT-TO-TOLERANCE (1/GAMMA -11.25d0) #.(/ 6.027393816261931672d-08) +TEST-TOL1+) (ASSERT-TO-TOLERANCE (1/GAMMA (+ (- 1.0d0) (/ 1.0d0 65536.0d0))) #.(/ -65536.42280587818970d0) +TEST-TOL1+) - #+(or) (ASSERT-TO-TOLERANCE (LOG-GAMMA-COMPLEX #C(5.0d0 2.0d0)) '(2.7487017561338026749d0 3.0738434100497007915d0) +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-GAMMA-COMPLEX #C(100.0d0 100.0d0)) @@ -105,7 +104,7 @@ (ASSERT-TO-TOLERANCE (TAYLOR-COEFFICIENT 10 500.0d0) 2.6911444554673721340d+20 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (TAYLOR-COEFFICIENT 100 100.0d0) 1.0715102881254669232d+42 +TEST-TOL1+) (ASSERT-TO-TOLERANCE (TAYLOR-COEFFICIENT 1000 200.0d0) 2.6628790558154746898d-267 +TEST-TOL1+) - ;;(ASSERT-TO-TOLERANCE (TAYLOR-COEFFICIENT 1000 500.0d0) 2.3193170139740855074d+131 +TEST-TOL1+) + (ASSERT-TO-TOLERANCE (TAYLOR-COEFFICIENT 1000 500.0d0) 2.3193170139740855074d+131 +TEST-TOL1+) (ASSERT-TO-TOLERANCE (FACTORIAL 0) 1.0d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (FACTORIAL 1) 1.0d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (FACTORIAL 7) 5040.0d0 +TEST-TOL0+) @@ -135,7 +134,7 @@ (ASSERT-TO-TOLERANCE (CHOOSE 500 200) 5.054949849935532221d+144 +TEST-TOL5+) (ASSERT-TO-TOLERANCE (CHOOSE 500 300) 5.054949849935532221d+144 +TEST-TOL5+) (ASSERT-TO-TOLERANCE (LOG-POCHAMMER 5.0d0 0.0d0) 0.0d0 +TEST-TOL0+) - ;;(ASSERT-TO-TOLERANCE (LOG-POCHAMMER 5.0d0 (/ 65536.0d0)) 0.000022981557571259389129d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (LOG-POCHAMMER 5.0d0 (/ 65536.0d0)) 0.000022981557571259389129d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-POCHAMMER 5.0d0 (/ 256.0d0)) 0.005884960217985189004d0 +TEST-TOL2+) (ASSERT-TO-TOLERANCE (LOG-POCHAMMER 7.0d0 3.0d0) 6.222576268071368616d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (LOG-POCHAMMER 5.0d0 2.0d0) 3.401197381662155375d0 +TEST-TOL0+) @@ -157,18 +156,18 @@ (ASSERT-TO-TOLERANCE (RELATIVE-POCHAMMER -5.5d0 (/ -256.0d0)) 1.7678268037726177453d0 +TEST-TOL1+) (ASSERT-TO-TOLERANCE (RELATIVE-POCHAMMER -5.5d0 -11.0d0) 0.09090909090939652475d0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -4.0d0) #.(/ 17160.0d0) +test-tol0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -3.0d0) #.(/ -1320.0d0) +test-tol0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -3.5d0) 0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 4.0d0) 3024.0d0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 3.0d0) -504.0d0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 3.5d0) 0.0d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -4.0d0) #.(/ 17160.0d0) +test-tol0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -3.0d0) #.(/ -1320.0d0) +test-tol0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 -3.5d0) 0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 4.0d0) 3024.0d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 3.0d0) -504.0d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 3.5d0) 0.0d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (POCHAMMER -9.0d0 0.0d0) 1.0d0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 -4.0d0) #.(/ 11880.0d0) +test-tol0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 -3.0d0) #.(/ -990.0d0) +test-tol0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 +4.0d0) 1680.0d0 +TEST-TOL0+) - ;(ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 +3.0d0) -336.0d0 +TEST-TOL0+) - ; input domain error? + (ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 -4.0d0) #.(/ 11880.0d0) +test-tol0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 -3.0d0) #.(/ -990.0d0) +test-tol0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 +4.0d0) 1680.0d0 +TEST-TOL0+) + (ASSERT-TO-TOLERANCE (POCHAMMER -8.0d0 +3.0d0) -336.0d0 +TEST-TOL0+) + ; Input domain error; error in gamma.c at line 769 ;(ASSERT-TO-TOLERANCE (POCHAMMER -3.0d0 +4.0d0) 0.0d0 +TEST-TOL0+) ;(ASSERT-TO-TOLERANCE (POCHAMMER -3.0d0 +3.0d0) -6.0d0 +TEST-TOL2+) ;(ASSERT-TO-TOLERANCE (POCHAMMER -4.0d0 +4.0d0) 24.0d0 +TEST-TOL2+) @@ -178,14 +177,12 @@ +TEST-TOL0+) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 0.001d0 1.0d0) 0.9997803916424144436d0 +TEST-TOL0+) - #+(or) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 0.001d0 10.0d0) 0.9999999958306921828d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 1.0d0 0.001d0) 0.0009995001666250083319d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 1.0d0 1.01d0) 0.6357810204284766802d0 +TEST-TOL0+) - #+(or) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 1.0d0 10.0d0) 0.9999546000702375151d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 10.0d0 10.01d0) 0.5433207586693410570d0 @@ -201,6 +198,7 @@ 0.3898035054195570860969333039d0 +TEST-TOL2+) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 10.0d0 1.0d-16) 2.755731922398588814734648067d-167 +TEST-TOL2+) + ;; Exceeded max number of iterations; error in gamma_inc.c at line 99 #+(or) (ASSERT-TO-TOLERANCE (COMPLEMENTARY-INCOMPLETE-GAMMA 1263131.0d0 1261282.3637d0) 0.04994777516935182963821362168d0 +TEST-TOL4+) @@ -246,7 +244,6 @@ +TEST-TOL0+) (ASSERT-TO-TOLERANCE (NONNORMALIZED-INCOMPLETE-GAMMA -0.5d0 0.001d0) 59.763880515942196981d0 +TEST-TOL0+) - #+(or) (ASSERT-TO-TOLERANCE (NONNORMALIZED-INCOMPLETE-GAMMA -1.0d0 0.001d0) 992.66896046923884234d0 +TEST-TOL0+) (ASSERT-TO-TOLERANCE (NONNORMALIZED-INCOMPLETE-GAMMA -3.5d0 0.001d0) 9.0224404490639003706d+09