[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-20-g9918ab2
Raymond Toy
rtoy at common-lisp.net
Tue Nov 25 17:35:48 UTC 2014
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 9918ab2d5794ac01efe17b808b351e25519dc88a (commit)
via d46a4bfeff75f685f2ccc4a2627a921e46547c1c (commit)
via 8e0c67d0c74e1dd5206d2b068734d863440ca286 (commit)
from 4d3255aa1a770f59d2851fd2c85707164ca485f5 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9918ab2d5794ac01efe17b808b351e25519dc88a
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Nov 25 09:35:38 2014 -0800
* Add tests for dd-%log2 and dd-%log10.
* Fix the log10.result-types test because we return correctly rounded
results for these few tests.
diff --git a/tests/irrat.lisp b/tests/irrat.lisp
index f1913d3..9538394 100644
--- a/tests/irrat.lisp
+++ b/tests/irrat.lisp
@@ -5,9 +5,13 @@
(in-package "IRRAT-TESTS")
+(defun relerr (actual expected)
+ (/ (abs (- actual expected))
+ expected))
+
;; This tests that log base 2 returns the correct value and the
;; correct type.
-(define-test log2
+(define-test log2.result-types
(dolist (number '(4 4f0 4d0 #+double-double 4w0))
(dolist (base '(2 2f0 2d0 #+double-double 2w0))
;; This tests that log returns the correct value and the correct type.
@@ -35,54 +39,84 @@
;; This tests that log base 10 returns the correct value and the
;; correct type.
-(define-test log10
+(define-test log10.result-types
(dolist (number '(100 100f0 100d0 #+double-double 100w0))
(dolist (base '(10 10f0 10d0 #+double-double 10w0))
;; This tests that log returns the correct value and the correct type.
(let* ((result (log number base))
- (relerr (/ (abs (- result 2)) 2)))
- ;; Figure out the expected type of the result and the maximum
- ;; allowed relative error. It turns out that for these test
- ;; cases, the result is exactly 2 except when the result type
- ;; is a double-double-float. In that case, there is a slight
- ;; error for (log 100w0 10).
- (multiple-value-bind (true-type allowed-error)
- (etypecase number
- ((or integer single-float)
- (etypecase base
+ (true-type
+ (etypecase number
((or integer single-float)
- (values 'single-float 0))
+ (etypecase base
+ ((or integer single-float)
+ 'single-float)
+ (double-float
+ 'double-float)
+ #+double-double
+ (ext:double-double-float
+ 'ext:double-double-float)))
(double-float
- (values 'double-float 0))
- #+double-double
- (ext:double-double-float
- (values 'ext:double-double-float
- 7.5d-33))))
- (double-float
- (etypecase base
- ((or integer single-float double-float)
- (values 'double-float 0))
+ (etypecase base
+ ((or integer single-float double-float)
+ 'double-float)
+ #+double-double
+ (ext:double-double-float
+ 'ext:double-double-float)))
#+double-double
(ext:double-double-float
- (values 'ext:double-double-float
- 7.5d-33))))
- #+double-double
- (ext:double-double-float
- (values 'ext:double-double-float
- 7.5d-33)))
- (assert-true (<= relerr allowed-error)
- number base result relerr allowed-error)
- (assert-true (typep result true-type)
- number baes result true-type))))))
+ 'ext:double-double-float))))
+ (assert-equalp 2 result
+ number base result)
+ (assert-true (typep result true-type)
+ number base result true-type)))))
-(define-test dd-log2
+(define-test dd-log2.special-cases
;; Verify that for x = 10^k for k = 1 to 300 that (kernel::dd-%log2
;; x) is close to the expected value. Previously, a bug caused
;; (kernel::dd-%log2 100w0) to give 6.1699... instead of 6.64385.
(loop for k from 1 below 300
- and x = (expt 10 k)
- and y = (kernel::dd-%log2 (float x 1w0))
- and z = (/ (log (float x 1d0)) (log 2d0))
- and e = (/ (abs (- y z)) z)
+ for x = (expt 10 k)
+ for y = (kernel::dd-%log2 (float x 1w0))
+ for z = (/ (log (float x 1d0)) (log 2d0))
+ for e = (/ (abs (- y z)) z)
do (assert-true (<= e 2d-16)
- k y z e)))
\ No newline at end of file
+ k y z e))
+ (let ((y (kernel::dd-%log2 (sqrt 2w0))))
+ (assert-true (<= (relerr y 1/2)
+ (* 2.7 (scale-float 1d0 (- (float-digits 1w0)))))
+ y))
+ (let ((y (kernel::dd-%log2 (sqrt 0.5w0))))
+ (assert-true (<= (relerr y -1/2)
+ (* 2.7 (scale-float 1d0 (- (float-digits 1w0)))))
+ y)))
+
+(define-test dd-log2.powers-of-2
+ (loop for k from -1074 below 1024
+ for x = (scale-float 1w0 k)
+ for y = (kernel::dd-%log2 x)
+ do (assert-equalp k y
+ k x y)))
+
+(define-test dd-log10.special-cases
+ (let ((y (kernel::dd-%log10 (sqrt 10w0))))
+ (assert-true (<= (relerr y 1/2)
+ (* 0.25 (scale-float 1d0 (- (float-digits 1w0))))))))
+
+(define-test dd-log10.powers-of-ten
+ ;; It would be nice if dd-%log10 produce the exact result for powers
+ ;; of ten, but we currently don't. But note that the maximum
+ ;; relative error is less than a double-double epsilon.
+ (let ((threshold (* 0.109 (scale-float 1d0 (- (float-digits 1w0))))))
+ (loop for k from -323 below 0
+ for x = (expt 10 k)
+ for y = (kernel::dd-%log10 (float x 1w0))
+ for e = (relerr y k)
+ do (assert-true (<= e threshold)
+ k e x y))
+ (loop for k from 1 to 308
+ for x = (expt 10 k)
+ for y = (kernel::dd-%log10 (float x 1w0))
+ for e = (relerr y k)
+ do (assert-true (<= e threshold)
+ k e x y))))
+
commit d46a4bfeff75f685f2ccc4a2627a921e46547c1c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Nov 25 09:33:58 2014 -0800
Use log2 and log10 functions when possible instead of using the
general case.
diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index fa89142..1179515 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -653,31 +653,35 @@
((and (realp number) (realp base))
(cond
((and (= base 2)
- (floatp number)
- #+double-double
- (not (typep number 'ext:double-double-float))
+ ;;(floatp number)
(or (plusp number)
(eql number 0.0)
- (eql number 0d0)))
- ;; Do the same thing as the deftranform does for
- ;; log base 2 and 10 for non-negative arguments.
+ (eql number 0d0)
+ #+double-double
+ (eql number 0w0)))
+ ;; Do the same thing as the deftranform does for log
+ ;; base 2 and 10 for non-negative arguments: handle
+ ;; the case where number > 0 or equal to +0.
(number-dispatch ((number real) (base real))
((double-float
- (foreach integer single-float double-float))
+ (foreach integer ratio single-float double-float))
(log2 number))
- ((single-float
- (foreach integer single-float))
+ (((foreach integer ratio single-float)
+ (foreach integer ratio single-float))
(float (log2 (float number 1d0)) 1f0))
- ((single-float double-float)
+ (((foreach integer ratio single-float)
+ double-float)
(log2 (float number 1d0)))
#+double-double
- (((foreach integer single-float double-float)
- ext:double-double-float)
- (log2 (float number 1w0) base))))
+ (((foreach integer ratio single-float double-float)
+ double-double-float)
+ (dd-%log2 (float number 1w0)))
+ #+double-double
+ ((double-double-float
+ (foreach integer ratio single-float double-float double-double-float))
+ (dd-%log2 number))))
((and (= base 10)
- (floatp number)
- #+double-double
- (not (typep number 'double-double-float))
+ ;;(floatp number)
(or (plusp number)
(eql number 0.0)
(eql number 0d0)))
@@ -685,19 +689,22 @@
;; log base 2 and 10 for non-negative arguments.
(number-dispatch ((number real) (base real))
((double-float
- (foreach double-float single-float integer))
+ (foreach rational single-float double-float))
(%log10 number))
- ((single-float
- (foreach single-float integer))
+ (((foreach integer ratio single-float)
+ (foreach integer ratio single-float))
(float (%log10 (float number 1d0)) 1f0))
- ((single-float double-float)
+ (((foreach integer ratio single-float)
+ double-float)
(%log10 (float number 1d0)))
#+double-double
- (((foreach integer single-float double-float)
+ (((foreach integer ratio single-float double-float)
ext:double-double-float)
- ;; This could be more accurate!
- (/ (log (float number 1w0))
- (log 10w0)))))
+ (dd-%log10 (float number 1w0)))
+ #+double-double
+ ((double-double-float
+ (foreach integer ratio single-float double-float double-double-float))
+ (dd-%log10 number))))
(t
;; CLHS 12.1.4.1 says
;;
commit 8e0c67d0c74e1dd5206d2b068734d863440ca286
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Nov 25 09:32:32 2014 -0800
Return -infinity for %log2 and %log10 of +0.
diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp
index d0acdd7..36051fc 100644
--- a/src/code/irrat-dd.lisp
+++ b/src/code/irrat-dd.lisp
@@ -1379,6 +1379,9 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(declare (type double-double-float x)
(optimize (speed 3) (space 0)
(inhibit-warnings 3)))
+ (when (eql x 0w0)
+ ;; log2(+0) = -infinity
+ (return-from dd-%log2 (/ -1 x)))
(multiple-value-bind (e x y z)
(compute-log x)
;; Multiply log of fraction by log2(e) and base 2 exponent by 1
@@ -1395,6 +1398,9 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(declare (type double-double-float x)
(optimize (speed 3) (space 0)
(inhibit-warnings 3)))
+ (when (eql x 0w0)
+ ;; log2(+0) = -infinity
+ (return-from dd-%log10 (/ -1 x)))
(multiple-value-bind (e x y z)
(compute-log x)
;; Multiply log of fraction by log10(e) and base 2 exponent by log10(2).
-----------------------------------------------------------------------
Summary of changes:
src/code/irrat-dd.lisp | 6 +++
src/code/irrat.lisp | 55 ++++++++++++++-----------
tests/irrat.lisp | 110 ++++++++++++++++++++++++++++++++-----------------
3 files changed, 109 insertions(+), 62 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list