suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Extend random to work with ranges and sequences.

Browse Source 
Requested by Matthias.
This commit is contained in:
Vincent St-Amour 2016-01-02 12:53:18 -06:00
parent 36b3493e45
commit 0796350a88
6 changed files with 133 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/racket-doc/scribblings/reference/numbers.scrbl
View File

@ -842,13 +842,30 @@ both in binary and as integers.
[rand-gen pseudo-random-generator?
(current-pseudo-random-generator)])
exact-nonnegative-integer?]
[(random [min (integer-in 1 4294967087)]
[max (integer-in 1 4294967087)]
[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) (</c 1))])]{
When called with an integer argument @racket[k], returns a random
exact integer in the range @racket[0] to @math{@racket[k]-1}. When
called with zero arguments, returns a random inexact number between
exact integer in the range @racket[0] to @math{@racket[k]-1}.
When called with two integer arguments @racket[min] and @racket[max], returns a
random exact integer in the range @racket[min] to @math{@racket[max]-1}.
When called with a sequence argument @racket[seq], returns a random element of
the sequence. Like @racket[sequence-length], does not terminate on infinite
sequences, and extracts elements up to the returned element.
When called with zero arguments, returns a random inexact number between
@racket[0] and @racket[1], exclusive.
In each case, the number is provided by the given pseudo-random number

20
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -2449,19 +2449,29 @@
(test (begin (random-seed 23) (list (random 10) (random 20) (random 30)))
'random-seed-same
(begin (random-seed 23) (list (random 10) (random 20) (random 30))))
(test (begin (random-seed 23) (list (random 10 20) (random 20 30) (random 30 40)))
'random-seed-same2
(begin (random-seed 23) (list (random 10 20) (random 20 30) (random 30 40))))
(test (begin (random-seed 23) (list (random '(1 2 3)) (random '(4 5 6)) (random '(7 8 9))))
'random-seed-same3
(begin (random-seed 23) (list (random '#(1 2 3)) (random '#(4 5 6)) (random '#(7 8 9)))))
(test (begin (random-seed 23) (list (random '#(1 2 3)) (random '#(4 5 6)) (random '#(7 8 9))))
'random-seed-same4
(begin (random-seed 23) (list (random '#(1 2 3)) (random '#(4 5 6)) (random '#(7 8 9)))))
(arity-test random-seed 1 1)
(arity-test random 0 2)
(arity-test random 0 3)
(err/rt-test (random-seed "apple"))
(err/rt-test (random-seed 4.5))
(err/rt-test (random-seed -1))
(err/rt-test (random-seed (expt 2 31)))
(err/rt-test (random-seed big-num))
(err/rt-test (random "apple"))
(err/rt-test (random 'apple))
(err/rt-test (random 0))
(err/rt-test (random -6))
(err/rt-test (random 4294967088))
(err/rt-test (random (expt 2 32)))
(err/rt-test (random big-num))
(err/rt-test (random 10 5))
(random-seed 101)
(define x (list (random 10) (random 20) (random 30)))
@ -2501,6 +2511,12 @@
(test 5353 random 10000)
(test 8571 random 10000)
(test 9729 random 10000))
(parameterize ([current-pseudo-random-generator
(vector->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 #t = 0 0)
(test #f = 0 (expt 2 32))

28
racket/collects/racket/private/for.rkt
View File

@ -78,6 +78,9 @@
sequence-generate
sequence-generate*
prop:sequence
sequence-length
-sequence-ref
define-sequence-syntax
make-do-sequence
@ -2029,4 +2032,29 @@
#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]))))
)

67
racket/collects/racket/private/pre-base.rkt
View File

@ -97,6 +97,67 @@
(define-values (double-flonum?) ; for symmetry with single-flonum?
(lambda (x) (flonum? x)))
(define-values (enforce-random-int-range)
(lambda (x)
(unless (and (exact-positive-integer? x)
(<= x 4294967087))
(raise-argument-error 'random "(integer-in 1 4294967087)" x))))
(define-values (enforce-greater)
(lambda (x y)
(unless (> y x)
(raise-argument-error
'random
(string-append "integer greater than " (number->string x))
y))))
(define-values (-random) ; more featureful than #%kernel's `random`
(case-lambda
[() (random)] ; no args, random float
[(x)
;; one arg, either random float with prng, or random integer, or random
;; sequence element
(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?)"
x)])]
[(x y)
;; two args, either min and prng, or min and max, or sequence and prng
(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)])]
[else
(raise-argument-error
'random
"(or/c (integer-in 1 4294967087) pseudo-random-generator?)"
y)])]
[(min max prng) ; three args: min, max, and prng
(enforce-random-int-range min)
(enforce-random-int-range max)
(enforce-greater min max)
(unless (pseudo-random-generator? prng)
(raise-argument-error 'random "pseudo-random-generator?" prng))
(+ min (random (- max min) prng))]))
(define-values (new:collection-path)
(let ([collection-path (new-lambda (collection
#:fail [fail (lambda (s)
@ -184,7 +245,8 @@
chaperone-procedure impersonate-procedure
chaperone-procedure* impersonate-procedure*
assq assv assoc
prop:incomplete-arity prop:method-arity-error)
prop:incomplete-arity prop:method-arity-error
random)
(all-from "reqprov.rkt")
(all-from-except "for.rkt"
define-in-vector-like
@ -207,4 +269,5 @@
define-struct/derived
struct-field-index
struct-copy
double-flonum?))
double-flonum?
(rename -random random)))

4
racket/collects/racket/private/sequence.rkt
View File

@ -9,7 +9,9 @@
sequence-ormap
sequence-for-each
sequence-fold
sequence-count)
sequence-count
sequence-length
(rename-out [-sequence-ref sequence-ref]))
(define (sequence-andmap f s)
(unless (procedure? f) (raise-argument-error 'sequence-andmap "procedure?" f))

23
racket/collects/racket/sequence.rkt
View File

@ -39,29 +39,6 @@
(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)