1
0
mirror of synced 2026-05-05 15:44:25 +00:00
Files
Interlisp.medley/internal/test/LANGUAGE/AUTO/12-5-2-ACOS.TEST

74 lines
2.2 KiB
Plaintext

;; Function To Be Tested: ACOS
;;
;; Source: Guy L Steele's CLTL
;; Section: 12.5.2 Trigonometric and Related Functions
;; Page: 207
;;
;; Created By: Kelly Roach and John Park
;;
;; Creation Date: July 12,1986
;;
;; Last Update: July 28,1986
;;
;; Filed As: {ERIS}<LISPCORE>CML>TEST>12-5-2-ACOS.TEST
;;
;;
;; Syntax: (ACOS NUMBER)
;;
;; Function Description:
;; ASIN returns the arc sine of the argument, and ACOS the arc cosine.
;; The result is in radians. The argument may be complex.
;;
;; The arc sine and arc cosine functions may be defined mathematically for
;; an argument X as follows:
;;
;;
;; Arc sine -I log (I X+SQRT(1-X2))
;; Arc cosine -I log (X+I SQRT(1-X2))
;;
;; Note that the result of either ASIN or ACOS may be
;; complex even if the argument is not complex; this occurs
;; when the absolute value of the argument is greater than one.
;;
;; Implementation note: These formulae are mathematically correct, assuming
;; completely accurate computation. They may be terrible methods for
;; floating-point computation! Implementors should consult a good text on
;; numerical analysis. The formulas given above are not necessarily
;; the simplest ones for real-valued computations, either; they are chosen
;; to define the branch cuts in desirable ways for the complex case.
;;
;; Argument(s): NUMBER - a number
;;
;; Returns: a number
;;
(do-test-group acos-setup
:before (progn
(setq acos-tolerance 0.001)
(setq acos-test-cases '(0.0 0.1 0.3 0.7 0.99 -0.1 -0.3 -0.7 -0.99))
(setq complex-part #C(0.0 1.0))
(defun estimate-acos (x) (if (<= (abs x) 1.0)
(- (* complex-part
(log (+ x
(* complex-part (sqrt (- 1 (expt x 2))))))))))
(defun acos-test (pairs) ; pairs: paired result (calulated vs correct)
(cond ((zerop (car pairs))(zerop (cdr pairs)))
(t (< (abs (- (car pairs) (cdr pairs)))
acos-tolerance)))))
(do-test acos-test
(and (setq calculated-acos
(mapcar #'acos acos-test-cases))
(setq correct-acos (mapcar #'realpart
(mapcar #'estimate-acos acos-test-cases)))
(setq calculated-expected
(pairlis calculated-acos correct-acos))
(setq acos-test-result (mapcar #'acos-test calculated-expected))
(notany 'null acos-test-result))))
STOP