From b88fd1b39377c8e99902c3f73a8e72001097a7b4 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 30 May 2010 16:10:58 -0400 Subject: [PATCH] Tests for exponential functions started --- special-functions/exponential-functions.lisp | 7 +- test-unit/augment.lisp | 7 +- test-unit/convert.lisp | 4 +- test-unit/machine.lisp | 4 +- tests/exponential-functions.lisp | 140 ++++++++++++++----- 5 files changed, 119 insertions(+), 43 deletions(-) diff --git a/special-functions/exponential-functions.lisp b/special-functions/exponential-functions.lisp index 9979d708..5116fc1a 100644 --- a/special-functions/exponential-functions.lisp +++ b/special-functions/exponential-functions.lisp @@ -1,6 +1,6 @@ ;; Exponential functions ;; 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 ;; Distributed under the terms of the GNU General Public License @@ -98,8 +98,9 @@ "The product y \exp(x) for the quantities x, y with associated absolute errors dx, dy.") -(defmfun exp-mult-err-scaled (x y) - "gsl_sf_exp_mult_err_e10_e" ((x :double) (y :double) (ret sf-result-e10)) +(defmfun exp-mult-err-scaled (x dx y dy) + "gsl_sf_exp_mult_err_e10_e" + ((x :double) (dx :double) (y :double) (dy :double) (ret sf-result-e10)) :documentation ; FDL "The product y \exp(x) for the quantities x, y with associated absolute errors dx, dy and with diff --git a/test-unit/augment.lisp b/test-unit/augment.lisp index d36748f5..45342119 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-29 20:58:09EDT augment.lisp> +;; Time-stamp: <2010-05-30 12:42:11EDT augment.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -35,6 +35,7 @@ (defconstant +test-tol4+ (* 16384 +dbl-epsilon+)) (defconstant +test-tol5+ (* 131072 +dbl-epsilon+)) (defconstant +test-tol6+ (* 1048576 +dbl-epsilon+)) +(defconstant +test-sqrt-tol0+ (* 2 +sqrt-dbl-epsilon+)) ;;; These are 1.0 if not "RELEASED" (defconstant +test-sigma+ 1.5d0) @@ -42,7 +43,7 @@ (defun sf-frac-diff (x1 x2) ;; 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))) ((zerop x1) (abs x2)) @@ -78,6 +79,8 @@ (elt result-list (+ ind (length expected-value))))))) ;; (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) `(let ((lisp-unit:*epsilon* ,tolerance)) (lisp-unit::assert-true diff --git a/test-unit/convert.lisp b/test-unit/convert.lisp index 30ec082a..6c2f5995 100644 --- a/test-unit/convert.lisp +++ b/test-unit/convert.lisp @@ -1,6 +1,6 @@ ;; Convert the GSL tests ;; 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 ;;; GSL tests in C to CL tests. It requires cl-ppcre, lisp-util, and iterate. @@ -92,7 +92,7 @@ (cl-ppcre:regex-replace "\&r" string "")) (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) "Replace the full C form with the TEST macro by just the argument." diff --git a/test-unit/machine.lisp b/test-unit/machine.lisp index 29cbc770..c1628ed8 100644 --- a/test-unit/machine.lisp +++ b/test-unit/machine.lisp @@ -1,6 +1,6 @@ ;; Constants specifying limits of floating point calculations in hardware ;; 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 ;; Distributed under the terms of the GNU General Public License @@ -31,3 +31,5 @@ (include "gsl/gsl_machine.h") (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) diff --git a/tests/exponential-functions.lisp b/tests/exponential-functions.lisp index c474986b..bae8322a 100644 --- a/tests/exponential-functions.lisp +++ b/tests/exponential-functions.lisp @@ -1,6 +1,6 @@ -;; 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 ;; ;; This program is free software: you can redistribute it and/or modify @@ -18,37 +18,107 @@ (in-package :gsl) -(LISP-UNIT:DEFINE-TEST EXPONENTIAL-FUNCTIONS - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST 20.085536923187668d0 8.91977022163267d-15) - (MULTIPLE-VALUE-LIST (GSL-EXP 3.0d0))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST 3.8811801942838993d0 868 3.448904081776264d-12) - (MULTIPLE-VALUE-LIST (EXP-SCALED 2000.0d0))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST 3.6535299896840335d44 8.355840218353793d30) - (MULTIPLE-VALUE-LIST (EXP-MULT 101.0d0 5.0d0))) - (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)))) +(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 + ;; 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))))) + -- GitLab