5 |
|
|
6 |
(in-package :cl-test) |
(in-package :cl-test) |
7 |
|
|
8 |
|
(declaim (special +standard-chars+ *cl-symbols-vector*)) |
9 |
|
|
10 |
|
(defvar *maximum-random-int-bits* |
11 |
|
(max 36 (1+ (integer-length most-positive-fixnum)))) |
12 |
|
|
13 |
(defun random-from-seq (seq) |
(defun random-from-seq (seq) |
14 |
"Generate a random member of a sequence." |
"Generate a random member of a sequence." |
15 |
(let ((len (length seq))) |
(let ((len (length seq))) |
41 |
collect `((< ,r ,cw) ,@(cdr case))) |
collect `((< ,r ,cw) ,@(cdr case))) |
42 |
(t ,@(cdar (last cases))))))) |
(t ,@(cdar (last cases))))))) |
43 |
|
|
44 |
|
(defun make-random-integer-range (&optional var) |
45 |
|
"Generate a list (LO HI) of integers, LO <= HI. This is used |
46 |
|
for generating integer types." |
47 |
|
(declare (ignore var)) |
48 |
|
(rcase |
49 |
|
(1 (flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) |
50 |
|
(- (random r) (floor (/ r 2)))))) |
51 |
|
(let ((x (%r)) |
52 |
|
(y (%r))) |
53 |
|
(list (min x y) (max x y))))) |
54 |
|
(1 (let* ((b (ash 1 (1+ (random *maximum-random-int-bits*)))) |
55 |
|
(b2 (floor (/ b 2)))) |
56 |
|
(let ((x (- (random b) b2)) |
57 |
|
(y (- (random b) b2))) |
58 |
|
(list (min x y) (max x y))))))) |
59 |
|
|
60 |
(defun random-nonnegative-real () |
(defun random-nonnegative-real () |
61 |
(if (coin 3) |
(if (coin 3) |
62 |
(random-case |
(random-case |
74 |
(expt 2.0d0 (random 32)) |
(expt 2.0d0 (random 32)) |
75 |
(expt 2.0l0 (random 32)))))) |
(expt 2.0l0 (random 32)))))) |
76 |
|
|
77 |
|
(defun make-random-integer () |
78 |
|
(let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) |
79 |
|
(rcase |
80 |
|
(6 (- (random r) (floor (/ r 2)))) |
81 |
|
(1 (- r (random (min 10 r)))) |
82 |
|
(1 (+ (floor (/ r 2)) (random (min 10 r))))))) |
83 |
|
|
84 |
|
(defun make-random-rational () |
85 |
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
86 |
|
(n (random r))) |
87 |
|
(assert (>= r 2)) |
88 |
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
89 |
|
(if (coin) (/ n d) (- (/ n d)))))) |
90 |
|
|
91 |
|
(defun make-random-nonnegative-rational () |
92 |
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
93 |
|
(n (random r))) |
94 |
|
(assert (>= r 2)) |
95 |
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
96 |
|
(/ n d)))) |
97 |
|
|
98 |
|
(defun make-random-positive-rational () |
99 |
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
100 |
|
(n (1+ (random r)))) |
101 |
|
(assert (>= r 2)) |
102 |
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
103 |
|
(/ n d)))) |
104 |
|
|
105 |
|
(defun make-random-bounded-rational (upper-limit lower-inclusive upper-inclusive) |
106 |
|
(assert (rationalp upper-limit)) |
107 |
|
(assert (not (minusp upper-limit))) |
108 |
|
(cond |
109 |
|
((= upper-limit 0) 0) |
110 |
|
((<= upper-limit 1/1000000) |
111 |
|
(/ (make-random-bounded-rational (* 1000000 upper-limit) lower-inclusive upper-inclusive) |
112 |
|
1000000)) |
113 |
|
((>= upper-limit 1000000) |
114 |
|
(* (random 1000000) |
115 |
|
(make-random-bounded-rational (/ upper-limit 1000000) lower-inclusive upper-inclusive))) |
116 |
|
(t |
117 |
|
(assert (< 1/1000000 upper-limit 1000000)) |
118 |
|
(let ((x 0)) |
119 |
|
(loop do (setq x (* upper-limit (rational (random 1.0)))) |
120 |
|
while (or (and (not lower-inclusive) (zerop x)) |
121 |
|
(and (not upper-inclusive) (= x upper-limit))) |
122 |
|
finally (return x)))))) |
123 |
|
|
124 |
|
(defun make-random-float () |
125 |
|
(rcase |
126 |
|
(1 (random most-positive-short-float)) |
127 |
|
(1 (random most-positive-single-float)) |
128 |
|
(1 (random most-positive-double-float)) |
129 |
|
(1 (random most-positive-long-float)))) |
130 |
|
|
131 |
|
(defun make-random-symbol () |
132 |
|
(rcase |
133 |
|
(3 (random-from-seq #(a b c d e f g h i j k l m n o p q r s t u v w x y z))) |
134 |
|
(2 (random-from-seq *cl-symbols-vector*)) |
135 |
|
(1 (gensym)))) |
136 |
|
|
137 |
(defun random-real () |
(defun random-real () |
138 |
(if (coin) (random-nonnegative-real) |
(if (coin) (random-nonnegative-real) |
139 |
(- (random-nonnegative-real)))) |
(- (random-nonnegative-real)))) |
151 |
(random-partition (1- n) (max 10 (1- n)))))) |
(random-partition (1- n) (max 10 (1- n)))))) |
152 |
))) |
))) |
153 |
|
|
|
(declaim (special +standard-chars+ *cl-symbols-vector*)) |
|
|
|
|
154 |
(defparameter *use-random-byte* t) |
(defparameter *use-random-byte* t) |
155 |
(defparameter *random-readable* nil) |
(defparameter *random-readable* nil) |
156 |
|
|