Really restore clisp cross-compilation.
[sbcl.git] / tests / random.pure.lisp
1 ;;;; various RANDOM tests without side effects
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;;
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
13
14 (in-package :cl-user)
15
16 ;;; Tests in this file that rely on properties of the distribution of
17 ;;; the random numbers are designed to be fast and have a very low
18 ;;; probability of false positives, generally of the order of (expt 10 -60).
19 ;;; These tests are not intended to assure the statistical qualities of the
20 ;;; pseudo random number generator but to help find bugs in its and RANDOM's
21 ;;; implementation.
22
23 ;; When the type of the argument of RANDOM is a set of integers, a
24 ;; DEFTRANSFORM triggered that simply generated (REM (RANDOM-CHUNK) NUM),
25 ;; which has two severe problems: The resulting distribution is very uneven
26 ;; for most arguments of RANDOM near the size of a random chunk and the
27 ;; RANDOM-CHUNK used was always 32 bits, even under 64 bit wordsize which
28 ;; yields even more disastrous distributions.
29 (with-test (:name (:random :integer :set-of-integers :distribution))
30   (let* ((high (floor (expt 2 33) 3))
31          (mid (floor high 2))
32          (fun (compile nil `(lambda (x)
33                               (random (if x ,high 10)))))
34          (n1 0)
35          (n 10000))
36     (dotimes (i n)
37       (when (>= (funcall fun t) mid)
38         (incf n1)))
39     ;; Half of the values of (RANDOM HIGH) should be >= MID, so we expect
40     ;; N1 to be binomially distributed such that this distribution can be
41     ;; approximated by a normal distribution with mean (/ N 2) and standard
42     ;; deviation (* (sqrt N) 1/2). The broken RANDOM we are testing here for
43     ;; yields (/ N 3) and (* (sqrt N) (sqrt 2/9)), respectively. We test if
44     ;; N1 is below the average of (/ N 3) and (/ N 2). With a value of N of
45     ;; 10000 this is more than 16 standard deviations away from the expected
46     ;; mean, which has a probability of occurring by chance of below
47     ;; (expt 10 -60).
48     (when (< n1 (* n 5/12))
49       (error "bad RANDOM distribution: expected ~d, got ~d" (/ n 2) n1))))
50
51 (with-test (:name (:random :integer :set-of-integers :chunk-size))
52   (let* ((high (expt 2 64))
53          (fun (compile nil `(lambda (x)
54                               (random (if x ,high 10)))))
55          (n 200)
56          (x 0))
57     (dotimes (i n)
58       (setf x (logior x (funcall fun t))))
59     ;; If RANDOM works correctly, x should be #b111...111 (64 ones)
60     ;; with a probability of 1 minus approximately (expt 2 -194).
61     (unless (= x (1- high))
62       (error "bad RANDOM distribution: ~16,16,'0r" x))))
63
64 ;;; Some tests for basic integer RANDOM functionality.
65
66 (with-test (:name (:random :integer :error-if-invalid-random-state))
67   (dolist (optimize '(((speed 0) (compilation-speed 3))
68                       ((speed 3) (compilation-speed 0) (space 0))))
69     (dolist (expr `((lambda (x state)
70                       (declare (optimize ,@optimize))
71                       (random x state))
72                     (lambda (x state)
73                       (declare (optimize ,@optimize))
74                       (declare (type integer x))
75                       (random x state))
76                     (lambda (x state)
77                       (declare (optimize ,@optimize))
78                       (declare (type (integer 100 200) x))
79                       (random x state))
80                     (lambda (x state)
81                       (declare (optimize ,@optimize))
82                       (random (if x 10 20) state))))
83       (let ((fun (compile nil expr)))
84         (assert (raises-error? (funcall fun 150 nil) type-error))))))
85
86 (with-test (:name (:random :integer :distribution))
87   (let ((generic-random (compile nil '(lambda (x)
88                                         (random x)))))
89     ;; Check powers of two: Every bit in the output should be sometimes
90     ;; 0, sometimes 1.
91     (dotimes (e 200)
92       (let* ((number (expt 2 e))
93              (foo (lambda ()
94                     (funcall generic-random number)))
95              (bar (compile nil `(lambda ()
96                                   (declare (optimize speed))
97                                   (random ,number)))))
98         (flet ((test (fun)
99                  (let ((x-and (funcall fun))
100                        (x-ior (funcall fun)))
101                    (dotimes (i 199)
102                      (setf x-and (logand x-and (funcall fun))
103                            x-ior (logior x-ior (funcall fun))))
104                    (assert (= x-and 0))
105                    (assert (= x-ior (1- number))))))
106           (test foo)
107           (test bar))))
108     ;; Test a collection of fixnums and bignums, powers of two and
109     ;; numbers just below and above powers of two, numbers needing one,
110     ;; two or more random chunks etc.
111     (dolist (number (remove-duplicates
112                      `(,@(loop for i from 2 to 11 collect i)
113                        ,@(loop for i in '(29 30 31 32 33 60 61 62 63 64 65)
114                                nconc (list (1- (expt 2 i))
115                                            (expt 2 i)
116                                            (1+ (expt 2 i))))
117                        ,@(loop for i from (1- sb-kernel::n-random-chunk-bits)
118                                to (* sb-kernel::n-random-chunk-bits 4)
119                                collect (* 3 (expt 2 i)))
120                        ,@(loop for i from 2 to sb-vm:n-word-bits
121                                for n = (expt 16 i)
122                                for r = (+ n (random n))
123                                collect r))))
124       (let ((foo (lambda ()
125                    (funcall generic-random number)))
126             (bar (compile nil `(lambda ()
127                                  (declare (optimize speed))
128                                  (random ,number)))))
129         (flet ((test (fun)
130                  (let* ((min (funcall fun))
131                         (max min))
132                    (dotimes (i 9999)
133                      (let ((r (funcall fun)))
134                        (when (< r min)
135                          (setf min r))
136                        (when (> r max)
137                          (setf max r))))
138                    ;; With 10000 trials and an argument of RANDOM below
139                    ;; 70 the probability of the minimum not being 0 is
140                    ;; less than (expt 10 -60), so we can test for that;
141                    ;; correspondingly with the maximum. For larger
142                    ;; arguments we can only test that all results are
143                    ;; in range.
144                    (if (< number 70)
145                        (progn
146                          (assert (= min 0))
147                          (assert (= max (1- number))))
148                        (progn
149                          (assert (>= min 0))
150                          (assert (< max number)))))))
151           (test foo)
152           (test bar))))))