From f1ddc10390c7dfe171c42ca7a9e36714716c6c87 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 29 Apr 2024 08:25:33 -0600 Subject: [PATCH 1/2] repair `pseudo-random-generator-next!` for large integers For an argument exact integer greater than 4294967087, generation of a random integer by piecing together smaller random numbers was broken. It didn't cover the whole range uniformly, and by mistreating the largest part of the integer, it could always produce 0 (e.g., for `(expt 2 32)`). Closes #830 --- mats/5_3.ms | 38 ++++++++++++++++++++------------ release_notes/release_notes.stex | 8 +++++++ s/5_3.ss | 30 ++++++++++++++----------- 3 files changed, 49 insertions(+), 27 deletions(-) diff --git a/mats/5_3.ms b/mats/5_3.ms index 363a92e9e..c26d25fa8 100644 --- a/mats/5_3.ms +++ b/mats/5_3.ms @@ -2809,20 +2809,30 @@ (= 0.970453319804345 (pseudo-random-generator-next! prgen)) (= 0.41754101818626094 (pseudo-random-generator-next! prgen)) (= 0.13061439482676662 (pseudo-random-generator-next! prgen)) - (let ([hits (make-vector 10)]) - (let loop ([i 1000]) - (unless (zero? i) - (let* ([n (pseudo-random-generator-next! prgen (expt 10 1000))] - [k (quotient n (expt 10 999))]) - (vector-set! hits k (add1 (vector-ref hits k))) - (loop (sub1 i))))) - ;; We expect about 100 hits in each bin. Having less than 50 or - ;; more than 150 should be so etxremely unlikely that we can rely on - ;; it not happning: - (let loop ([i (vector-length hits)]) - (or (= i 0) - (and (< 50 (vector-ref hits (sub1 i)) 150) - (loop (sub1 i)))))) + (let nloop ([ns (list (expt 2 31) + (expt 2 32) + (expt 2 33) + (expt 2 64) + (expt 10 1000))]) + (or (null? ns) + (and + (let* ([M 64] + [hits (make-vector M)]) + (let loop ([i (* M 100)]) + (unless (zero? i) + (let* ([n (pseudo-random-generator-next! prgen (car ns))] + [k (quotient n (quotient (car ns) M))]) + (when (>= n (car ns)) (error 'random "too big")) + (vector-set! hits k (add1 (vector-ref hits k))) + (loop (sub1 i))))) + ;; We expect about 100 hits in each bin. Having less than 50 or + ;; more than 150 should be so extremely unlikely that we can rely on + ;; it not happning: + (let loop ([i (vector-length hits)]) + (or (= i 0) + (and (< 50 (vector-ref hits (sub1 i)) 150) + (loop (sub1 i)))))) + (nloop (cdr ns))))) ) diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 74f9f1e40..8e69687db 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -2726,6 +2726,14 @@ in fasl files does not generally make sense. %----------------------------------------------------------------------------- \section{Bug Fixes}\label{section:bugfixes} +\subsection{Random number generation for large exact integers (10.1.0)} + +Given an exact integer greater than 4294967087, +\scheme{pseudo-random-generator-next!} did not produce a valid result. +Generated results did not cover the intended range uniformly, and by +mistreating the largest part of the integer, it could always produce +\scheme{0} (e.g., for \scheme{(expt 2 32)}). + \subsection{Missing memory fences for some platforms (10.1.0)} Compilation for tppc32le lacked memory fences that are needed to diff --git a/s/5_3.ss b/s/5_3.ss index eb328b822..705af585c 100644 --- a/s/5_3.ss +++ b/s/5_3.ss @@ -3156,19 +3156,23 @@ (random-double s)] [(s x) (define (random-integer s x) - (let ([bits (integer-length x)]) - (let loop ([shift 0]) - (cond - [(<= bits shift) 0] - [else - ;; Assuming that a `uptr` is at least 32 bits: - (bitwise-ior (loop (+ shift 32)) - (let ([n (bitwise-bit-field x shift (+ shift 32))]) - (if (zero? n) - 0 - (bitwise-arithmetic-shift-left - (random-int s n) - shift))))])))) + ;; assumes that uptr is at least 32 bits + (let ([maybe-result + ;; get a number that might be too big, because we bump + ;; the high 31-bit digit by one to cover the range created + ;; by lower 31-bit digits (assuming that one of them is non-zero) + (let ([y (- x 1)]) ; might reduce bit width; more than compensated by `(+ z 1)` below + (let loop ([r 0] [len (integer-length y)] [shift 0]) + (if (< len 32) + (let ([z (bitwise-bit-field y shift (+ shift 31))]) + (+ r (bitwise-arithmetic-shift-left (random-int s (+ z 1)) shift))) + (loop (+ r (bitwise-arithmetic-shift-left (random-int s #x80000000) shift)) + (- len 31) + (+ shift 31)))))]) + ;; probably of a bad choice is at most 1/2 + (if (>= maybe-result x) + (random-integer s x) + maybe-result))) (unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s)) (cond [(fixnum? x) From 1d70832b1249e0522e3b7a4418595bc855d01039 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Tue, 30 Apr 2024 11:43:21 -0400 Subject: [PATCH 2/2] fixed two more typos --- mats/5_3.ms | 2 +- s/5_3.ss | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mats/5_3.ms b/mats/5_3.ms index c26d25fa8..dd7542a6a 100644 --- a/mats/5_3.ms +++ b/mats/5_3.ms @@ -2827,7 +2827,7 @@ (loop (sub1 i))))) ;; We expect about 100 hits in each bin. Having less than 50 or ;; more than 150 should be so extremely unlikely that we can rely on - ;; it not happning: + ;; it not happening: (let loop ([i (vector-length hits)]) (or (= i 0) (and (< 50 (vector-ref hits (sub1 i)) 150) diff --git a/s/5_3.ss b/s/5_3.ss index 705af585c..473b8530d 100644 --- a/s/5_3.ss +++ b/s/5_3.ss @@ -3169,7 +3169,7 @@ (loop (+ r (bitwise-arithmetic-shift-left (random-int s #x80000000) shift)) (- len 31) (+ shift 31)))))]) - ;; probably of a bad choice is at most 1/2 + ;; probability of a bad choice is at most 1/2 (if (>= maybe-result x) (random-integer s x) maybe-result)))