diff --git a/pkgs/racket-doc/scribblings/reference/numbers.scrbl b/pkgs/racket-doc/scribblings/reference/numbers.scrbl index 0817ec2de8..28e2c7121c 100644 --- a/pkgs/racket-doc/scribblings/reference/numbers.scrbl +++ b/pkgs/racket-doc/scribblings/reference/numbers.scrbl @@ -847,10 +847,6 @@ both in binary and as integers. [rand-gen pseudo-random-generator? (current-pseudo-random-generator)]) exact-nonnegative-integer?] - [(random [seq sequence?] - [rand-gen pseudo-random-generator? - (current-pseudo-random-generator)]) - any/c] [(random [rand-gen pseudo-random-generator? (current-pseudo-random-generator)]) (and/c real? inexact? (>/c 0) (pseudo-random-generator #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638))]) - (test 3 random '(1 2 3 4 5)) - (test 10 random '#(7 6 8 9 10)) - (test #\e random "abcde")) + (test 3 random-ref '(1 2 3 4 5)) + (test 10 random-ref '#(7 6 8 9 10)) + (test #\e random-ref "abcde")) +(parameterize ([current-pseudo-random-generator + (vector->pseudo-random-generator + #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638))]) + (test '(3) random-sample '(1 2 3 4 5) 1) + (test '(5 5 5) random-sample '(1 2 3 4 5) 3) + (test '(2 4 5) random-sample '(1 2 3 4 5) 3 #:replacement? #f)) + (test #t = 0 0) (test #f = 0 (expt 2 32)) diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index 12851138ec..c95664af1a 100644 --- a/racket/collects/racket/private/for.rkt +++ b/racket/collects/racket/private/for.rkt @@ -78,9 +78,6 @@ sequence-generate sequence-generate* prop:sequence - sequence-length - - -sequence-ref define-sequence-syntax make-do-sequence @@ -2032,29 +2029,4 @@ #true [(next-body l d init-dir use-dir?)])]]))) - (define-values (sequence-length) - (λ (s) - (unless (sequence? s) (raise-argument-error 'sequence-length "sequence?" s)) - (for/fold ([c 0]) ([i (in-values*-sequence s)]) - (add1 c)))) - - (define-values (-sequence-ref) - (λ (s i) - (unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s)) - (unless (exact-nonnegative-integer? i) - (raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i)) - (let-values ([(v) (for/fold ([c #f]) ([v (in-values*-sequence s)] - [j (in-range (add1 i))] - #:unless (j . < . i)) - (or v '(#f)))]) - (cond - [(not v) - (raise-arguments-error - 'sequence-ref - "sequence ended before index" - "index" i - "sequence" s)] - [(list? v) (apply values v)] - [else v])))) - ) diff --git a/racket/collects/racket/private/pre-base.rkt b/racket/collects/racket/private/pre-base.rkt index 15986c49bc..b0e4575df4 100644 --- a/racket/collects/racket/private/pre-base.rkt +++ b/racket/collects/racket/private/pre-base.rkt @@ -113,38 +113,27 @@ (case-lambda [() (random)] ; no args, random float [(x) - ;; one arg, either random float with prng, or random integer, or random - ;; sequence element + ;; one arg, either random float with prng, or random integer (cond [(exact-positive-integer? x) (enforce-random-int-range x) (random x)] [(pseudo-random-generator? x) (random x)] - [(sequence? x) - (-sequence-ref x (random (sequence-length x)))] [else (raise-argument-error 'random - "(or/c (integer-in 1 4294967087) sequence? pseudo-random-generator?)" + "(or/c (integer-in 1 4294967087) pseudo-random-generator?)" x)])] [(x y) - ;; two args, either min and prng, or min and max, or sequence and prng + ;; two args, either min and prng, or min and max (cond [(exact-positive-integer? y) ; min and max case (enforce-random-int-range x) (enforce-random-int-range y) (enforce-greater x y) (+ x (random (- y x)))] - [(pseudo-random-generator? y) - (cond [(exact-positive-integer? x) ; int and prng case - (enforce-random-int-range x) - (random x y)] - [(sequence? x) ; sequence and prng case - (-sequence-ref x (random (sequence-length x) y))] - [else - (raise-argument-error - 'random - "(or/c (integer-in 1 4294967087) sequence?)" - x)])] + [(pseudo-random-generator? y) ; int and prng case + (enforce-random-int-range x) + (random x y)] [else (raise-argument-error 'random diff --git a/racket/collects/racket/private/sequence.rkt b/racket/collects/racket/private/sequence.rkt index 4c199d9251..3c25917e3a 100644 --- a/racket/collects/racket/private/sequence.rkt +++ b/racket/collects/racket/private/sequence.rkt @@ -9,9 +9,7 @@ sequence-ormap sequence-for-each sequence-fold - sequence-count - sequence-length - (rename-out [-sequence-ref sequence-ref])) + sequence-count) (define (sequence-andmap f s) (unless (procedure? f) (raise-argument-error 'sequence-andmap "procedure?" f)) diff --git a/racket/collects/racket/random.rkt b/racket/collects/racket/random.rkt index 2978444c9b..83955dbc2b 100644 --- a/racket/collects/racket/random.rkt +++ b/racket/collects/racket/random.rkt @@ -1,7 +1,13 @@ #lang racket/base -(require "private/unix-rand.rkt" "private/windows-rand.rkt" racket/contract/base) -(provide (contract-out [crypto-random-bytes (-> exact-nonnegative-integer? bytes?)])) +(require "private/unix-rand.rkt" "private/windows-rand.rkt" + racket/contract/base racket/sequence racket/set) +(provide (contract-out [crypto-random-bytes (-> exact-nonnegative-integer? bytes?)] + [random-ref (->* (sequence?) (pseudo-random-generator?) any/c)] + [random-sample (->* (sequence? exact-nonnegative-integer?) + (pseudo-random-generator? + #:replacement? any/c) + (listof any/c))])) ; (: crypto-random-bytes (-> Positive-Integer Bytes)) ; returns n random bytes from the os. @@ -12,3 +18,25 @@ [else (raise (make-exn:fail:unsupported "not supported on the current platform" (current-continuation-marks)))])) + +(define (random-ref seq [prng (current-pseudo-random-generator)]) + (sequence-ref seq (random (sequence-length seq)))) + +(define (random-sample seq n [prng (current-pseudo-random-generator)] + #:replacement? [replacement? #t]) + (cond [replacement? + (for/list ([i (in-range n)]) + (random-ref seq prng))] + [else + (unless (>= (sequence-length seq) n) + (raise-argument-error 'random-sample + "integer less than sequence length" + n)) + (define l (sequence-length seq)) + ;; sequences don't necessarily support removal, so instead sample + ;; indices without replacement, then index into the sequence + (let loop ([res-idx (set)]) + (cond [(= (set-count res-idx) n) ; we have all we need, we're done + (for/list ([i (in-set res-idx)]) (sequence-ref seq i))] + [else + (loop (set-add res-idx (random l)))]))])) diff --git a/racket/collects/racket/sequence.rkt b/racket/collects/racket/sequence.rkt index 51d98f1996..cd68cd305c 100644 --- a/racket/collects/racket/sequence.rkt +++ b/racket/collects/racket/sequence.rkt @@ -39,6 +39,29 @@ (define (sequence->list s) (for/list ([v s]) v)) +(define (sequence-length s) + (unless (sequence? s) (raise-argument-error 'sequence-length "sequence?" s)) + (for/fold ([c 0]) ([i (in-values*-sequence s)]) + (add1 c))) + +(define (sequence-ref s i) + (unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s)) + (unless (exact-nonnegative-integer? i) + (raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i)) + (let ([v (for/fold ([c #f]) ([v (in-values*-sequence s)] + [j (in-range (add1 i))] + #:unless (j . < . i)) + (or v '(#f)))]) + (cond + [(not v) + (raise-arguments-error + 'sequence-ref + "sequence ended before index" + "index" i + "sequence" s)] + [(list? v) (apply values v)] + [else v]))) + (define (sequence-tail seq i) (unless (sequence? seq) (raise-argument-error 'sequence-tail "sequence?" seq)) (unless (exact-nonnegative-integer? i)