check-random-within

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