280 |
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
281 |
(if (coin) (/ n d) (- (/ n d)))))) |
(if (coin) (/ n d) (- (/ n d)))))) |
282 |
|
|
283 |
|
(defun make-random-nonnegative-rational () |
284 |
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
285 |
|
(n (random r))) |
286 |
|
(assert (>= r 2)) |
287 |
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
288 |
|
(/ n d)))) |
289 |
|
|
290 |
|
(defun make-random-positive-rational () |
291 |
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
292 |
|
(n (1+ (random r)))) |
293 |
|
(assert (>= r 2)) |
294 |
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
295 |
|
(/ n d)))) |
296 |
|
|
297 |
|
(defun make-random-bounded-rational (upper-limit lower-inclusive upper-inclusive) |
298 |
|
(assert (rationalp upper-limit)) |
299 |
|
(assert (not (minusp upper-limit))) |
300 |
|
(cond |
301 |
|
((= upper-limit 0) 0) |
302 |
|
((<= upper-limit 1/1000000) |
303 |
|
(/ (make-random-bounded-rational (* 1000000 upper-limit) lower-inclusive upper-inclusive) |
304 |
|
1000000)) |
305 |
|
((>= upper-limit 1000000) |
306 |
|
(* (random 1000000) |
307 |
|
(make-random-bounded-rational (/ upper-limit 1000000) lower-inclusive upper-inclusive))) |
308 |
|
(t |
309 |
|
(assert (< 1/1000000 upper-limit 1000000)) |
310 |
|
(let ((x 0)) |
311 |
|
(loop do (setq x (* upper-limit (rational (random 1.0)))) |
312 |
|
while (or (and (not lower-inclusive) (zerop x)) |
313 |
|
(and (not upper-inclusive) (= x upper-limit))) |
314 |
|
finally (return x)))))) |
315 |
|
|
316 |
(defun make-random-float () |
(defun make-random-float () |
317 |
(rcase |
(rcase |
318 |
(1 (random most-positive-short-float)) |
(1 (random most-positive-short-float)) |
523 |
`(boole ,op ,e1 ,e2))))) |
`(boole ,op ,e1 ,e2))))) |
524 |
|
|
525 |
;; n-ary ops |
;; n-ary ops |
526 |
(40 |
(20 |
527 |
(let* ((op (random-from-seq #(+ - * logand min max |
(let* ((op (random-from-seq #(+ - * logand min max |
528 |
logior values lcm gcd logxor))) |
logior values lcm gcd logxor))) |
529 |
(nmax (case op ((* lcm gcd) 4) (t (1+ (random 40))))) |
(nmax (case op ((* lcm gcd) 4) (t (1+ (random 40))))) |
1197 |
;; powers of 2...) |
;; powers of 2...) |
1198 |
(random-from-interval (1+ hi) lo))))) |
(random-from-interval (1+ hi) lo))))) |
1199 |
|
|
1200 |
|
(rational |
1201 |
|
(or |
1202 |
|
(let ((r (make-random-element-of-type 'rational))) |
1203 |
|
(and (typep r type) r)) |
1204 |
|
(let ((lo (cadr type)) |
1205 |
|
(hi (caddr type)) |
1206 |
|
lo= hi=) |
1207 |
|
(cond |
1208 |
|
((consp lo) nil) |
1209 |
|
((member lo '(* nil)) |
1210 |
|
(setq lo nil) |
1211 |
|
(setq lo= nil)) |
1212 |
|
(t |
1213 |
|
(assert (typep lo 'rational)) |
1214 |
|
(setq lo= t))) |
1215 |
|
(cond |
1216 |
|
((consp hi) nil) |
1217 |
|
((member hi '(* nil)) |
1218 |
|
(setq hi nil) |
1219 |
|
(setq hi= nil)) |
1220 |
|
(t |
1221 |
|
(assert (typep hi 'rational)) |
1222 |
|
(setq hi= t))) |
1223 |
|
(assert (or (null lo) (null hi) (<= lo hi))) |
1224 |
|
(assert (or (null lo) (null hi) (< lo hi) (and lo= hi=))) |
1225 |
|
(cond |
1226 |
|
((null lo) |
1227 |
|
(cond |
1228 |
|
((null hi) (make-random-rational)) |
1229 |
|
(hi= (- hi (make-random-nonnegative-rational))) |
1230 |
|
(t (- hi (make-random-positive-rational))))) |
1231 |
|
((null hi) |
1232 |
|
(cond |
1233 |
|
(lo= (+ lo (make-random-nonnegative-rational))) |
1234 |
|
(t (+ lo (make-random-positive-rational))))) |
1235 |
|
(t |
1236 |
|
(+ lo (make-random-bounded-rational (- hi lo) lo= hi=))))))) |
1237 |
|
|
1238 |
((single-float double-float long-float short-float) |
((single-float double-float long-float short-float) |
1239 |
(let ((lo (cadr type)) |
(let ((lo (cadr type)) |
1240 |
(hi (caddr type)) |
(hi (caddr type)) |
1336 |
when (typep c type) |
when (typep c type) |
1337 |
return c))))) |
return c))))) |
1338 |
))) |
))) |
1339 |
|
((typep type 'class) |
1340 |
|
(make-random-element-of-type (class-name type))) |
1341 |
(t |
(t |
1342 |
(ecase type |
(ecase type |
1343 |
(bit (random 2)) |
(bit (random 2)) |
1344 |
(boolean (random-from-seq #(nil t))) |
(boolean (random-from-seq #(nil t))) |
1345 |
(symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car))) |
(symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car))) |
1346 |
|
(keyword (random-from-seq #(:a :b :c :d :e :f :g :h :i :j))) |
1347 |
(unsigned-byte (random-from-interval |
(unsigned-byte (random-from-interval |
1348 |
(1+ (ash 1 (random *maximum-random-int-bits*))) 0)) |
(1+ (ash 1 (random *maximum-random-int-bits*))) 0)) |
1349 |
(signed-byte (random-from-interval |
(signed-byte (random-from-interval |
1357 |
((float) |
((float) |
1358 |
(make-random-element-of-type (random-from-seq #(short-float single-float double-float long-float)))) |
(make-random-element-of-type (random-from-seq #(short-float single-float double-float long-float)))) |
1359 |
((real) (make-random-element-of-type (random-from-seq #(integer rational float)))) |
((real) (make-random-element-of-type (random-from-seq #(integer rational float)))) |
1360 |
((number) (make-random-element-of-type (random-from-seq #(integer rational float complex)))) |
((number) (make-random-element-of-type (random-from-seq #(integer rational float #-ecl complex)))) |
1361 |
((bit-vector) (make-random-vector 'bit '*)) |
((bit-vector) (make-random-vector 'bit '*)) |
1362 |
((simple-bit-vector) (make-random-vector 'bit '* :simple t)) |
((simple-bit-vector) (make-random-vector 'bit '* :simple t)) |
1363 |
((vector) (make-random-vector '* '*)) |
((vector) (make-random-vector '* '*)) |
1372 |
((base-char standard-char) |
((base-char standard-char) |
1373 |
(random-from-seq +standard-chars+)) |
(random-from-seq +standard-chars+)) |
1374 |
((character) (make-random-character)) |
((character) (make-random-character)) |
1375 |
|
((extended-char) (loop for x = (make-random-character) when (typep x 'extended-char) return x)) |
1376 |
;; Default |
;; Default |
1377 |
((atom t *) (make-random-element-of-type |
((atom t *) (make-random-element-of-type |
1378 |
(random-from-seq #(real symbol boolean integer unsigned-byte complex character |
(random-from-seq #(real symbol boolean integer unsigned-byte |
1379 |
(string 1) (bit-vector 1) complex)))) |
#-ecl complex character |
1380 |
|
(string 1) (bit-vector 1))))) |
1381 |
((null) nil) |
((null) nil) |
1382 |
((fixnum) |
((fixnum) |
1383 |
(random-from-interval (1+ most-positive-fixnum) most-negative-fixnum)) |
(random-from-interval (1+ most-positive-fixnum) most-negative-fixnum)) |