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