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 (checked-compile `(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 (checked-compile `(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   (map-optimize-declarations
  68    (lambda (optimize)
  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 (checked-compile expr)))
  84          (assert-error (funcall fun 150 nil) type-error))))
  85    :speed '(0 3) :safety nil :space '(nil 0) :compilation-speed '(0 3)))
  86
  87 (with-test (:name (random integer :distribution))
  88   (let ((generic-random (checked-compile '(lambda (x)
  89                                             (random x)))))
  90     ;; Check powers of two: Every bit in the output should be sometimes
  91     ;; 0, sometimes 1.
  92     (dotimes (e 200)
  93       (let* ((number (expt 2 e))
  94              (foo (lambda ()
  95                     (funcall generic-random number)))
  96              (bar (checked-compile `(lambda ()
  97                                       (declare (optimize speed))
  98                                       (random ,number)))))
  99         (flet ((test (fun)
 100                  (let ((x-and (funcall fun))
 101                        (x-ior (funcall fun)))
 102                    (dotimes (i 199)
 103                      (setf x-and (logand x-and (funcall fun))
 104                            x-ior (logior x-ior (funcall fun))))
 105                    (assert (= x-and 0))
 106                    (assert (= x-ior (1- number))))))
 107           (test foo)
 108           (test bar))))
 109     ;; Test a collection of fixnums and bignums, powers of two and
 110     ;; numbers just below and above powers of two, numbers needing one,
 111     ;; two or more random chunks etc.
 112     (dolist (number (remove-duplicates
 113                      `(,@(loop for i from 2 to 11 collect i)
 114                        ,@(loop for i in '(29 30 31 32 33 60 61 62 63 64 65)
 115                                nconc (list (1- (expt 2 i))
 116                                            (expt 2 i)
 117                                            (1+ (expt 2 i))))
 118                        ,@(loop for i from (1- sb-kernel::n-random-chunk-bits)
 119                                to (* sb-kernel::n-random-chunk-bits 4)
 120                                collect (* 3 (expt 2 i)))
 121                        ,@(loop for i from 2 to sb-vm:n-word-bits
 122                                for n = (expt 16 i)
 123                                for r = (+ n (random n))
 124                                collect r))))
 125       (let ((foo (lambda ()
 126                    (funcall generic-random number)))
 127             (bar (checked-compile `(lambda ()
 128                                      (declare (optimize speed))
 129                                      (random ,number)))))
 130         (flet ((test (fun)
 131                  (let* ((min (funcall fun))
 132                         (max min))
 133                    (dotimes (i 9999)
 134                      (let ((r (funcall fun)))
 135                        (when (< r min)
 136                          (setf min r))
 137                        (when (> r max)
 138                          (setf max r))))
 139                    ;; With 10000 trials and an argument of RANDOM below
 140                    ;; 70 the probability of the minimum not being 0 is
 141                    ;; less than (expt 10 -60), so we can test for that;
 142                    ;; correspondingly with the maximum. For larger
 143                    ;; arguments we can only test that all results are
 144                    ;; in range.
 145                    (if (< number 70)
 146                        (progn
 147                          (assert (= min 0))
 148                          (assert (= max (1- number))))
 149                        (progn
 150                          (assert (>= min 0))
 151                          (assert (< max number)))))))
 152           (test foo)
 153           (test bar))))))