From 229c4dceffac0ed55045ed12702784682c452dbc Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sat, 27 Jun 2026 15:54:50 -0400 Subject: [PATCH] Add check-random-within to the teaching languages check-random-within combines check-random and check-within: the test and expected expressions are evaluated with the same freshly-seeded pseudo-random generator (like check-random), and the two results are then compared up to a tolerance (like check-within). This is the form to use when a random computation produces inexact numbers, which check-random refuses to compare. - test-engine/racket-tests: add the check-random-within syntax and do-check-random-within, and provide it. - lang/htdp-{beginner,beginner-abbr,intermediate,intermediate-lambda, advanced}: export check-random-within to the student languages. - typed/test-engine/type-env-ext: give do-check-random-within a type. - htdp-doc .../prim-ops: document the new form. - htdp-test .../test-engine/racket-tests: test pass, failure, and the non-number-tolerance error. Supersedes the stale draft in #95, which predated the rewrite of check-random into do-check-random. (Grammar BNF listing in std-grammar.rkt + per-language .scrbl is a remaining follow-up.) --- htdp-doc/scribblings/htdp-langs/prim-ops.rkt | 22 ++++++++++++- htdp-lib/lang/htdp-advanced.rkt | 1 + htdp-lib/lang/htdp-beginner-abbr.rkt | 1 + htdp-lib/lang/htdp-beginner.rkt | 1 + htdp-lib/lang/htdp-intermediate-lambda.rkt | 1 + htdp-lib/lang/htdp-intermediate.rkt | 1 + htdp-lib/test-engine/racket-tests.rkt | 33 ++++++++++++++++++++ htdp-lib/typed/test-engine/type-env-ext.rkt | 8 ++++- htdp-test/tests/test-engine/racket-tests.rkt | 22 +++++++++++++ 9 files changed, 88 insertions(+), 2 deletions(-) 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-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))