diff --git a/htdp-doc/scribblings/htdp-langs/advanced.scrbl b/htdp-doc/scribblings/htdp-langs/advanced.scrbl index fd25cb8e..523f1e19 100644 --- a/htdp-doc/scribblings/htdp-langs/advanced.scrbl +++ b/htdp-doc/scribblings/htdp-langs/advanced.scrbl @@ -17,10 +17,10 @@ local let let* letrec time begin begin0 set! delay shared recur when case match unless ; match _ cons list list* struct vector box - check-expect check-random check-within check-member-of + check-expect check-random check-within check-random-within check-member-of check-range check-error check-satisfied : signature enum mixed -> ListOf) -(expr check-satisfied check-expect check-random check-within check-error check-member-of check-range require) +(expr check-satisfied check-expect check-random check-within check-random-within check-error check-member-of check-range require) [program (code:line def-or-expr #, @dots)] [def-or-expr definition expr @@ -323,6 +323,7 @@ level as they did in the @secref["intermediate-lam"] level. check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-doc/scribblings/htdp-langs/beginner-abbr.scrbl b/htdp-doc/scribblings/htdp-langs/beginner-abbr.scrbl index b27e4f12..751861ba 100644 --- a/htdp-doc/scribblings/htdp-langs/beginner-abbr.scrbl +++ b/htdp-doc/scribblings/htdp-langs/beginner-abbr.scrbl @@ -16,9 +16,9 @@ @racketgrammar*+qq[ #:literals (define define-struct lambda cond else if and or require lib planet - check-expect check-random check-within check-error check-satisfied + check-expect check-random check-within check-random-within check-error check-satisfied : signature enum mixed -> ListOf) -(name check-satisfied check-expect check-random check-within check-member-of check-range check-error require) +(name check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) [program (code:line def-or-expr #, @dots)] [def-or-expr definition expr @@ -89,6 +89,7 @@ Abbreviations} level as they did in the @secref["beginner"] level. check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-doc/scribblings/htdp-langs/beginner.scrbl b/htdp-doc/scribblings/htdp-langs/beginner.scrbl index 94c17826..558117fe 100644 --- a/htdp-doc/scribblings/htdp-langs/beginner.scrbl +++ b/htdp-doc/scribblings/htdp-langs/beginner.scrbl @@ -15,9 +15,9 @@ @racketgrammar*+library[ #:literals (define define-struct lambda cond else if and or require lib planet - check-expect check-random check-within check-error check-satisfied + check-expect check-random check-within check-random-within check-error check-satisfied : signature enum mixed -> ListOf) -(name check-satisfied check-expect check-random check-within check-member-of check-range check-error require) +(name check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) [program (code:line def-or-expr #, @dots)] [def-or-expr definition expr @@ -84,6 +84,7 @@ A quoted @racket[name] is a symbol. A symbol is a value, just like check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-doc/scribblings/htdp-langs/intermediate-lambda.scrbl b/htdp-doc/scribblings/htdp-langs/intermediate-lambda.scrbl index c2edba16..57762c02 100644 --- a/htdp-doc/scribblings/htdp-langs/intermediate-lambda.scrbl +++ b/htdp-doc/scribblings/htdp-langs/intermediate-lambda.scrbl @@ -13,9 +13,9 @@ @racketgrammar*+qq[ #:literals (define define-struct lambda λ cond else if and or require lib planet local let let* letrec time check-expect check-random - check-within check-member-of check-range check-error check-satisfied + check-within check-random-within check-member-of check-range check-error check-satisfied : signature enum mixed -> ListOf) -(expr check-satisfied check-expect check-random check-within check-member-of check-range check-error require) +(expr check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) [program (code:line def-or-expr #, @dots)] [def-or-expr definition expr @@ -128,6 +128,7 @@ level as they did in the @secref["intermediate"] level. check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-doc/scribblings/htdp-langs/intermediate.scrbl b/htdp-doc/scribblings/htdp-langs/intermediate.scrbl index f2c1e3e0..a7132890 100644 --- a/htdp-doc/scribblings/htdp-langs/intermediate.scrbl +++ b/htdp-doc/scribblings/htdp-langs/intermediate.scrbl @@ -13,9 +13,9 @@ @racketgrammar*+qq[ #:literals (define define-struct lambda cond else if and or require lib planet - local let let* letrec time check-expect check-random check-within check-error check-satisfied + local let let* letrec time check-expect check-random check-within check-random-within check-error check-satisfied : signature enum mixed -> ListOf) -(expr check-satisfied check-expect check-random check-within check-member-of check-range check-error require) +(expr check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) [program (code:line def-or-expr #, @dots)] [def-or-expr definition expr @@ -102,6 +102,7 @@ did in the @secref["beginner-abbr"] level. check-random check-satisfied check-within + check-random-within check-error check-member-of check-range @@ -124,4 +125,3 @@ did in the @secref["beginner-abbr"] level. @(render-sections (docs) #'here "htdp-intermediate") @;prim-op-defns['(lib "htdp-intermediate.rkt" "lang") #'here '()] - diff --git a/htdp-doc/scribblings/htdp-langs/prim-ops.rkt b/htdp-doc/scribblings/htdp-langs/prim-ops.rkt index 0bb27b2d..f8b7b9a7 100644 --- a/htdp-doc/scribblings/htdp-langs/prim-ops.rkt +++ b/htdp-doc/scribblings/htdp-langs/prim-ops.rkt @@ -170,6 +170,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range @@ -187,6 +188,7 @@ #'check-random @racket[check-random] #'check-satisfied @racket[check-satisfied] #'check-within @racket[check-within] + #'check-random-within @racket[check-random-within] #'check-error @racket[check-error] #'check-member-of @racket[check-member-of] #'check-range @racket[check-range] @@ -204,6 +206,7 @@ check-random-id check-random-elem check-satisfied-id check-satisfied-elem check-within-id check-within-elem + check-random-within-id check-random-within-elem check-error-id check-error-elem check-member-of-id check-member-of-elem check-range-id check-range-elem @@ -544,7 +547,24 @@ In contrast, when @racket[delta] is small, the test fails: It is an error for @racket[expressions] or @racket[expected-expression] to produce a function value; see note on @racket[check-expect] for details. - If @racket[delta] is not a number, @check-within-elem reports an error.} + If @racket[delta] is not a number, @check-within-elem reports an error.} + + @defform*[#:id [check-random-within check-random-within-id] + [(check-random-within expression expected-expression delta)]]{ + + Combines @racket[check-random] and @racket[check-within]. Like + @racket[check-random], @racket[expression] and + @racket[expected-expression] are evaluated with the same random-number + sequence, so calls to @racket[random] in both expressions draw the same + numbers. Like @racket[check-within], the test then succeeds if every number + in the value of @racket[expression] is within @racket[delta] of the + corresponding number in the value of @racket[expected-expression]. + + Use @racket[check-random-within] in place of @racket[check-random] when the + random computation produces inexact numbers, which @racket[check-random] + refuses to compare. + + If @racket[delta] is not a number, @check-random-within-elem reports an error.} @defform*[#:id [check-error check-error-id] [(check-error expression expected-error-message) diff --git a/htdp-doc/scribblings/htdp-langs/std-grammar.rkt b/htdp-doc/scribblings/htdp-langs/std-grammar.rkt index 82aa84d4..ec47d33a 100644 --- a/htdp-doc/scribblings/htdp-langs/std-grammar.rkt +++ b/htdp-doc/scribblings/htdp-langs/std-grammar.rkt @@ -11,7 +11,7 @@ (define-syntax-rule (racketgrammar*+library #:literals lits - (rhs-satisfied check-satisfied check-expect check-random check-within check-member-of check-range check-error require) + (rhs-satisfied check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) form ...) (racketgrammar* #:literals lits @@ -19,6 +19,7 @@ [test-case @#,racket[(check-expect expr expr)] @#,racket[(check-random expr expr)] @#,racket[(check-within expr expr expr)] + @#,racket[(check-random-within expr expr expr)] @#,racket[(check-member-of expr expr (... ...))] @#,racket[(check-range expr expr expr)] @#,racket[(check-satisfied expr rhs-satisfied)] @@ -33,11 +34,11 @@ (define-syntax-rule (racketgrammar*+qq #:literals lits - (rhs-satisfied check-satisfied check-expect check-random check-within check-member-of check-range check-error require) + (rhs-satisfied check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) form ...) (racketgrammar*+library #:literals lits - (rhs-satisfied check-satisfied check-expect check-random check-within check-member-of check-range check-error require) + (rhs-satisfied check-satisfied check-expect check-random check-within check-random-within check-member-of check-range check-error require) form ... (... [quoted name @@ -100,4 +101,3 @@ with @racket[define] or @racket[define-struct], or any one of the @seclink[(string-append section-prefix "-pre-defined")]{pre-defined functions}.} ))) - diff --git a/htdp-lib/lang/htdp-advanced.rkt b/htdp-lib/lang/htdp-advanced.rkt index 6e831a00..deea1a5d 100644 --- a/htdp-lib/lang/htdp-advanced.rkt +++ b/htdp-lib/lang/htdp-advanced.rkt @@ -59,6 +59,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-lib/lang/htdp-beginner-abbr.rkt b/htdp-lib/lang/htdp-beginner-abbr.rkt index 533fe3ee..e8988e70 100644 --- a/htdp-lib/lang/htdp-beginner-abbr.rkt +++ b/htdp-lib/lang/htdp-beginner-abbr.rkt @@ -42,6 +42,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-lib/lang/htdp-beginner.rkt b/htdp-lib/lang/htdp-beginner.rkt index e212f796..d6ad3653 100644 --- a/htdp-lib/lang/htdp-beginner.rkt +++ b/htdp-lib/lang/htdp-beginner.rkt @@ -46,6 +46,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-lib/lang/htdp-intermediate-lambda.rkt b/htdp-lib/lang/htdp-intermediate-lambda.rkt index 698d405b..67073695 100644 --- a/htdp-lib/lang/htdp-intermediate-lambda.rkt +++ b/htdp-lib/lang/htdp-intermediate-lambda.rkt @@ -46,6 +46,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-lib/lang/htdp-intermediate.rkt b/htdp-lib/lang/htdp-intermediate.rkt index 110b5f4a..d5a2501a 100644 --- a/htdp-lib/lang/htdp-intermediate.rkt +++ b/htdp-lib/lang/htdp-intermediate.rkt @@ -48,6 +48,7 @@ check-random check-satisfied check-within + check-random-within check-error check-member-of check-range diff --git a/htdp-lib/test-engine/racket-tests.rkt b/htdp-lib/test-engine/racket-tests.rkt index fef454f2..5f82f2a2 100644 --- a/htdp-lib/test-engine/racket-tests.rkt +++ b/htdp-lib/test-engine/racket-tests.rkt @@ -4,6 +4,7 @@ (provide check-expect ;; syntax : (check-expect ) check-random ;; syntax : (check-random ) check-within ;; syntax : (check-within ) + check-random-within ;; syntax : (check-random-within ) check-member-of ;; syntax : (check-member-of ) check-range ;; syntax : (check-range ) check-error ;; syntax : (check-error []) @@ -235,6 +236,38 @@ (lambda (exn) (unexpected-error/check-* src expected exn (exn->markup exn) 'check-within)))) +(define-syntax (check-random-within stx) + (check-context! 'check-random-within CHECK-WITHIN-DEFN-STR stx) + (syntax-case stx () + [(_ e1 e2 within) + (let ([test #`(lambda () e1)] + [args (list #`(lambda () e2) #`within)]) + (check-expect-maker stx #'do-check-random-within test args 'comes-from-check-random))] + [_ (raise-syntax-error 'check-random-within (argcount-error-message/stx 3 stx) stx)])) + +;; Like check-random, the test and expected expressions are evaluated +;; with the same freshly-seeded pseudo-random generator; like check-within, +;; the two results are compared up to the `within` tolerance. +(define (do-check-random-within test expected-thunk within src) + (error-check number? within CHECK-WITHIN-INEXACT-FMT #t) + (let ((rng (make-pseudo-random-generator)) + (k (modulo (current-milliseconds) (sub1 (expt 2 31))))) + (let ((expected (parameterize ([current-pseudo-random-generator rng]) + (random-seed k) + (expected-thunk)))) + (error-check (lambda (v) (not (procedure? v))) expected CHECK-WITHIN-FUNCTION-FMT #t) + (execute-test + src + (lambda () + (let ((actual (parameterize ([current-pseudo-random-generator rng]) + (random-seed k) + ((test))))) + (if (beginner-equal~? actual expected within) + #t + (not-within src actual expected within)))) + (lambda (exn) + (unexpected-error/check-* src expected exn (exn->markup exn) 'check-random)))))) + (define-syntax (check-error stx) (check-context! 'check-error CHECK-ERROR-DEFN-STR stx) (syntax-case stx () diff --git a/htdp-lib/typed/test-engine/type-env-ext.rkt b/htdp-lib/typed/test-engine/type-env-ext.rkt index d99fc1f8..cfe77fcc 100644 --- a/htdp-lib/typed/test-engine/type-env-ext.rkt +++ b/htdp-lib/typed/test-engine/type-env-ext.rkt @@ -61,6 +61,12 @@ [(define-values _ (add-check-expect-test! (lambda () (do-check-random _ _ _)))) #'do-check-random]) - ((-> Univ) (-> Univ) Univ . -> . -Boolean)])) + ((-> Univ) (-> Univ) Univ . -> . -Boolean)] + [(syntax-parse (local-expand #'(ce:check-random-within 1 1 1) 'module #f) + #:literals (define-values) + [(define-values _ + (add-check-expect-test! (lambda () (do-check-random-within _ _ _ _)))) + #'do-check-random-within]) + ((-> Univ) (-> Univ) -Real Univ . -> . -Boolean)])) (begin-for-syntax (initialize-type-env ce-env)) diff --git a/htdp-test/tests/test-engine/racket-tests.rkt b/htdp-test/tests/test-engine/racket-tests.rkt index acfac3f5..ea79c66c 100644 --- a/htdp-test/tests/test-engine/racket-tests.rkt +++ b/htdp-test/tests/test-engine/racket-tests.rkt @@ -382,6 +382,28 @@ (check-random (h 0) (list (random 20) (random 50) (random 70) (random 100))) (check-failure unequal?) +;; check-random-within: both expressions use the same seeded random +;; sequence, and results are compared up to a tolerance. Unlike +;; check-random, inexact results are allowed. +(check-random-within (exact->inexact (random 100)) + (exact->inexact (random 100)) + 0.001) +(check-success) + +;; Same seed, but the expected value is shifted past the tolerance. +(check-random-within (random 100) (+ 50 (random 100)) 0.001) +(check-failure not-within?) + +;; A non-number tolerance is an error. +(check-random-within 1.0 1.0 "0.1") +(check-exn + (lambda (e) + (initialize-test-object!) + (and (exn:fail:contract? e) + (regexp-match? #rx"\"0[.]1\" is not inexact" (exn-message e)))) + (lambda () + (run-tests!))) + (check-property (for-all ((a Integer) (b Integer))