[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-28-gbf11273
Raymond Toy
rtoy at common-lisp.net
Sat Dec 21 06:42:10 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 bf1127321b08ef7e02eb7159f194c054078b95f2 (commit)
via 196e1482e0563250b4ca257a2a119dbe09e6b0a3 (commit)
from b71b7c854469191e462162c9d11d0c35222a284a (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 bf1127321b08ef7e02eb7159f194c054078b95f2
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Dec 20 22:41:59 2013 -0800
Document the value of atan better. The CLHS is confusing.
Clean up comments for asin too.
diff --git a/src/tests/trig.lisp b/src/tests/trig.lisp
index 78e643d..011aeaf 100644
--- a/src/tests/trig.lisp
+++ b/src/tests/trig.lisp
@@ -482,14 +482,16 @@
(complex 0 z)))
;; asin(x) = -i*log(i*x + sqrt(1-x^2))
-(defun asin-def (z)
- (- (i*z (log (+ (i*z z)
- (sqrt (1-z (* z z))))))))
-
-;; asin branch cut is the real axis |x| > 1. For x < -1, it is
+;;
+;; The branch cut is the real axis |x| > 1. For x < -1, it is
;; continuous with quadrant II; for x > 1, continuous with quadrant
;; IV.
;;
+(defun asin-def (z)
+ (- (i*z (log (+ (i*z z)
+ (sqrt (1-z (* z z))))))))
+
+
(define-test branch-cut.asin
(:tag :asin :branch-cuts)
;; Test for x < -1, which is continuous with Quadrant II. Compute
@@ -566,6 +568,33 @@
;; atan(z) = (log(1+i*z) - log(1-i*z))/(2*i)
;; = -i/2*(log(1+i*z) - log(1-i*z))
;;
+;; WARNING: The CLHS is a bit confused here. Two definitions of atan
+;; are given in the CLHS
+;; http://www.lispworks.com/documentation/HyperSpec/Body/f_asin_.htm
+;; and they are not consistent. Plus, there is a typo in the second
+;; definition. (Missing parens.)
+;;
+;; For clarification, we turn to
+;; http://www.lispworks.com/documentation/HyperSpec/Issues/iss069_w.htm,
+;; which recommends using the second formula and also puts in the
+;; parentheses in the correct places.
+;;
+;; BUT, this is further confused by the example that atan(0+2*i) is
+;; 1.57-0.549*i for the proposed formula but -1.57+0.549*i under the
+;; current formula.
+;;
+;;
+;; I think the inconsistency is that the results are derived without
+;; signed zeroes. But we have signed zeroes, so let us derive the
+;; actual value of atan(0+2*i) using the (second) formula.
+;;
+;; atan(0+2*i) = (log(1+i*(0+2*i)) - log(1-i*(0+2*i)))/(2*i)
+;; = (log(1+(-2+0*i)) - log(1-(-2+0*i)))/(2*i)
+;; = (log(-1-0*i) - log(3-0*i))/(2*i)
+;; = ((log(1) - pi*i) - (log(3) - 0*i))/(2*i)
+;; = (-log(3) - pi*i)/(2*i)
+;; = -pi/2 + log(3)/2*i
+;;
;; The branch cut is the imaginary axis, |y| > 1. For y < -1, atan is
;; continuous with Quadrant IV; for y > 1, Quadrant II.
(defun atan-def (z)
commit 196e1482e0563250b4ca257a2a119dbe09e6b0a3
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Dec 20 22:16:27 2013 -0800
Add tests for branch cuts.
diff --git a/src/tests/trig.lisp b/src/tests/trig.lisp
index 58d5440..78e643d 100644
--- a/src/tests/trig.lisp
+++ b/src/tests/trig.lisp
@@ -228,6 +228,8 @@
t
err)))
+
+;;; Tests for double-double-floats
(define-test dd-sin.signed-zeroes
"Test sin for 0w0 and -0w0"
(:tag :sin :double-double :signed-zeroes)
@@ -431,3 +433,169 @@
(assert-eql nil
(dd-sincos-test (scale-float 1w0 1023) 1000)))
+
+;;; Tests for branch cuts.
+
+
+;; Compute fun(arg) and check that the signs of the real and imaginary
+;; parts match the value of real-sign and imag-sign, respectively.
+;; Return T if the signs match.
+(defun check-signs (fun arg real-sign imag-sign)
+ (let* ((z (funcall fun arg))
+ (x (realpart z))
+ (y (imagpart z)))
+ (cond ((and (= (float-sign x) real-sign)
+ (= (float-sign y) imag-sign))
+ t)
+ (t
+ (format t "Sign of result doesn't match expected signs~%~
+ ~& fun = ~A~
+ ~& arg = ~A~
+ ~& res = ~A~
+ ~& expected = ~A ~A~%"
+ fun arg z real-sign imag-sign)
+ nil))))
+
+;; Return the signs of the real and imaginary parts of z.
+(defun get-signs (z)
+ (values (float-sign (realpart z))
+ (float-sign (imagpart z))))
+
+;; 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)
+ (if (complexp z)
+ (complex (- 1 (realpart z)) (- (imagpart z)))
+ (- 1 z)))
+
+;; 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)
+ (if (complexp z)
+ (complex (+ 1 (realpart z)) (imagpart z))
+ (+ 1 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)))
+
+;; asin(x) = -i*log(i*x + sqrt(1-x^2))
+(defun asin-def (z)
+ (- (i*z (log (+ (i*z z)
+ (sqrt (1-z (* z z))))))))
+
+;; asin branch cut is the real axis |x| > 1. For x < -1, it is
+;; continuous with quadrant II; for x > 1, continuous with quadrant
+;; IV.
+;;
+(define-test branch-cut.asin
+ (:tag :asin :branch-cuts)
+ ;; Test for x < -1, which is continuous with Quadrant II. Compute
+ ;; the value at #c(-2d0 1d-10) and check that components of
+ ;; asin(-2+0.0*i) have the same signs as the reference value.
+ (multiple-value-bind (tr ti)
+ (get-signs (asin-def #c(-2d0 1d-20)))
+ (assert-true (check-signs #'asin -2d0 tr ti))
+ (assert-true (check-signs #'asin -2w0 tr ti))
+ (assert-true (check-signs #'asin #c(-2d0 0) tr ti))
+ (assert-true (check-signs #'asin #c(-2w0 0) tr ti)))
+ ;; Test the other side of the branch cut for x < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (asin-def #c(-2d0 -1d-20)))
+ (assert-true (check-signs #'asin #c(-2d0 -0d0) tr ti))
+ (assert-true (check-signs #'asin #c(-2w0 -0w0) tr ti)))
+
+ ;; Test for x > 1, which is continuous with Quadrant IV, using the
+ ;; value at #c(+2d0 1d-10) as the reference
+ (multiple-value-bind (tr ti)
+ (get-signs (asin-def #c(2d0 1d-20)))
+ (assert-true (check-signs #'asin #c(2d0 0) tr ti))
+ (assert-true (check-signs #'asin #c(2w0 0) tr ti)))
+ ;; Test the other side of the branch cut for x > 1.
+ (multiple-value-bind (tr ti)
+ (get-signs (asin-def #c(2d0 -1d-20)))
+ (assert-true (check-signs #'asin 2d0 tr ti))
+ (assert-true (check-signs #'asin 2w0 tr ti))
+ (assert-true (check-signs #'asin #c(2d0 -0d0) tr ti))
+ (assert-true (check-signs #'asin #c(2w0 -0w0) tr ti))))
+
+;; acos(z) = pi/2 - asin(z).
+;;
+;; The branch cut is the real axis for |x| > 1. For x < -1, it is
+;; 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))))
+
+(define-test branch-cut.acos
+ (:tag :acos :branch-cuts)
+ ;; Test for x < -1, which is continuous with Quadrant II. Compute
+ ;; the value at #c(-2d0 1d-10) and check that components of
+ ;; acos(-2+0.0*i) have the same signs as the reference value.
+ (multiple-value-bind (tr ti)
+ (get-signs (acos-def #c(-2d0 1d-20)))
+ (assert-true (check-signs #'acos -2d0 tr ti))
+ (assert-true (check-signs #'acos -2w0 tr ti))
+ (assert-true (check-signs #'acos #c(-2d0 0) tr ti))
+ (assert-true (check-signs #'acos #c(-2w0 0) tr ti)))
+ ;; Test the other side of the branch cut for x < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (acos-def #c(-2d0 -1d-20)))
+ (assert-true (check-signs #'acos #c(-2d0 -0d0) tr ti))
+ (assert-true (check-signs #'acos #c(-2w0 -0w0) tr ti)))
+
+ ;; Test for x > 1, which is continuous with Quadrant IV, using the
+ ;; value at #c(+2d0 1d-10) as the reference
+ (multiple-value-bind (tr ti)
+ (get-signs (acos-def #c(2d0 1d-20)))
+ (assert-true (check-signs #'acos #c(2d0 0) tr ti))
+ (assert-true (check-signs #'acos #c(2w0 0) tr ti)))
+ ;; Test the other side of the branch cut for x > 1.
+ (multiple-value-bind (tr ti)
+ (get-signs (acos-def #c(2d0 -1d-20)))
+ (assert-true (check-signs #'acos 2d0 tr ti))
+ (assert-true (check-signs #'acos 2w0 tr ti))
+ (assert-true (check-signs #'acos #c(2d0 -0d0) tr ti))
+ (assert-true (check-signs #'acos #c(2w0 -0w0) tr ti))))
+
+;; atan(z) = (log(1+i*z) - log(1-i*z))/(2*i)
+;; = -i/2*(log(1+i*z) - log(1-i*z))
+;;
+;; The branch cut is the imaginary axis, |y| > 1. For y < -1, atan is
+;; continuous with Quadrant IV; for y > 1, Quadrant II.
+(defun atan-def (z)
+ (let* ((iz (i*z z))
+ (w (- (log (1+z iz))
+ (log (1-z iz)))))
+ (* -1/2 (i*z w))))
+
+(define-test branch-cut.atan
+ (:tag :atan :branch-cuts)
+ ;; Test for y < -1, which is continuous with Quadrant IV. Use the
+ ;; value at #c(1d-20 -2d0) as the reference.
+ (multiple-value-bind (tr ti)
+ (get-signs (atan-def #c(1d-20 -2d0)))
+ (assert-true (check-signs #'atan #c(0d0 -2d0) tr ti))
+ (assert-true (check-signs #'atan #c(0w0 -2w0) tr ti)))
+ ;; Test the other side of the branch cut for x < -1.
+ (multiple-value-bind (tr ti)
+ (get-signs (atan-def #c(-1d-20 -2d0)))
+ (assert-true (check-signs #'atan #c(-0d0 -2d0) tr ti))
+ (assert-true (check-signs #'atan #c(-0w0 -2w0) tr ti)))
+
+ ;; Test for y > 1, which is continuous with Quadrant II, using the
+ ;; value at #c(-1d-20 +2d0) as the reference
+ (multiple-value-bind (tr ti)
+ (get-signs (atan-def #c(-1d-20 2d0)))
+ (assert-true (check-signs #'atan #c(-0d0 2d0) tr ti))
+ (assert-true (check-signs #'atan #c(-0w0 2w0) tr ti)))
+ ;; Test the other side of the branch cut for x > 1.
+ (multiple-value-bind (tr ti)
+ (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))))
-----------------------------------------------------------------------
Summary of changes:
src/tests/trig.lisp | 197 +++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 197 insertions(+)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list