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

nats/e -> nat/e

Browse Source
This commit is contained in:
Max New 2014-04-12 17:18:49 -05:00 committed by Robby Findler
parent 68421f05dd
commit f309685999
3 changed files with 51 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
View File

@ -121,7 +121,7 @@
[`any any/e] [`any any/e]
[`number num/e] [`number num/e]
[`string string/e] [`string string/e]
[`natural nats/e] [`natural nat/e]
[`integer integer/e] [`integer integer/e]
[`real real/e] [`real real/e]
[`boolean bool/e] [`boolean bool/e]

33
pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt
View File

@ -58,9 +58,9 @@
take/e take/e
fold-enum fold-enum
nats/e nat/e
range/e range/e
nats+/e nat+/e
;; Base type enumerators ;; Base type enumerators
any/e any/e
@ -216,14 +216,11 @@
(define (fin/e . args) (from-list/e (remove-duplicates args))) (define (fin/e . args) (from-list/e (remove-duplicates args)))
(define nats/e (define nat/e
(enum +inf.0 (enum +inf.0
identity identity
(λ (n) identity))
(unless (>= n 0) (define int/e
(redex-error 'encode "Not a natural"))
n)))
(define ints/e
(enum +inf.0 (enum +inf.0
(λ (n) (λ (n)
(if (even? n) (if (even? n)
@ -785,24 +782,24 @@
(cond [(> low high) (redex-error 'range/e "invalid range: ~s, ~s" low high)] (cond [(> low high) (redex-error 'range/e "invalid range: ~s, ~s" low high)]
[(infinite? high) [(infinite? high)
(if (infinite? low) (if (infinite? low)
ints/e int/e
(map/e (map/e
(λ (n) (λ (n)
(+ n low)) (+ n low))
(λ (n) (λ (n)
(- n low)) (- n low))
nats/e))] nat/e))]
[(infinite? low) [(infinite? low)
(map/e (map/e
(λ (n) (λ (n)
(- high n)) (- high n))
(λ (n) (λ (n)
(+ high n)) (+ high n))
nats/e)] nat/e)]
[else [else
(map/e (λ (n) (+ n low)) (map/e (λ (n) (+ n low))
(λ (n) (- n low)) (λ (n) (- n low))
(take/e nats/e (+ 1 (- high low))))])) (take/e nat/e (+ 1 (- high low))))]))
;; thunk/e : Nat or +-Inf, ( -> enum a) -> enum a ;; thunk/e : Nat or +-Inf, ( -> enum a) -> enum a
(define (thunk/e s thunk) (define (thunk/e s thunk)
@ -1070,7 +1067,7 @@
[1 (const/e `(,bound))] [1 (const/e `(,bound))]
[_ [_
(define smallers/e (loop (sub1 len))) (define smallers/e (loop (sub1 len)))
(define bounded/e (take/e nats/e (add1 bound))) (define bounded/e (take/e nat/e (add1 bound)))
(define first-max/e (define first-max/e
(map/e (map/e
(curry cons bound) (curry cons bound)
@ -1081,7 +1078,7 @@
(define first-not-max/e (define first-not-max/e
(match bound (match bound
[0 empty/e] [0 empty/e]
[_ (cons/e (take/e nats/e bound) [_ (cons/e (take/e nat/e bound)
smallers/e)])) smallers/e)]))
(define (first-max? l) (define (first-max? l)
((first l) . = . bound)) ((first l) . = . bound))
@ -1103,12 +1100,12 @@
(define layer/e (bounded-list/e k layer)) (define layer/e (bounded-list/e k layer))
(decode layer/e (n . - . smallest)))) (decode layer/e (n . - . smallest))))
(define (nats+/e n) (define (nat+/e n)
(map/e (λ (k) (map/e (λ (k)
(+ k n)) (+ k n))
(λ (k) (λ (k)
(- k n)) (- k n))
nats/e)) nat/e))
;; fail/e : exn -> enum () ;; fail/e : exn -> enum ()
;; returns an enum that calls a thunk ;; returns an enum that calls a thunk
@ -1124,7 +1121,7 @@
test test
(require rackunit) (require rackunit)
(provide check-bijection? (provide check-bijection?
ints/e int/e
find-size find-size
list->inc-set list->inc-set
inc-set->list) inc-set->list)
@ -1180,7 +1177,7 @@
(define from-1/e (define from-1/e
(map/e add1 (map/e add1
sub1 sub1
nats/e)) nat/e))
(define integer/e (define integer/e
(disj-sum/e (cons (const/e 0) zero?) (disj-sum/e (cons (const/e 0) zero?)

69
pkgs/redex-pkgs/redex-test/redex/tests/enumerator-test.rkt
View File

@ -37,7 +37,7 @@
(check-bijection? e))) (check-bijection? e)))
;; map test ;; map test
(define nats+1 (nats+/e 1)) (define nats+1 (nat+/e 1))
(test-begin (test-begin
(check-equal? (size nats+1) +inf.0) (check-equal? (size nats+1) +inf.0)
@ -48,17 +48,17 @@
(test-begin (test-begin
(check-exn exn:fail? (check-exn exn:fail?
(λ () (λ ()
(decode nats/e -1)))) (decode nat/e -1))))
;; ints checks ;; ints checks
(test-begin (test-begin
(check-eq? (decode ints/e 0) 0) ; 0 -> 0 (check-eq? (decode int/e 0) 0) ; 0 -> 0
(check-eq? (decode ints/e 1) 1) ; 1 -> 1 (check-eq? (decode int/e 1) 1) ; 1 -> 1
(check-eq? (decode ints/e 2) -1) ; 2 -> 1 (check-eq? (decode int/e 2) -1) ; 2 -> 1
(check-eq? (encode ints/e 0) 0) (check-eq? (encode int/e 0) 0)
(check-eq? (encode ints/e 1) 1) (check-eq? (encode int/e 1) 1)
(check-eq? (encode ints/e -1) 2) (check-eq? (encode int/e -1) 2)
(check-bijection? ints/e)) ; -1 -> 2, -3 -> 4 (check-bijection? int/e)) ; -1 -> 2, -3 -> 4
;; sum tests ;; sum tests
(define evens/e (define evens/e
@ -87,9 +87,9 @@
(cons (from-list/e '(0 1 2 3)) number?))) (cons (from-list/e '(0 1 2 3)) number?)))
(define bool-or-nat (define bool-or-nat
(disj-sum/e (cons bools/e boolean?) (disj-sum/e (cons bools/e boolean?)
(cons nats/e number?))) (cons nat/e number?)))
(define nat-or-bool (define nat-or-bool
(disj-sum/e (cons nats/e number?) (disj-sum/e (cons nat/e number?)
(cons bools/e boolean?))) (cons bools/e boolean?)))
(define odd-or-even (define odd-or-even
(disj-sum/e (cons evens/e even?) (disj-sum/e (cons evens/e even?)
@ -136,7 +136,7 @@
(define multi-layered (define multi-layered
(disj-sum/e (cons (take/e string/e 5) string?) (disj-sum/e (cons (take/e string/e 5) string?)
(cons (from-list/e '(a b c d)) symbol?) (cons (from-list/e '(a b c d)) symbol?)
(cons nats/e number?) (cons nat/e number?)
(cons bool/e boolean?) (cons bool/e boolean?)
(cons (many/e bool/e) list?))) (cons (many/e bool/e) list?)))
@ -165,7 +165,7 @@
(cons (from-list/e '(0 1 2 3)) number?))) (cons (from-list/e '(0 1 2 3)) number?)))
(define bool-or-nat (define bool-or-nat
(disj-append/e (cons bools/e boolean?) (disj-append/e (cons bools/e boolean?)
(cons nats/e number?))) (cons nat/e number?)))
(check-equal? (size bool-or-num) 6) (check-equal? (size bool-or-num) 6)
(check-equal? (decode bool-or-num 0) #t) (check-equal? (decode bool-or-num 0) #t)
@ -191,9 +191,9 @@
(define bool*bool (cons/e bools/e bools/e)) (define bool*bool (cons/e bools/e bools/e))
(define 1*b (cons/e (const/e 1) bools/e)) (define 1*b (cons/e (const/e 1) bools/e))
(define b*1 (cons/e bools/e (const/e 1))) (define b*1 (cons/e bools/e (const/e 1)))
(define bool*nats (cons/e bools/e nats/e)) (define bool*nats (cons/e bools/e nat/e))
(define nats*bool (cons/e nats/e bools/e)) (define nats*bool (cons/e nat/e bools/e))
(define nats*nats (cons/e nats/e nats/e)) (define nats*nats (cons/e nat/e nat/e))
(define ns-equal? (λ (ns ms) (define ns-equal? (λ (ns ms)
(and (= (car ns) (and (= (car ns)
(car ms)) (car ms))
@ -268,15 +268,15 @@
[expected (list->set approx)]) [expected (list->set approx)])
(equal? actual expected))) (equal? actual expected)))
(test-begin (test-begin
(define n*n (cantor-list/e nats/e nats/e)) (define n*n (cantor-list/e nat/e nat/e))
(check-range? n*n 0 1 '((0 0))) (check-range? n*n 0 1 '((0 0)))
(check-range? n*n 1 3 '((0 1) (1 0))) (check-range? n*n 1 3 '((0 1) (1 0)))
(check-range? n*n 3 6 '((0 2) (1 1) (2 0))) (check-range? n*n 3 6 '((0 2) (1 1) (2 0)))
(check-range? n*n 6 10 '((0 3) (1 2) (2 1) (3 0))) (check-range? n*n 6 10 '((0 3) (1 2) (2 1) (3 0)))
(check-range? n*n 10 15 '((0 4) (1 3) (2 2) (3 1) (4 0)))) (check-range? n*n 10 15 '((0 4) (1 3) (2 2) (3 1) (4 0))))
(test-begin (test-begin
(define n*n*n (cantor-list/e nats/e nats/e nats/e)) (define n*n*n (cantor-list/e nat/e nat/e nat/e))
(define n*n*n*n (cantor-list/e nats/e nats/e nats/e nats/e)) (define n*n*n*n (cantor-list/e nat/e nat/e nat/e nat/e))
(check-range? n*n*n 0 1 '((0 0 0))) (check-range? n*n*n 0 1 '((0 0 0)))
@ -287,17 +287,17 @@
(1 1 1)))) (1 1 1))))
(test-begin (test-begin
(check-bijection? (cantor-vec/e string/e nats/e real/e)) (check-bijection? (cantor-vec/e string/e nat/e real/e))
(check-bijection? (cantor-list/e string/e nats/e real/e)) (check-bijection? (cantor-list/e string/e nat/e real/e))
(check-bijection? (cantor-list/e))) (check-bijection? (cantor-list/e)))
(test-begin (test-begin
(define n*n (box-list/e nats/e nats/e)) (define n*n (box-list/e nat/e nat/e))
(check-range? n*n 0 1 '((0 0))) (check-range? n*n 0 1 '((0 0)))
(check-range? n*n 1 4 '((0 1) (1 0) (1 1))) (check-range? n*n 1 4 '((0 1) (1 0) (1 1)))
(check-range? n*n 4 9 '((0 2) (1 2) (2 1) (2 0) (2 2)))) (check-range? n*n 4 9 '((0 2) (1 2) (2 1) (2 0) (2 2))))
(test-begin (test-begin
(define n*n*n (box-list/e nats/e nats/e nats/e)) (define n*n*n (box-list/e nat/e nat/e nat/e))
(check-range? n*n*n 0 1 '((0 0 0))) (check-range? n*n*n 0 1 '((0 0 0)))
(check-range? n*n*n 1 8 '((0 0 1) (0 1 1) (0 1 0) (check-range? n*n*n 1 8 '((0 0 1) (0 1 1) (0 1 0)
@ -314,8 +314,8 @@
(2 2 0) (2 2 1) (2 2 2)))) (2 2 0) (2 2 1) (2 2 2))))
(test-begin (test-begin
(check-bijection? (box-vec/e string/e nats/e real/e)) (check-bijection? (box-vec/e string/e nat/e real/e))
(check-bijection? (box-list/e string/e nats/e real/e)) (check-bijection? (box-list/e string/e nat/e real/e))
(check-bijection? (box-list/e))) (check-bijection? (box-list/e)))
;; helper ;; helper
@ -323,11 +323,12 @@
(check-equal? (list->inc-set '(2 0 1 2)) '(2 3 5 8)) (check-equal? (list->inc-set '(2 0 1 2)) '(2 3 5 8))
(check-equal? (inc-set->list '(2 3 5 8)) '(2 0 1 2))) (check-equal? (inc-set->list '(2 3 5 8)) '(2 0 1 2)))
;; mixed finite/infinite list/e tests ;; mixed finite/infinite list/e tests
(test-begin (test-begin
(check-bijection? (list/e bool/e (cons/e bool/e bool/e) (fin/e 'foo 'bar 'baz))) (check-bijection? (list/e bool/e (cons/e bool/e bool/e) (fin/e 'foo 'bar 'baz)))
(check-bijection? (list/e nats/e string/e (many/e bool/e))) (check-bijection? (list/e nat/e string/e (many/e bool/e)))
(check-bijection? (list/e bool/e nats/e ints/e string/e (cons/e bool/e bool/e)))) (check-bijection? (list/e bool/e nat/e int/e string/e (cons/e bool/e bool/e))))
;; multi-arg map/e test ;; multi-arg map/e test
(define sums/e (define sums/e
@ -343,7 +344,7 @@
;; dep/e tests ;; dep/e tests
(define (up-to n) (define (up-to n)
(take/e nats/e (+ n 1))) (take/e nat/e (+ n 1)))
(define 3-up (define 3-up
(dep/e (dep/e
@ -353,13 +354,13 @@
(define from-3 (define from-3
(dep/e (dep/e
(from-list/e '(0 1 2)) (from-list/e '(0 1 2))
nats+/e)) nat+/e))
(define nats-to (define nats-to
(dep/e nats/e up-to)) (dep/e nat/e up-to))
(define nats-up (define nats-up
(dep/e nats/e nats+/e)) (dep/e nat/e nat+/e))
(test-begin (test-begin
(check-equal? (size 3-up) 6) (check-equal? (size 3-up) 6)
@ -421,7 +422,7 @@
up-to)) up-to))
(define nats-to-2 (define nats-to-2
(dep/e nats/e up-to)) (dep/e nat/e up-to))
(test-begin (test-begin
(check-equal? (size 3-up-2) 6) (check-equal? (size 3-up-2) 6)
@ -470,7 +471,7 @@
;; except/e test ;; except/e test
(define not-3 (except/e nats/e 3)) (define not-3 (except/e nat/e 3))
(test-begin (test-begin
(check-equal? (decode not-3 0) 0) (check-equal? (decode not-3 0) 0)
(check-equal? (decode not-3 3) 4) (check-equal? (decode not-3 3) 4)
@ -486,7 +487,7 @@
;; many/e tests ;; many/e tests
(define natss (define natss
(many/e nats/e)) (many/e nat/e))
(check-bijection? natss) (check-bijection? natss)
(define emptys/e (define emptys/e