Commit 6f686bab authored by Liam Healy's avatar Liam Healy
Browse files

Fix return from #'exp-err-scaled, rename/move test macros

The return value from #'exp-err-scaled should be sf-result-e10, now
fixed.  Test macros renamed, made to match their corresponding GSL
versions better, and moved to augment.lisp.  Some of the GSL
exponential function tests are now ported, and two fail.
parent b88fd1b3
;; Exponential functions ;; Exponential functions
;; Liam Healy, Tue Mar 21 2006 - 17:05 ;; Liam Healy, Tue Mar 21 2006 - 17:05
;; Time-stamp: <2010-05-30 12:19:24EDT exponential-functions.lisp> ;; Time-stamp: <2010-05-31 23:32:15EDT exponential-functions.lisp>
;; ;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -86,7 +86,7 @@ ...@@ -86,7 +86,7 @@
(defmfun exp-err-scaled (x dx) (defmfun exp-err-scaled (x dx)
"gsl_sf_exp_err_e10_e" "gsl_sf_exp_err_e10_e"
((x :double) (dx :double) (ret sf-result)) ((x :double) (dx :double) (ret sf-result-e10))
:documentation ; FDL :documentation ; FDL
"Exponentiate x with an associated absolute error dx "Exponentiate x with an associated absolute error dx
and with extended numeric range.") and with extended numeric range.")
......
;; Additional methods for lisp-unit ;; Additional methods for lisp-unit
;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp ;; Liam Healy 2009-04-15 23:23:30EDT augment.lisp
;; Time-stamp: <2010-05-30 12:42:11EDT augment.lisp> ;; Time-stamp: <2010-05-31 23:29:58EDT augment.lisp>
;; ;;
;; Copyright 2009 Liam M. Healy ;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -53,7 +53,8 @@ ...@@ -53,7 +53,8 @@
(abs (/ (- x1 x2) (+ x1 x2)))) (abs (/ (- x1 x2) (+ x1 x2))))
(t 1.0d0))) (t 1.0d0)))
(defun sf-check-pair (result expected-value tolerance &optional error-estimate) (defun sf-check-single (result expected-value tolerance &optional error-estimate)
"Check the result of a single value as in test_sf_check_result in specfunc/test_sf.c."
(or (eql result expected-value) ; catch expected inifinity/nan (or (eql result expected-value) ; catch expected inifinity/nan
(let ((diff (abs (- result expected-value)))) (let ((diff (abs (- result expected-value))))
(and (and
...@@ -72,7 +73,7 @@ ...@@ -72,7 +73,7 @@
;; Error information is returned ;; Error information is returned
(loop for ind below (length expected-value) (loop for ind below (length expected-value)
always always
(sf-check-pair (sf-check-single
(elt result-list ind) (elt result-list ind)
(elt expected-value ind) (elt expected-value ind)
tolerance tolerance
...@@ -88,6 +89,19 @@ ...@@ -88,6 +89,19 @@
(sf-check-results (sf-check-results
(multiple-value-list ,form) ,expected-value ,tolerance)))) (multiple-value-list ,form) ,expected-value ,tolerance))))
(defmacro assert-sf-scale (form expected-value scale result-tol &optional err-tol)
;; Some of the tests in test_exp like gsl_sf_exp_mult_e10_e(1.0,
;; 1.0, &re) do a check of test_sf_frac_diff, then of the err, then
;; the scale (e10), then they (redundantly?) call test_sf_e10.
;; Others just call test_sf_e10. This attempts to cover both cases.
`(lisp-unit::assert-true
(multiple-value-bind (val scale err)
,form
(and
(sf-check-single val ,expected-value ,result-tol err)
(= scale ,scale)
,(if err-tol `(<= err ,err-tol) t)))))
;; lisp-unit::assert-true ;; lisp-unit::assert-true
(defmacro assert-posinf (form) (defmacro assert-posinf (form)
......
;; Constants specifying limits of floating point calculations in hardware ;; Constants specifying limits of floating point calculations in hardware
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2010-05-30 11:53:31EDT machine.lisp> ;; Time-stamp: <2010-05-31 23:21:42EDT machine.lisp>
;; ;;
;; Copyright 2009 Liam M. Healy ;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -32,4 +32,4 @@ ...@@ -32,4 +32,4 @@
(constant (+dbl-epsilon+ "GSL_DBL_EPSILON") :type double-float) (constant (+dbl-epsilon+ "GSL_DBL_EPSILON") :type double-float)
(constant (+sqrt-dbl-epsilon+ "GSL_SQRT_DBL_EPSILON") :type double-float) (constant (+sqrt-dbl-epsilon+ "GSL_SQRT_DBL_EPSILON") :type double-float)
(constant (+log-dbl-max+ "7.0978271289338397d+02") :type double-float) (constant (+log-dbl-max+ "GSL_LOG_DBL_MAX") :type double-float)
...@@ -21,52 +21,22 @@ ...@@ -21,52 +21,22 @@
(defconstant +exp-x+ (* 0.8d0 +log-dbl-max+)) (defconstant +exp-x+ (* 0.8d0 +log-dbl-max+))
(defconstant +ln2+ 0.69314718055994530941723212146d0) (defconstant +ln2+ 0.69314718055994530941723212146d0)
(defmacro assert-sf-scale (form expected-value result-tol err-tol &optional scale)
`(lisp-unit::assert-true
(multiple-value-bind (val scale err)
,form
(and
(sf-check-pair val ,expected-value ,result-tol err)
(= scale ,scale)))))
;; assert-to-tolerance probably not doing any good here ;; assert-to-tolerance probably not doing any good here
(LISP-UNIT:DEFINE-TEST EXPONENTIAL-FUNCTIONS (lisp-unit:define-test exponential-functions
;; From specfunc/test_sf.c ;; From specfunc/test_sf.c
(assert-to-tolerance (gsl-exp -10.0d0) (exp -10.0d0) +test-tol0+) (assert-to-tolerance (gsl-exp -10.0d0) (exp -10.0d0) +test-tol0+)
(assert-to-tolerance (gsl-exp 10.0d0) (exp 10.0d0) +test-tol0+) (assert-to-tolerance (gsl-exp 10.0d0) (exp 10.0d0) +test-tol0+)
(lisp-unit::assert-true (assert-sf-scale (exp-scaled 1.0d0) (exp 1.0d0) 0 +test-tol0+ +test-tol1+)
(multiple-value-bind (val scale err) (assert-sf-scale (exp-scaled 2000.0d0) 3.88118019428363725d0 868 +test-tol3+ +test-tol5+)
(exp-scaled 1.0d0)
(or
(> (sf-frac-diff val (exp 1.0d0)) +test-tol0+)
(> err +test-tol1+)
(not (zerop scale)))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-scaled 2000.0d0)
(or
(> (sf-frac-diff val 3.88118019428363725d0) +test-tol3+)
(> err +test-tol5+)
(not (= scale 868)))))
(assert-to-tolerance (exp-err -10.0d0 +test-tol1+) (exp -10.0d0) +test-tol1+) (assert-to-tolerance (exp-err -10.0d0 +test-tol1+) (exp -10.0d0) +test-tol1+)
(assert-to-tolerance (exp-err 10.0d0 +test-tol1+) (exp 10.0d0) +test-tol1+) (assert-to-tolerance (exp-err 10.0d0 +test-tol1+) (exp 10.0d0) +test-tol1+)
(lisp-unit::assert-true (assert-sf-scale
(multiple-value-bind (val scale err) (exp-err-scaled 1.0d0 +test-sqrt-tol0+) (exp 1.0d0) 0 +test-tol1+ (* 32 +test-tol0+))
(exp-err-scaled 1.0d0 +test-sqrt-tol0+) (assert-sf-scale
(or (exp-err-scaled 2000.0d0 1.0d-10) 3.88118019428363725d0 868 +test-tol3+ 1.0d-7)
(> (sf-frac-diff val (exp 1.0d0)) +test-tol1+)
(> err (* 32 +test-tol0+))
(not (zerop scale)))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-err-scaled 2000.0d0 1.0d-10)
(or
(> (sf-frac-diff val 3.88118019428363725d0) +test-tol3+)
(> err 1.0d-7)
(not (= scale 868)))))
(assert-to-tolerance (exp-mult -10.0d0 1.0d-06) (* 1.0d-06 (exp -10.0d0)) +test-tol0+) (assert-to-tolerance (exp-mult -10.0d0 1.0d-06) (* 1.0d-06 (exp -10.0d0)) +test-tol0+)
(assert-to-tolerance (exp-mult -10.0d0 2.0d) (* 2.0d0 (exp -10.0d0)) +test-tol0+) (assert-to-tolerance (exp-mult -10.0d0 2.0d0) (* 2.0d0 (exp -10.0d0)) +test-tol0+)
(assert-to-tolerance (exp-mult -10.0d0 -2.0d) (* -2.0d0 (exp -10.0d0)) +test-tol0+) (assert-to-tolerance (exp-mult -10.0d0 -2.0d0) (* -2.0d0 (exp -10.0d0)) +test-tol0+)
(assert-to-tolerance (exp-mult 10.0d0 1.0d-06) (* 1.0d-06 (exp 10.0d0)) +test-tol0+) (assert-to-tolerance (exp-mult 10.0d0 1.0d-06) (* 1.0d-06 (exp 10.0d0)) +test-tol0+)
(assert-to-tolerance (exp-mult 10.0d0 -2.0d0) (* -2.0d0 (exp 10.0d0)) +test-tol0+) (assert-to-tolerance (exp-mult 10.0d0 -2.0d0) (* -2.0d0 (exp 10.0d0)) +test-tol0+)
(assert-to-tolerance (assert-to-tolerance
...@@ -81,44 +51,19 @@ ...@@ -81,44 +51,19 @@
(exp-mult +exp-x+ 1.0d20) (* 1.0d20 (exp +exp-x+)) +test-tol3+) (exp-mult +exp-x+ 1.0d20) (* 1.0d20 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance (assert-to-tolerance
(exp-mult +exp-x+ (* +exp-x+ (exp +ln2+))) 2.0d0 +test-tol4+) (exp-mult +exp-x+ (* +exp-x+ (exp +ln2+))) 2.0d0 +test-tol4+)
(lisp-unit::assert-true (assert-sf-scale
(multiple-value-bind (val scale err) (exp-mult-scaled 1.0d0 1.0d0) (exp 1.0d0) 0 +test-tol0+ +test-tol2+)
(exp-mult-scaled 1.0d0 1.0d0) (assert-sf-scale
(or (exp-mult-scaled 1000.0d0 1.0d200) 1.970071114017046993888879352d0
(> (sf-frac-diff val (exp 1.0d0)) +test-tol0+) 634 +test-tol3+ 1.0d-11)
(> err +test-tol2+) (assert-sf-scale
(not (zerop scale))))) (exp-mult-err-scaled 1.0d0 +test-tol0+ 1.0d0 +test-tol0+)
(lisp-unit::assert-true 0 (exp 1.0d0) +test-tol0+ +test-tol2+)
(multiple-value-bind (val scale err) (assert-sf-scale
(exp-mult-scaled 1000.0d0 1.0d200) (exp-mult-err-scaled 1000.0d0 1.0d-12 1.0d200 1.0d190) 1.9700711140165661d0
(or 634 +test-tol3+ 1.0d-9)
(> (sf-frac-diff val 1.970071114017046993888879352d0) +test-tol3+) (assert-sf-scale
(> err 1.0d-11) (exp-mult-scaled 10000.0d0 1.0d0) 8.806818225662921587261496007d0 4342 +test-tol5+)
(not (= scale 634))))) (assert-sf-scale
(lisp-unit::assert-true (exp-mult-scaled 100.0d0 1.0d0) 2.688117141816135448412625551d43 0 +test-tol2+))
(multiple-value-bind (val scale err)
(exp-mult-err-scaled 1.0d0 +test-tol0+ 1.0d0 +test-tol0+)
(or
(> (sf-frac-diff val (exp 1.0d0)) +test-tol0+)
(> err +test-tol2+)
(not (zerop scale)))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-mult-err-scaled 1000.0d0 1.0d-12 1.0d200 1.0d190)
(or
(> (sf-frac-diff val 1.9700711140165661d0) +test-tol3+)
(> err 1.0d-9)
(not (= scale 634)))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-mult-scaled 10000.0d0 1.0d0)
(and
(sf-check-pair val 8.806818225662921587261496007d0 +test-tol5+ err)
(= scale 4342))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-mult-scaled 100.0d0 1.0d0)
(and
(sf-check-pair val 2.688117141816135448412625551d43 +test-tol2+ err)
(zerop scale)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment