From: Lutz Euler <lutz.euler@freenet.de>
Date: Tue, 1 May 2012 13:57:03 +0000 (+0200)
Subject: Fix the DEFTRANSFORM of RANDOM for hairy integer types.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=18911695a5625fc908b8c07e97d33bf54749a962;p=sbcl.git

Fix the DEFTRANSFORM of RANDOM for hairy integer types.

With integer types that are neither an interval nor a single known value
the DEFTRANSFORM used to generate an expression that had two problems:
First, it yielded very uneven distributions of random values for most
arguments to RANDOM that are not very small. Second, it used a too small
RANDOM-CHUNK under 64 bits word size thus never generating numbers
larger than (1- (EXPT 2 32)) even if RANDOM's argument was larger than
(EXPT 2 32).

Fix this by giving up the transform in these cases.

Add a new file "tests/random.pure.lisp" containing tests for this.
---

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 3efdaa1..8d2eaed 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -97,7 +97,8 @@
         ;; KLUDGE: a relatively conservative treatment, but better
         ;; than a bug (reported by PFD sbcl-devel towards the end of
         ;; 2004-11.
-        '(rem (random-chunk (or state *random-state*)) num))))
+        (give-up-ir1-transform
+         "Argument type is too complex to optimize for."))))
 
 ;;;; float accessors
 
diff --git a/tests/random.pure.lisp b/tests/random.pure.lisp
new file mode 100644
index 0000000..ef0f398
--- /dev/null
+++ b/tests/random.pure.lisp
@@ -0,0 +1,62 @@
+;;;; various RANDOM tests without side effects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+;;; Tests in this file that rely on properties of the distribution of
+;;; the random numbers are designed to be fast and have a very low
+;;; probability of false positives, generally of the order of (expt 10 -60).
+;;; These tests are not intended to assure the statistical qualities of the
+;;; pseudo random number generator but to help find bugs in its and RANDOM's
+;;; implementation.
+
+;; When the type of the argument of RANDOM is a set of integers, a
+;; DEFTRANSFORM triggered that simply generated (REM (RANDOM-CHUNK) NUM),
+;; which has two severe problems: The resulting distribution is very uneven
+;; for most arguments of RANDOM near the size of a random chunk and the
+;; RANDOM-CHUNK used was always 32 bits, even under 64 bit wordsize which
+;; yields even more disastrous distributions.
+(with-test (:name (:random :integer :set-of-integers :distribution))
+  (let* ((high (floor (expt 2 33) 3))
+         (mid (floor high 2))
+         (fun (compile nil `(lambda (x)
+                              (random (if x ,high 10)))))
+         (n1 0)
+         (n 10000))
+    (dotimes (i n)
+      (when (>= (funcall fun t) mid)
+        (incf n1)))
+    ;; Half of the values of (RANDOM HIGH) should be >= MID, so we expect
+    ;; N1 to be binomially distributed such that this distribution can be
+    ;; approximated by a normal distribution with mean (/ N 2) and standard
+    ;; deviation (* (sqrt N) 1/2). The broken RANDOM we are testing here for
+    ;; yields (/ N 3) and (* (sqrt N) (sqrt 2/9)), respectively. We test if
+    ;; N1 is below the average of (/ N 3) and (/ N 2). With a value of N of
+    ;; 10000 this is more than 16 standard deviations away from the expected
+    ;; mean, which has a probability of occurring by chance of below
+    ;; (expt 10 -60).
+    (when (< n1 (* n 5/12))
+      (error "bad RANDOM distribution: expected ~d, got ~d" (/ n 2) n1))))
+
+(with-test (:name (:random :integer :set-of-integers :chunk-size))
+  (let* ((high (expt 2 64))
+         (fun (compile nil `(lambda (x)
+                              (random (if x ,high 10)))))
+         (n 200)
+         (x 0))
+    (dotimes (i n)
+      (setf x (logior x (funcall fun t))))
+    ;; If RANDOM works correctly, x should be #b111...111 (64 ones)
+    ;; with a probability of 1 minus approximately (expt 2 -194).
+    (unless (= x (1- high))
+      (error "bad RANDOM distribution: ~16,16,'0r" x))))