Commit b88fd1b3 authored by Liam Healy's avatar Liam Healy

Tests for exponential functions started

parent 05f0512c
;; 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
......
;; 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
......
;; 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."
......
;; 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)
;; 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)))))
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