check-random-within

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

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

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

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

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 '()]
-

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)

htdp-doc/scribblings/htdp-langs/std-grammar.rkt

@@ -11,14 +11,15 @@
 
 (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
    form ...
    [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}.}
 
 )))
-

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

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

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

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

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

htdp-lib/test-engine/racket-tests.rkt

@@ -4,6 +4,7 @@
 (provide check-expect ;; syntax : (check-expect <expression> <expression>)
          check-random ;; syntax : (check-random <expression> <expression>)
          check-within ;; syntax : (check-within <expression> <expression> <expression>)
+         check-random-within ;; syntax : (check-random-within <expression> <expression> <expression>)
          check-member-of ;; syntax : (check-member-of <expression> <expression>)
          check-range ;; syntax : (check-range <expression> <expression> <expression>)
          check-error  ;; syntax : (check-error <expression> [<expression>])
@@ -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 ()

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))

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))