Skip to content
Snippets Groups Projects
Commit b88fd1b3 authored by Liam Healy's avatar Liam Healy
Browse files

Tests for exponential functions started

parent 05f0512c
No related branches found
No related tags found
No related merge requests found
;; Exponential functions ;; Exponential functions
;; Liam Healy, Tue Mar 21 2006 - 17:05 ;; Liam Healy, Tue Mar 21 2006 - 17:05
;; Time-stamp: <2009-12-27 10:10:04EST exponential-functions.lisp> ;; Time-stamp: <2010-05-30 12:19:24EDT 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
...@@ -98,8 +98,9 @@ ...@@ -98,8 +98,9 @@
"The product y \exp(x) for the quantities x, y "The product y \exp(x) for the quantities x, y
with associated absolute errors dx, dy.") with associated absolute errors dx, dy.")
(defmfun exp-mult-err-scaled (x y) (defmfun exp-mult-err-scaled (x dx y dy)
"gsl_sf_exp_mult_err_e10_e" ((x :double) (y :double) (ret sf-result-e10)) "gsl_sf_exp_mult_err_e10_e"
((x :double) (dx :double) (y :double) (dy :double) (ret sf-result-e10))
:documentation ; FDL :documentation ; FDL
"The product y \exp(x) for the quantities x, y "The product y \exp(x) for the quantities x, y
with associated absolute errors dx, dy and with with associated absolute errors dx, dy and with
......
;; 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-29 20:58:09EDT augment.lisp> ;; Time-stamp: <2010-05-30 12:42:11EDT 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
...@@ -35,6 +35,7 @@ ...@@ -35,6 +35,7 @@
(defconstant +test-tol4+ (* 16384 +dbl-epsilon+)) (defconstant +test-tol4+ (* 16384 +dbl-epsilon+))
(defconstant +test-tol5+ (* 131072 +dbl-epsilon+)) (defconstant +test-tol5+ (* 131072 +dbl-epsilon+))
(defconstant +test-tol6+ (* 1048576 +dbl-epsilon+)) (defconstant +test-tol6+ (* 1048576 +dbl-epsilon+))
(defconstant +test-sqrt-tol0+ (* 2 +sqrt-dbl-epsilon+))
;;; These are 1.0 if not "RELEASED" ;;; These are 1.0 if not "RELEASED"
(defconstant +test-sigma+ 1.5d0) (defconstant +test-sigma+ 1.5d0)
...@@ -42,7 +43,7 @@ ...@@ -42,7 +43,7 @@
(defun sf-frac-diff (x1 x2) (defun sf-frac-diff (x1 x2)
;; After test_sf_frac_diff in specfunc/test_sf.c. ;; After test_sf_frac_diff in specfunc/test_sf.c.
(cond ((and (zerop x1) (zerop x2)) (cond ((and (zerop x1) (zerop x2))(exp-err-scaled 1.0d0 +test-sqrt-tol0+)
(coerce 0 (type-of x1))) (coerce 0 (type-of x1)))
((zerop x1) ((zerop x1)
(abs x2)) (abs x2))
...@@ -78,6 +79,8 @@ ...@@ -78,6 +79,8 @@
(elt result-list (+ ind (length expected-value))))))) (elt result-list (+ ind (length expected-value)))))))
;; (assert-to-tolerance (tdist-P 0.0d0 1.0d0) 0.5d0 +test-tol6+) ;; (assert-to-tolerance (tdist-P 0.0d0 1.0d0) 0.5d0 +test-tol6+)
;; Probably can remove the binding of lisp-unit:*epsilon*, it doesn't
;; do anything anymore.
(defmacro assert-to-tolerance (form expected-value tolerance) (defmacro assert-to-tolerance (form expected-value tolerance)
`(let ((lisp-unit:*epsilon* ,tolerance)) `(let ((lisp-unit:*epsilon* ,tolerance))
(lisp-unit::assert-true (lisp-unit::assert-true
......
;; Convert the GSL tests ;; Convert the GSL tests
;; Liam Healy 2010-05-22 13:03:53EDT convert.lisp ;; Liam Healy 2010-05-22 13:03:53EDT convert.lisp
;; Time-stamp: <2010-05-27 10:27:14EDT convert.lisp> ;; Time-stamp: <2010-05-30 10:29:38EDT convert.lisp>
;;; This file is not normally loaded; it is only used to convert the ;;; This file is not normally loaded; it is only used to convert the
;;; GSL tests in C to CL tests. It requires cl-ppcre, lisp-util, and iterate. ;;; GSL tests in C to CL tests. It requires cl-ppcre, lisp-util, and iterate.
...@@ -92,7 +92,7 @@ ...@@ -92,7 +92,7 @@
(cl-ppcre:regex-replace "\&r" string "")) (cl-ppcre:regex-replace "\&r" string ""))
(defparameter *gsl-test-form-regex* (defparameter *gsl-test-form-regex*
(cl-ppcre:parse-string "\\s*TEST(_SF|_SF_2)?\\s*\\((.*)\\)\\s*;")) (cl-ppcre::parse-string "\\s*TEST(_SF|_SF_2)?\\s*\\((.*)\\)\\s*;"))
(defun GSL-test-form (string) (defun GSL-test-form (string)
"Replace the full C form with the TEST macro by just the argument." "Replace the full C form with the TEST macro by just the argument."
......
;; 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-22 10:01:27EDT machine.lisp> ;; Time-stamp: <2010-05-30 11:53:31EDT 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
...@@ -31,3 +31,5 @@ ...@@ -31,3 +31,5 @@
(include "gsl/gsl_machine.h") (include "gsl/gsl_machine.h")
(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 (+log-dbl-max+ "7.0978271289338397d+02") :type double-float)
;; Regression test EXPONENTIAL-FUNCTIONS for GSLL, automatically generated ;; Regression test EXPONENTIAL-FUNCTIONS for GSLL
;; ;;
;; Copyright 2009 Liam M. Healy ;; Copyright 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -18,37 +18,107 @@ ...@@ -18,37 +18,107 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST EXPONENTIAL-FUNCTIONS (defconstant +exp-x+ (* 0.8d0 +log-dbl-max+))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (defconstant +ln2+ 0.69314718055994530941723212146d0)
(LIST 20.085536923187668d0 8.91977022163267d-15)
(MULTIPLE-VALUE-LIST (GSL-EXP 3.0d0))) (defmacro assert-sf-scale (form expected-value result-tol err-tol &optional scale)
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL `(lisp-unit::assert-true
(LIST 3.8811801942838993d0 868 3.448904081776264d-12) (multiple-value-bind (val scale err)
(MULTIPLE-VALUE-LIST (EXP-SCALED 2000.0d0))) ,form
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (and
(LIST 3.6535299896840335d44 8.355840218353793d30) (sf-check-pair val ,expected-value ,result-tol err)
(MULTIPLE-VALUE-LIST (EXP-MULT 101.0d0 5.0d0))) (= scale ,scale)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0908344123363103d0 243 5.42628544911082d-13)
(MULTIPLE-VALUE-LIST
(EXP-MULT-SCALED 555.0d0 101.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0000500016667085d-4 4.441114150507224d-20)
(MULTIPLE-VALUE-LIST (EXPM1 1.d-4)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0000500016667084d0 4.4411141505072235d-16)
(MULTIPLE-VALUE-LIST (EXPREL 1.d-4)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0003334166833362d0 4.442372766015162d-16)
(MULTIPLE-VALUE-LIST (EXPREL-2 0.001d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0002500500083344d0 2.665201526164121d-15)
(MULTIPLE-VALUE-LIST (EXPREL-N 3 0.001d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 20.085536923187668d0 0.04017108054156605d0)
(MULTIPLE-VALUE-LIST (EXP-ERR 3.0d0 0.001d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 461.9673492333164d0 0.4820528861567092d0)
(MULTIPLE-VALUE-LIST
(EXP-MULT-ERR 3.0d0 0.001d0 23.0d0 0.001d0))))
;; assert-to-tolerance probably not doing any good here
(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-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-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 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 +exp-x+ 1.00001d0) (* 1.00001d0 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance
(exp-mult +exp-x+ 1.000001d0) (* 1.000001d0 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance
(exp-mult +exp-x+ 1.0000001d0) (* 1.0000001d0 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance
(exp-mult +exp-x+ 100.0d0) (* 100.0d0 (exp +exp-x+)) +test-tol3+)
(assert-to-tolerance
(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)
(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% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment