85 lines
2.5 KiB
Plaintext
85 lines
2.5 KiB
Plaintext
;; Function To Be Tested: PHASE
|
||
;;
|
||
;; Source: Guy L Steele's CLTL
|
||
;; Section: 12.5.2 Trigonometric and Related Functions
|
||
;; Page: 206
|
||
;;
|
||
;; Created By: Kelly Roach and John Park
|
||
;;
|
||
;; Creation Date: July 12,1986
|
||
;;
|
||
;; Last Update: July 31,1986
|
||
;;
|
||
;; Filed As: {ERIS}<LISPCORE>CML>TEST>12-5-2-PHASE.TEST
|
||
;;
|
||
;;
|
||
;; Syntax: (PHASE NUMBER)
|
||
;;
|
||
;; Function Description:
|
||
;; The phase of a number is the angle part of its polar representation
|
||
;; as a complex number. That is,
|
||
;;
|
||
;; (PHASE X) = (ATAN (IMAGPART X) (REALPART X))
|
||
;;
|
||
;; The result is in radians, in the range -Sail (exclusive)
|
||
;; to Sail (inclusive). The phase of a positive non-complex number
|
||
;; is zero; that of a negative non-complex number is Sail.
|
||
;; The phase of zero is arbitrarily defined to be zero.
|
||
;;
|
||
;; If the argument is a complex floating-point number, the result
|
||
;; is a floating-point number of the same type as the components of
|
||
;; the argument.
|
||
;; If the argument is a floating-point number, the result is a
|
||
;; floating-point number of the same type.
|
||
;; If the argument is a rational number or complex rational number, the result
|
||
;; is a single-format floating-point number.
|
||
;;
|
||
;; Argument(s): NUMBER - a number
|
||
;;
|
||
;; Returns: a number
|
||
;;
|
||
|
||
|
||
(do-test-group (phase-setup
|
||
:before (progn
|
||
(setq phase-tolerance 0.00001)
|
||
(setq phase-test-cases
|
||
'(0 1 2 -1 0.0 3.0 -5.0 #C(1.0 0.5) #C(1.1 -0.1) #C(-0.2 -1.0)))
|
||
|
||
(defun compute-phase (x)
|
||
(cond ((zerop x) x)
|
||
((complexp x) (atan (imagpart x) (realpart x)))
|
||
(t (atan 0 x))))
|
||
|
||
(setq correct-phase
|
||
(mapcar #'compute-phase phase-test-cases))
|
||
|
||
|
||
(defun phase-difference (pairs) ; calculated vs correct
|
||
(cond ((zerop (cdr pairs)) (zerop (car pairs)))
|
||
(t (< (abs (/ (- (car pairs)(cdr pairs)) (cdr pairs)))
|
||
phase-tolerance))))
|
||
|
||
(defun check-phase-range (x) ; x : value of (phase x)
|
||
(cond ((complexp x)
|
||
(and (> (phase x) (- pi))
|
||
(<= (phase x) pi)
|
||
(not(integerp (phase x)))))
|
||
((plusp x) (= (phase x) 0))
|
||
((minusp x) (> (phase x) (- pi 0.000001)))
|
||
((zerop x) (= (phase x) 0))
|
||
(t (and (> (phase x) (- pi))
|
||
(<= (phase x) pi)))))))
|
||
|
||
(do-test phase-test
|
||
(and (setq calculated-phase
|
||
(mapcar #'phase phase-test-cases))
|
||
(setq phase-pairs
|
||
(pairlis calculated-phase correct-phase))
|
||
(notany 'null (mapcar #'check-phase-range phase-test-cases))
|
||
(or (equal calculated-phase correct-phase)
|
||
(notany 'null (mapcar #'phase-difference phase-pairs))))))
|
||
|
||
STOP
|
||
|