85 lines
2.5 KiB
Plaintext
85 lines
2.5 KiB
Plaintext
;; Function To Be Tested: random
|
|
;;
|
|
;; Source: Common Lisp by Guy Steele
|
|
;; Section 12.9: Random Numbers
|
|
;; Page: 228
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: July 22, 86
|
|
;;
|
|
;; Last Update: Jan 28, 1987 Jim Blum - fixed (COND ... NIL) to (COND ... (T NIL))
|
|
;;
|
|
;; Filed as: {eris}<lispcore>cml>test>12-9-random.test
|
|
;;
|
|
;; Syntax: random number &optional state
|
|
;;
|
|
;; Function Description: This function accepts a positive integer n and returns
|
|
;; a number of the same kind between 0 (inclusive) and n (exclusive).
|
|
;; The argument state must be an object of type random-state; it defaults to the
|
|
;; value of the variable *random-state*.
|
|
;;
|
|
;; Argument(s): number: positive integer or positive floating-point number
|
|
;; state (optional): object of type random-state.
|
|
;;
|
|
;; Returns: random number between 0 (inclusive) and specified number (exclusive).
|
|
;;
|
|
;; Constraints/limitations: None
|
|
|
|
|
|
(do-test-group random-test-setup
|
|
:before (progn
|
|
|
|
(setq random-state1 (make-random-state))
|
|
(setq random-state2 (make-random-state))
|
|
(setq random-state3 (make-random-state))
|
|
|
|
(setq random-values
|
|
'(1 3 7.4 10 38 100 860 99999.888
|
|
most-positive-double-float least-positive-double-float))
|
|
(setq random-original (mapcar #'eval random-values))
|
|
|
|
(setq random-state-values '((19 random-state1)
|
|
(100 random-state2)
|
|
(999.9 random-state3)))
|
|
(setq random-state-original (mapcar #'(lambda (x) (car x))
|
|
random-state-values))
|
|
|
|
(setq random-state-first (mapcar #'(lambda (x)(union '() x))
|
|
random-state-values))
|
|
|
|
|
|
(defun check-final-values (random-pairs)
|
|
(cond ((and(or(= (cdr random-pairs) (car random-pairs))
|
|
(< (cdr random-pairs) (car random-pairs)))
|
|
(or (zerop (cdr random-pairs))
|
|
(plusp (cdr random-pairs)))) t)
|
|
(t nil))))
|
|
|
|
|
|
|
|
(do-test random-test
|
|
(and (setq random-final
|
|
(mapcar #'random random-original))
|
|
(setq random-result-pairs
|
|
(pairlis random-original random-final))
|
|
(setq random-test-result
|
|
(mapcar #'check-final-values random-result-pairs))
|
|
(notany #'null random-test-result)
|
|
|
|
(setq random-state-final
|
|
(mapcar #'eval
|
|
(mapcar #'(lambda (x) (append '(random) x))
|
|
random-state-values)))
|
|
(setq random-state-pairs
|
|
(pairlis random-state-original random-state-final))
|
|
(setq random-state-result
|
|
(mapcar #'check-final-values random-result-pairs))
|
|
(notany #'null random-state-result))))
|
|
|
|
|
|
|
|
STOP
|
|
|
|
|