[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2013-12-a-42-g894af6c
Raymond Toy
rtoy at common-lisp.net
Mon Dec 23 18:40:22 UTC 2013
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 894af6c4aaa3b83f3c13d2e59735c33f79abdc20 (commit)
via 15d3bbe341280c08855d07dc6664c0fd17b27636 (commit)
via e5bfd82b999468624a09dad92189843f08eac5b2 (commit)
from f849f4dba02f2b41d78ffe21d43be5b184aa7cdf (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 894af6c4aaa3b83f3c13d2e59735c33f79abdc20
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Mon Dec 23 10:40:03 2013 -0800
Add tests for the branch cut for atanh. Not clear that this is
correct because atanh(-2) appears to be wrong.
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 9565ef5..05437e5 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -725,3 +725,66 @@
(get-signs (acosh-def #c(0.25d0 -1d-20)))
(assert-true (check-signs #'acosh #c(0.25d0 -0d0) tr ti))
(assert-true (check-signs #'acosh #c(0.25w0 -0w0) tr ti))))
+
+;; atanh(z) = 1/2*(log(1+z) - log(1-z))
+;;
+;; The branch cut is on the real axis for |x| > 1. For x < -1, it is
+;; continuous with Quadrant III. For x > 1, it is continuous with
+;; quadrant I.
+;;
+;; NOTE: The rules above are what is given by the CLHS. However,
+;; consider the value of atanh(-2) and atanh(-2-0.0*i)
+;;
+;; atanh(-2) = 1/2*(log(1-2) - log(1+2))
+;; = 1/2*(log(-1) - log(3))
+;; = 1/2*(i*pi - log(3))
+;; = -1/2*log(3) + i*pi/2
+;;
+;; atanh(-2-0*i) = 1/2*(log(1+(-2-0*i)) - log(1-(-2-0*i)))
+;; = 1/2*(log(-1-0*i) - log(3-0*i))
+;; = 1/2*(-i*pi - log(3))
+;; = -1/2*log(3) - i*pi/2
+;;
+;; atanh(-2+0*i) = 1/2*(log(1+(-2+0*i)) - log(1-(-2+0*i)))
+;; = 1/2*(log(-1+0*i) - log(3-0*i))
+;; = 1/2*(i*pi - log(3))
+;; = -1/2*log(3) + i*pi/2
+;;
+;; Thus, atanh(-2) is continuous with Quadrant II, NOT continuous with
+;; Quadrant III!
+;;
+;; What do we do?
+(defun atanh-def (z)
+ (r*z 1/2
+ (- (log (1+z z))
+ (log (1-z z)))))
+
+(define-test branch-cut.atanh
+ (:tag :atanh :branch-cuts)
+ ;; Test for x < -1, which is continuous with Quadrant III. Use the
+ ;; the value at #c(-2d0 -1d-20) as the reference.
+ (multiple-value-bind (tr ti)
+ (get-signs (atanh-def #c(-2d0 -1d-20)))
+ (assert-true (check-signs #'atanh -2d0 tr ti))
+ (assert-true (check-signs #'atanh -2w0 tr ti))
+ (assert-true (check-signs #'atanh #c(-2d0 -0d0) tr ti))
+ (assert-true (check-signs #'atanh #c(-2w0 -0w0) tr ti)))
+ ;; Test the other side of the branch cut for x < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (atanh-def #c(-2d0 +1d-20)))
+ (assert-true (check-signs #'atanh #c(-2d0 0d0) tr ti))
+ (assert-true (check-signs #'atanh #c(-2w0 0w0) tr ti)))
+
+ ;; Test for x > 1, which is continuous with Quadrant I, using the
+ ;; value at #c(+2d0 1d-10) as the reference
+ (multiple-value-bind (tr ti)
+ (get-signs (atanh-def #c(2d0 1d-20)))
+ (assert-true (check-signs #'atanh 2d0 tr ti))
+ (assert-true (check-signs #'atanh 2w0 tr ti))
+ (assert-true (check-signs #'atanh #c(2d0 0) tr ti))
+ (assert-true (check-signs #'atanh #c(2w0 0) tr ti)))
+ ;; Test the other side of the branch cut for x > 1.
+ (multiple-value-bind (tr ti)
+ (get-signs (atanh-def #c(2d0 -1d-20)))
+ (assert-true (check-signs #'atanh #c(2d0 -0d0) tr ti))
+ (assert-true (check-signs #'atanh #c(2w0 -0w0) tr ti))))
commit 15d3bbe341280c08855d07dc6664c0fd17b27636
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Mon Dec 23 08:36:22 2013 -0800
Add tests for the branch cuts for asinh and acosh, and some fixes.
o Add function R-Z to compute r - z carefully. (For definition of
acos)
o Add function R*Z to compute r*z carefully, For acos and acosh.
o Add tests for asinh and acosh.
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 011aeaf..9565ef5 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -468,6 +468,13 @@
(complex (- 1 (realpart z)) (- (imagpart z)))
(- 1 z)))
+(defun z-1 (z)
+ (if (complexp z)
+ (complex (- (realpart z) 1)
+ (imagpart z))
+ (- z 1)))
+
+
;; Carefully compute 1+z. For z = x + i*y, we want 1+x + i*y, which
;; only really matters when y is a signed zero.
(defun 1+z (z)
@@ -475,12 +482,24 @@
(complex (+ 1 (realpart z)) (imagpart z))
(+ 1 z)))
+(defun r-z (r z)
+ (if (complexp z)
+ (complex (- r (realpart z))
+ (- (imagpart z)))
+ (- r z)))
+
;; Carefully compute i*z = i*(x+i*y) = -y + i*x.
(defun i*z (z)
(if (complexp z)
(complex (- (imagpart z)) (realpart z))
(complex 0 z)))
+;; Carefully compute r*z, where r is a real value and z is complex.
+(defun r*z (r z)
+ (if (complexp z)
+ (complex (* r (realpart z)) (* r (imagpart z)))
+ (* r z)))
+
;; asin(x) = -i*log(i*x + sqrt(1-x^2))
;;
;; The branch cut is the real axis |x| > 1. For x < -1, it is
@@ -529,10 +548,10 @@
;; continous with Quadrant II; for x > 1, Quadrant IV.
(defun acos-def (z)
(if (typep z 'kernel:double-double-float)
- (- (/ kernel:dd-pi 2)
- (asin-def z))
- (- (/ pi 2)
- (asin-def z))))
+ (r-z (/ kernel:dd-pi 2)
+ (asin-def z))
+ (r-z (/ pi 2)
+ (asin-def z))))
(define-test branch-cut.acos
(:tag :acos :branch-cuts)
@@ -601,7 +620,7 @@
(let* ((iz (i*z z))
(w (- (log (1+z iz))
(log (1-z iz)))))
- (* -1/2 (i*z w))))
+ (r*z -1/2 (i*z w))))
(define-test branch-cut.atan
(:tag :atan :branch-cuts)
@@ -628,3 +647,81 @@
(get-signs (atan-def #c(1d-20 2d0)))
(assert-true (check-signs #'atan #c(0d0 2d0) tr ti))
(assert-true (check-signs #'atan #c(0d0 2w0) tr ti))))
+
+;; asinh(z) = log(z + sqrt(1+z^2))
+;;
+;; The branch cut is the imaginary axis with |y| > 1. For y > 1, asinh
+;; is continuous with Quadrant I. For y < -1, it is continuous with
+;; Quadrant III.
+
+(defun asinh-def (z)
+ (log (+ z (sqrt (1+z (* z z))))))
+
+(define-test branch-cut.asinh
+ (:tag :asinh :branch-cuts)
+ ;; Test for y < -1, which is continuous with Quadrant I. Use the
+ ;; value at #c(1d-20 -2d0) as the reference.
+ (multiple-value-bind (tr ti)
+ (get-signs (asinh-def #c(1d-20 -2d0)))
+ (assert-true (check-signs #'asinh #c(0d0 -2d0) tr ti))
+ (assert-true (check-signs #'asinh #c(0w0 -2w0) tr ti)))
+ ;; Test the other side of the branch cut for y < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (asinh-def #c(-1d-20 -2d0)))
+ (assert-true (check-signs #'asinh #c(-0d0 -2d0) tr ti))
+ (assert-true (check-signs #'asinh #c(-0w0 -2w0) tr ti)))
+
+ ;; Test for y > 1, which is continuous with Quadrant III, using the
+ ;; value at #c(-1d-20 +2d0) as the reference
+ (multiple-value-bind (tr ti)
+ (get-signs (asinh-def #c(-1d-20 2d0)))
+ (assert-true (check-signs #'asinh #c(-0d0 2d0) tr ti))
+ (assert-true (check-signs #'asinh #c(-0w0 2w0) tr ti)))
+ ;; Test the other side of the branch cut for x > 1.
+ (multiple-value-bind (tr ti)
+ (get-signs (asinh-def #c(1d-20 2d0)))
+ (assert-true (check-signs #'asinh #c(0d0 2d0) tr ti))
+ (assert-true (check-signs #'asinh #c(0d0 2w0) tr ti))))
+
+;; acosh(z) = 2*log(sqrt((z+1)/2) + sqrt((z-1)/2))
+;;
+;; The branch cut is along the real axis with x < 1. For x < 0, it is
+;; continuous with Quadrant II. For 0< x < 1, it is continuous with
+;; Quadrant I.
+
+(defun acosh-def (z)
+ (r*z 2
+ (log (+ (sqrt (r*z 1/2 (1+z z)))
+ (sqrt (r*z 1/2 (z-1 z)))))))
+
+
+(define-test branch-cut.acosh
+ (:tag :acosh :branch-cuts)
+ ;; Test for x < 0, which is continuous with Quadrant II. Use the
+ ;; value at #c(-2d0 1d-20) as a reference.
+ (multiple-value-bind (tr ti)
+ (get-signs (acosh-def #c(-2d0 1d-20)))
+ (assert-true (check-signs #'acosh -2d0 tr ti))
+ ;;(assert-true (check-signs #'acosh -2w0 tr ti))
+ (assert-true (check-signs #'acosh #c(-2d0 0) tr ti))
+ ;;(assert-true (check-signs #'acosh #c(-2w0 0) tr ti))
+ )
+ ;; Test the other side of the branch cut for x < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (acosh-def #c(-2d0 -1d-20)))
+ (assert-true (check-signs #'acosh #c(-2d0 -0d0) tr ti))
+ ;;(assert-true (check-signs #'acosh #c(-2w0 -0w0) tr ti))
+ )
+
+ ;; Test for 0 < x < 1, which is continuous with Quadrant I, using the
+ ;; value at #c(0.25d0 1d-10) as the reference.
+ (multiple-value-bind (tr ti)
+ (get-signs (acosh-def #c(0.25d0 1d-20)))
+ (assert-true (check-signs #'acosh #c(0.25d0 0) tr ti))
+ (assert-true (check-signs #'acosh #c(0.25w0 0) tr ti))
+ )
+ ;; Test the other side of the branch cut for 0 < x < 1.
+ (multiple-value-bind (tr ti)
+ (get-signs (acosh-def #c(0.25d0 -1d-20)))
+ (assert-true (check-signs #'acosh #c(0.25d0 -0d0) tr ti))
+ (assert-true (check-signs #'acosh #c(0.25w0 -0w0) tr ti))))
commit e5bfd82b999468624a09dad92189843f08eac5b2
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Mon Dec 23 00:16:43 2013 -0800
Float printer tests from reading the logs for print.lisp.
diff --git a/tests/printer.lisp b/tests/printer.lisp
new file mode 100644
index 0000000..b511f0b
--- /dev/null
+++ b/tests/printer.lisp
@@ -0,0 +1,113 @@
+(defpackage :printer-tests
+ (:use :cl :lisp-unit))
+
+(in-package "PRINTER-TESTS")
+
+(define-test format.float.1
+ (assert-equal ".0000"
+ (format nil "~5F" 1d-10))
+ (assert-equal "0.000"
+ (format nil "~,3F" 0.000001)))
+
+(define-test format.float.2
+ (assert-equal " 0.990E+00" (format nil "~11,3,2,0,'*,,'EE" .99))
+ (assert-equal " 0.999E+00" (format nil "~11,3,2,0,'*,,'EE" .999))
+ (assert-equal " 0.100E+01" (format nil "~11,3,2,0,'*,,'EE" .9999))
+ (assert-equal " 0.999E-04" (format nil "~11,3,2,0,'*,,'EE" .0000999))
+ (assert-equal " 0.100E-03" (format nil "~11,3,2,0,'*,,'EE" .00009999))
+ (assert-equal " 9.999E-05" (format nil "~11,3,2,,'*,,'EE" .00009999))
+ (assert-equal " 1.000E-04" (format nil "~11,3,2,,'*,,'EE" .000099999)))
+
+(define-test format.float.3
+ (assert-equal ".00123d+6" (format nil "~9,,,-2E" 1.2345689d3))
+ (assert-equal "-.0012d+6" (format nil "~9,,,-2E" -1.2345689d3))
+ (assert-equal ".00123d+0" (format nil "~9,,,-2E" 1.2345689d-3))
+ (assert-equal "-.0012d+0" (format nil "~9,,,-2E" -1.2345689d-3)))
+
+(define-test format.float.4
+ (assert-equal "0.314e-01" (format nil "~9,3,2,0,'%G" 0.0314159))
+ (assert-equal "+.003e+03" (format nil "~9,3,2,-2,'%@e" 3.14159))
+ (assert-equal " 31.42" (format nil "~6,2,1,'*F" 3.14159))
+ (assert-equal " 3141590." (format nil "~9,0,6f" 3.14159))
+
+ (assert-equal ".00000003d+8" (format nil "~9,4,,-7E" pi))
+ (assert-equal ".000003d+6" (format nil "~9,4,,-5E" pi))
+ (assert-equal "3141600.d-6" (format nil "~5,4,,7E" pi))
+ (assert-equal " 314.16d-2" (format nil "~11,4,,3E" pi))
+ (assert-equal " 31416.d-4" (format nil "~11,4,,5E" pi))
+ (assert-equal " 0.3142d+1" (format nil "~11,4,,0E" pi))
+ (assert-equal ".03142d+2" (format nil "~9,,,-1E" pi))
+ (assert-equal "0.003141592653589793d+3" (format nil "~,,,-2E" pi))
+ (assert-equal "31.41592653589793d-1" (format nil "~,,,2E" pi))
+ (assert-equal "3.141592653589793d+0" (format nil "~E" pi))
+ (assert-equal ".03142d+2" (format nil "~9,5,,-1E" pi))
+ (assert-equal " 0.03142d+2" (format nil "~11,5,,-1E" pi))
+ (assert-equal "3.141592653589793 " (format nil "~G" pi))
+ (assert-equal "3.1416 " (format nil "~9,5G" pi))
+ (assert-equal "| 3141593.d-06|" (format nil "|~13,6,2,7E|" pi))
+ (assert-equal "0.314d+01" (format nil "~9,3,2,0,'%E" pi))
+ (assert-equal " 3141593." (format nil "~9,0,6f" pi))
+ (assert-equal " 31.42" (format nil "~6,2,1,'*F" pi))
+ (assert-equal "******" (format nil "~6,2,1,'*F" (* 100 pi)))
+ (assert-equal "+.003d+03" (format nil "~9,3,2,-2,'%@E" pi))
+ (assert-equal "+0.003d+03" (format nil "~10,3,2,-2,'%@E" pi))
+ (assert-equal "=====+0.003d+03" (format nil "~15,3,2,-2,'%,'=@E" pi))
+ (assert-equal "0.003d+03" (format nil "~9,3,2,-2,'%E" pi))
+ (assert-equal "%%%%%%%%" (format nil "~8,3,2,-2,'%@E" pi))
+
+ (assert-equal "1. " (format nil "~g" 1e0))
+
+ (assert-equal "0.0e+0" (format nil "~e" 0))
+ (assert-equal "0.0d+0" (format nil "~e" 0d0))
+ (assert-equal "0.0d+0000" (format nil "~9,,4e" 0d0))
+ (assert-equal "1.2345678901234567d+4" (format nil "~E" 1.234567890123456789d4))
+
+ (assert-equal "1.32922799578492d+36" (format nil "~20E" (expt 2d0 120)))
+ (assert-equal " 1.32922800d+36" (format nil "~21,8E" (expt 2d0 120)))
+
+ (assert-equal ".0012345679" (format nil "~11f" 1.23456789123456789d-3)))
+
+(define-test format.float.5
+ ;; From CLHS 22.3.11
+ (flet ((test-f (x)
+ (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
+ x x x x x x)))
+ (assert-equal " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" (test-f 3.14159))
+ (assert-equal " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" (test-f -3.14159))
+ (assert-equal "100.00|******|100.00| 100.0|100.00|100.0" (test-f 100.0))
+ (assert-equal "1234.00|******|??????|1234.0|1234.00|1234.0" (test-f 1234.0))
+ (assert-equal " 0.01| 0.06| 0.01| 0.006|0.01|0.006" (test-f 0.006))))
+
+(define-test format.float.6
+ (flet ((test-e (x)
+ (format nil
+ "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~
+ ~9,3,2,-2,'%@E|~9,2E"
+ x x x x)))
+
+ (assert-equal " 3.14e+0| 31.42$-01|+.003e+03| 3.14e+0" (test-e 3.14159))
+ (assert-equal " -3.14e+0|-31.42$-01|-.003e+03| -3.14e+0" (test-e -3.14159))
+ (assert-equal " 1.10e+3| 11.00$+02|+.001e+06| 1.10e+3" (test-e 1100.0))
+ (assert-equal " 1.10d+3| 11.00$+02|+.001d+06| 1.10d+3" (test-e 1100.0d0))
+ (assert-equal "*********| 11.00$+12|+.001e+16| 1.10e+13" (test-e 1.1e13))
+ (assert-equal "*********|??????????|%%%%%%%%%|1.10d+120" (test-e 1.1d120))))
+
+(define-test format.float.7
+ (flet ((test-scale (k)
+ (format nil "~&Scale factor ~2D: |~13,6,2,VE|"
+ (- k 5) (- k 5) 3.14159)))
+
+ (assert-equal "Scale factor -5: | 0.000003e+06|" (test-scale 0))
+ (assert-equal "Scale factor -4: | 0.000031e+05|" (test-scale 1))
+ (assert-equal "Scale factor -3: | 0.000314e+04|" (test-scale 2))
+ (assert-equal "Scale factor -2: | 0.003142e+03|" (test-scale 3))
+ (assert-equal "Scale factor -1: | 0.031416e+02|" (test-scale 4))
+ (assert-equal "Scale factor 0: | 0.314159e+01|" (test-scale 5))
+ (assert-equal "Scale factor 1: | 3.141590e+00|" (test-scale 6))
+ (assert-equal "Scale factor 2: | 31.41590e-01|" (test-scale 7))
+ (assert-equal "Scale factor 3: | 314.1590e-02|" (test-scale 8))
+ (assert-equal "Scale factor 4: | 3141.590e-03|" (test-scale 9))
+ (assert-equal "Scale factor 5: | 31415.90e-04|" (test-scale 10))
+ (assert-equal "Scale factor 6: | 314159.0e-05|" (test-scale 11))
+ (assert-equal "Scale factor 7: | 3141590.e-06|" (test-scale 12))))
+
-----------------------------------------------------------------------
Summary of changes:
tests/printer.lisp | 113 ++++++++++++++++++++++++++++++++++
tests/trig.lisp | 170 ++++++++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 278 insertions(+), 5 deletions(-)
create mode 100644 tests/printer.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-commit
mailing list