Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
cmucl
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
19
Issues
19
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
cmucl
cmucl
Commits
196e1482
Commit
196e1482
authored
Dec 20, 2013
by
Raymond Toy
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add tests for branch cuts.
parent
b71b7c85
Changes
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
168 additions
and
0 deletions
+168
0
trig.lisp
src/tests/trig.lisp
+168
0
No files found.
src/tests/trig.lisp
View file @
196e1482
...
...
@@ 228,6 +228,8 @@
t
err
)))
;;; Tests for doubledoublefloats
(
definetest
ddsin.signedzeroes
"Test sin for 0w0 and 0w0"
(
:tag
:sin
:doubledouble
:signedzeroes
)
...
...
@@ 431,3 +433,169 @@
(
asserteql
nil
(
ddsincostest
(
scalefloat
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 realsign and imagsign, respectively.
;; Return T if the signs match.
(
defun
checksigns
(
fun
arg
realsign
imagsign
)
(
let*
((
z
(
funcall
fun
arg
))
(
x
(
realpart
z
))
(
y
(
imagpart
z
)))
(
cond
((
and
(
=
(
floatsign
x
)
realsign
)
(
=
(
floatsign
y
)
imagsign
))
t
)
(
t
(
format
t
"Sign of result doesn't match expected signs~%~
~& fun = ~A~
~& arg = ~A~
~& res = ~A~
~& expected = ~A ~A~%"
fun
arg
z
realsign
imagsign
)
nil
))))
;; Return the signs of the real and imaginary parts of z.
(
defun
getsigns
(
z
)
(
values
(
floatsign
(
realpart
z
))
(
floatsign
(
imagpart
z
))))
;; Carefully compute 1z. For z = x + i*y, we want 1x  i*y, which
;; only really matters when y is a signed zero.
(
defun
1z
(
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(1x^2))
(
defun
asindef
(
z
)
(

(
i*z
(
log
(
+
(
i*z
z
)
(
sqrt
(
1z
(
*
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.
;;
(
definetest
branchcut.asin
(
:tag
:asin
:branchcuts
)
;; Test for x < 1, which is continuous with Quadrant II. Compute
;; the value at #c(2d0 1d10) and check that components of
;; asin(2+0.0*i) have the same signs as the reference value.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
asindef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
asin
2d0
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
2w0
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
#c
(
2d0
0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
#c
(
2w0
0
)
tr
ti
)))
;; Test the other side of the branch cut for x < 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
asindef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
asin
#c
(
2d0
0d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
#c
(
2w0
0w0
)
tr
ti
)))
;; Test for x > 1, which is continuous with Quadrant IV, using the
;; value at #c(+2d0 1d10) as the reference
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
asindef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
asin
#c
(
2d0
0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
#c
(
2w0
0
)
tr
ti
)))
;; Test the other side of the branch cut for x > 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
asindef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
asin
2d0
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
2w0
tr
ti
))
(
asserttrue
(
checksigns
#'
asin
#c
(
2d0
0d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
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
acosdef
(
z
)
(
if
(
typep
z
'kernel:doubledoublefloat
)
(

(
/
kernel:ddpi
2
)
(
asindef
z
))
(

(
/
pi
2
)
(
asindef
z
))))
(
definetest
branchcut.acos
(
:tag
:acos
:branchcuts
)
;; Test for x < 1, which is continuous with Quadrant II. Compute
;; the value at #c(2d0 1d10) and check that components of
;; acos(2+0.0*i) have the same signs as the reference value.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
acosdef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
acos
2d0
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
2w0
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2d0
0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2w0
0
)
tr
ti
)))
;; Test the other side of the branch cut for x < 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
acosdef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
acos
#c
(
2d0
0d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2w0
0w0
)
tr
ti
)))
;; Test for x > 1, which is continuous with Quadrant IV, using the
;; value at #c(+2d0 1d10) as the reference
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
acosdef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
acos
#c
(
2d0
0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2w0
0
)
tr
ti
)))
;; Test the other side of the branch cut for x > 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
acosdef
#c
(
2d0
1d20
)))
(
asserttrue
(
checksigns
#'
acos
2d0
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
2w0
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2d0
0d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
acos
#c
(
2w0
0w0
)
tr
ti
))))
;; atan(z) = (log(1+i*z)  log(1i*z))/(2*i)
;; = i/2*(log(1+i*z)  log(1i*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
atandef
(
z
)
(
let*
((
iz
(
i*z
z
))
(
w
(

(
log
(
1+z
iz
))
(
log
(
1z
iz
)))))
(
*
1/2
(
i*z
w
))))
(
definetest
branchcut.atan
(
:tag
:atan
:branchcuts
)
;; Test for y < 1, which is continuous with Quadrant IV. Use the
;; value at #c(1d20 2d0) as the reference.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
atandef
#c
(
1d20
2d0
)))
(
asserttrue
(
checksigns
#'
atan
#c
(
0d0
2d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
atan
#c
(
0w0
2w0
)
tr
ti
)))
;; Test the other side of the branch cut for x < 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
atandef
#c
(
1d20
2d0
)))
(
asserttrue
(
checksigns
#'
atan
#c
(
0d0
2d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
atan
#c
(
0w0
2w0
)
tr
ti
)))
;; Test for y > 1, which is continuous with Quadrant II, using the
;; value at #c(1d20 +2d0) as the reference
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
atandef
#c
(
1d20
2d0
)))
(
asserttrue
(
checksigns
#'
atan
#c
(
0d0
2d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
atan
#c
(
0w0
2w0
)
tr
ti
)))
;; Test the other side of the branch cut for x > 1.
(
multiplevaluebind
(
tr
ti
)
(
getsigns
(
atandef
#c
(
1d20
2d0
)))
(
asserttrue
(
checksigns
#'
atan
#c
(
0d0
2d0
)
tr
ti
))
(
asserttrue
(
checksigns
#'
atan
#c
(
0d0
2w0
)
tr
ti
))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment