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

Generator support for natural', integer', and `real' patterns.

Browse Source 
svn: r13961
This commit is contained in:
Casey Klein 2009-03-04 21:13:57 +00:00
parent cf66f23dc8
commit c4524ef9ae
2 changed files with 61 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/redex/private/rg-test.ss
View File

@ -81,6 +81,10 @@
(test (pick-number 2624 (make-random 0 0 0 0 1 1 1/5 1/5 2 .5 0 .5))
(make-rectangular 7/8 -3.0))
(test (pick-natural 224 (make-random 1/5)) 5)
(test (pick-integer 900 (make-random 0 0 1/5)) -7)
(test (pick-real 9000 (make-random 0 0 0 .5 1 1/8)) 11.0)
(let* ([lits '("bcd" "cbd")]
[chars (sort (unique-chars lits) char<=?)])
(test (pick-char 0 chars (make-random 1)) #\c)
@ -148,6 +152,9 @@
#:nt [nt pick-nt]
#:str [str pick-string]
#:num [num pick-number]
#:nat [nat pick-natural]
#:int [int pick-integer]
#:real [real pick-real]
#:any [any pick-any]
#:seq [seq pick-sequence-length]
#:pref [pref pick-preferred-productions])
@ -158,6 +165,9 @@
(define next-variable-decision (decision var))
(define next-non-terminal-decision (decision nt))
(define next-number-decision (decision num))
(define next-natural-decision (decision nat))
(define next-integer-decision (decision int))
(define next-real-decision (decision real))
(define next-string-decision (decision str))
(define next-any-decision (decision any))
(define next-sequence-decision (decision seq))
@ -236,6 +246,24 @@
(decisions #:var (list (λ _ 'x) (λ _ 'y) (λ _ 'x) (λ _ 'z))))
'z))
(let ()
(define-language L
(n natural)
(i integer)
(r real))
(test (let ([n (generate-term L n 0 #:attempt 10000)])
(and (integer? n)
(exact? n)
(not (negative? n))))
#t)
(test (generate-term/decisions L n 0 1 (decisions #:nat (λ (_) 42))) 42)
(test (let ([i (generate-term L i 0 #:attempt 10000)])
(and (integer? i) (exact? i)))
#t)
(test (generate-term/decisions L i 0 1 (decisions #:int (λ (_) -42))) -42)
(test (real? (generate-term L r 0 #:attempt 10000)) #t)
(test (generate-term/decisions L r 0 1 (decisions #:real (λ (_) 4.2))) 4.2))
(let ()
(define-language lang
(a (number number ... "foo" ... "bar" #t ...))

44
collects/redex/private/rg.ss
View File

@ -153,16 +153,28 @@ To do a better job of not generating programs with free variables,
(define (attempt->size n)
(inexact->exact (floor (/ (log (add1 n)) (log 5)))))
(define (pick-number attempt [random random])
(cond [(or (< attempt integer-threshold) (not (exotic-choice? random)))
(random-natural (expected-value->p (attempt->size attempt)) random)]
[(or (< attempt rational-threshold) (not (exotic-choice? random)))
(random-integer (expected-value->p (attempt->size (- attempt integer-threshold))) random)]
[(or (< attempt real-threshold) (not (exotic-choice? random)))
(random-rational (expected-value->p (attempt->size (- attempt rational-threshold))) random)]
[(or (< attempt complex-threshold) (not (exotic-choice? random)))
(random-real (expected-value->p (attempt->size (- attempt real-threshold))) random)]
[else (random-complex (expected-value->p (attempt->size (- attempt complex-threshold))) random)]))
(define (pick-number attempt #:top-threshold [top-threshold complex-threshold] [random random])
(let loop ([threshold 0]
[generator random-natural]
[levels `((,integer-threshold . ,random-integer)
(,rational-threshold . ,random-rational)
(,real-threshold . ,random-real)
(,complex-threshold . ,random-complex))])
(if (or (null? levels)
(< attempt (caar levels))
(< top-threshold (caar levels))
(not (exotic-choice? random)))
(generator (expected-value->p (attempt->size (- attempt threshold))) random)
(loop (caar levels) (cdar levels) (cdr levels)))))
(define (pick-natural attempt [random random])
(pick-number attempt #:top-threshold 0 random))
(define (pick-integer attempt [random random])
(pick-number attempt #:top-threshold integer-threshold random))
(define (pick-real attempt [random random])
(pick-number attempt #:top-threshold real-threshold random))
(define (pick-sequence-length attempt)
(random-natural (expected-value->p (attempt->size attempt))))
@ -309,6 +321,9 @@ To do a better job of not generating programs with free variables,
(match pat
[`number (values ((next-number-decision) attempt) state)]
[`natural (values ((next-natural-decision) attempt) state)]
[`integer (values ((next-integer-decision) attempt) state)]
[`real (values ((next-real-decision) attempt) state)]
[`(variable-except ,vars ...)
(generate/pred 'variable
(recur/pat/size-attempt 'variable)
@ -875,6 +890,9 @@ To do a better job of not generating programs with free variables,
(define-signature decisions^
(next-variable-decision
next-number-decision
next-natural-decision
next-integer-decision
next-real-decision
next-non-terminal-decision
next-sequence-decision
next-any-decision
@ -885,6 +903,9 @@ To do a better job of not generating programs with free variables,
(unit (import) (export decisions^)
(define (next-variable-decision) pick-var)
(define (next-number-decision) pick-number)
(define (next-natural-decision) pick-natural)
(define (next-integer-decision) pick-integer)
(define (next-real-decision) pick-real)
(define (next-non-terminal-decision) pick-nt)
(define (next-sequence-decision) pick-sequence-length)
(define (next-any-decision) pick-any)
@ -899,7 +920,8 @@ To do a better job of not generating programs with free variables,
class-reassignments reassign-classes unparse-pattern
(struct-out ellipsis) (struct-out mismatch) (struct-out class)
(struct-out binder) check-metafunction-contract prepare-lang
pick-number parse-language check-reduction-relation
pick-number pick-natural pick-integer pick-real
parse-language check-reduction-relation
preferred-production-threshold check-metafunction
generation-decisions pick-preferred-productions
default-retries proportion-at-size retry-threshold