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
;; 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
;; Distributed under the terms of the GNU General Public License
......@@ -86,7 +86,7 @@
(defmfun exp-err-scaled (x dx)
"gsl_sf_exp_err_e10_e"
((x :double) (dx :double) (ret sf-result))
((x :double) (dx :double) (ret sf-result-e10))
:documentation ; FDL
"Exponentiate x with an associated absolute error dx
and with extended numeric range.")
......
;; Additional methods for lisp-unit
;; 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
;; Distributed under the terms of the GNU General Public License
......@@ -53,7 +53,8 @@
(abs (/ (- x1 x2) (+ x1 x2))))
(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
(let ((diff (abs (- result expected-value))))
(and
......@@ -72,7 +73,7 @@
;; Error information is returned
(loop for ind below (length expected-value)
always
(sf-check-pair
(sf-check-single
(elt result-list ind)
(elt expected-value ind)
tolerance
......@@ -88,6 +89,19 @@
(sf-check-results
(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
(defmacro assert-posinf (form)
......
;; Constants specifying limits of floating point calculations in hardware
;; 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
;; Distributed under the terms of the GNU General Public License
......@@ -32,4 +32,4 @@
(constant (+dbl-epsilon+ "GSL_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 @@
(defconstant +exp-x+ (* 0.8d0 +log-dbl-max+))
(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
(LISP-UNIT:DEFINE-TEST EXPONENTIAL-FUNCTIONS
(lisp-unit:define-test exponential-functions
;; 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+)
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(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-sf-scale (exp-scaled 1.0d0) (exp 1.0d0) 0 +test-tol0+ +test-tol1+)
(assert-sf-scale (exp-scaled 2000.0d0) 3.88118019428363725d0 868 +test-tol3+ +test-tol5+)
(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
(multiple-value-bind (val scale err)
(exp-err-scaled 1.0d0 +test-sqrt-tol0+)
(or
(> (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-sf-scale
(exp-err-scaled 1.0d0 +test-sqrt-tol0+) (exp 1.0d0) 0 +test-tol1+ (* 32 +test-tol0+))
(assert-sf-scale
(exp-err-scaled 2000.0d0 1.0d-10) 3.88118019428363725d0 868 +test-tol3+ 1.0d-7)
(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.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.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 -2.0d0) (* -2.0d0 (exp 10.0d0)) +test-tol0+)
(assert-to-tolerance
......@@ -81,44 +51,19 @@
(exp-mult +exp-x+ 1.0d20) (* 1.0d20 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance
(exp-mult +exp-x+ (* +exp-x+ (exp +ln2+))) 2.0d0 +test-tol4+)
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(exp-mult-scaled 1.0d0 1.0d0)
(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-scaled 1000.0d0 1.0d200)
(or
(> (sf-frac-diff val 1.970071114017046993888879352d0) +test-tol3+)
(> err 1.0d-11)
(not (= scale 634)))))
(lisp-unit::assert-true
(multiple-value-bind (val scale err)
(assert-sf-scale
(exp-mult-scaled 1.0d0 1.0d0) (exp 1.0d0) 0 +test-tol0+ +test-tol2+)
(assert-sf-scale
(exp-mult-scaled 1000.0d0 1.0d200) 1.970071114017046993888879352d0
634 +test-tol3+ 1.0d-11)
(assert-sf-scale
(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)))))
0 (exp 1.0d0) +test-tol0+ +test-tol2+)
(assert-sf-scale
(exp-mult-err-scaled 1000.0d0 1.0d-12 1.0d200 1.0d190) 1.9700711140165661d0
634 +test-tol3+ 1.0d-9)
(assert-sf-scale
(exp-mult-scaled 10000.0d0 1.0d0) 8.806818225662921587261496007d0 4342 +test-tol5+)
(assert-sf-scale
(exp-mult-scaled 100.0d0 1.0d0) 2.688117141816135448412625551d43 0 +test-tol2+))
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