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

Tweak sum/e behavior for nicer Redex enumeration and simplify repeats.

Browse Source
This commit is contained in:
Max New 2013-09-17 22:55:05 -07:00
parent 0b78356be7
commit 5c82ab06c3
3 changed files with 78 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -410,19 +410,12 @@
(match sub-pat
[`(repeat ,pat #f #f)
(map/e
(λ (n-ts)
(repeat (car n-ts)
(cdr n-ts)))
(λ (ts)
(repeat (length ts)
ts))
(λ (rep)
(cons (repeat-n rep)
(repeat-terms rep)))
(sum/e
(const/e (cons 0 '()))
(dep/e
(nats+/e 1)
(λ (n)
(list/e
(build-list n (const (loop pat))))))))]
(repeat-terms rep))
(many/e (loop pat)))]
[`(repeat ,pat ,name #f)
(error 'unimplemented "named-repeat")]
[`(repeat ,pat #f ,mismatch)

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

@ -1,5 +1,6 @@
#lang racket/base
(require racket/math
racket/match
racket/list
racket/function
data/gvector)
@ -200,42 +201,72 @@
(- (* 2 n) 1)
(* 2 (abs n))))))
;; sum :: enum a, enum b -> enum (a or b)
;; sum :: enum a, enum b -> enum (U a b)
(define sum/e
(case-lambda
[(e) e]
[(e1 e2)
(cond
[(= 0 (size e1)) e2]
[(= 0 (size e2)) e1]
[(not (infinite? (enum-size e1)))
(enum (+ (enum-size e1)
(enum-size e2))
(λ (n)
(if (< n (enum-size e1))
((enum-from e1) n)
((enum-from e2) (- n (enum-size e1)))))
(λ (x)
(with-handlers ([exn:fail? (λ (_)
(+ (enum-size e1)
((enum-to e2) x)))])
((enum-to e1) x))))]
[(not (infinite? (enum-size e2)))
(sum/e e2 e1)]
[else ;; both infinite, interleave them
(enum +inf.f
(λ (n)
(if (even? n)
((enum-from e1) (/ n 2))
((enum-from e2) (/ (- n 1) 2))))
(λ (x)
(with-handlers ([exn:fail?
(λ (_)
(+ (* ((enum-to e2) x) 2)
1))])
(* ((enum-to e1) x) 2))))])]
;; Sum two enumerators of different sizes
(define (sum-uneven less/e more/e)
;; interleave until less/e is exhausted
;; pairsdone is 1+ the highest index using less/e
(let* ([less-size (size less/e)]
[pairsdone (* 2 less-size)])
(enum (+ less-size (size more/e))
(λ (n)
(if (< n pairsdone)
(let-values ([(q r) (quotient/remainder n 2)])
;; Always put e1 first though!
(decode (match r
[0 e1]
[1 e2])
q))
(decode more/e (- n less-size))))
(λ (x)
(with-handlers
([exn:fail?
(λ (_)
(let ([i (encode more/e x)])
(if (< i less-size)
(+ (* 2 i) 1)
(+ (- i less-size) pairsdone))))])
(* 2 (encode less/e x)))))))
(let* ([s1 (size e1)]
[s2 (size e2)])
(cond
[(= 0 s1) e2]
[(= 0 s2) e1]
[(< s1 s2)
(sum-uneven e1 e2)]
[(< s2 s1)
(sum-uneven e2 e1)]
[else ;; both the same length, interleave them
(enum (+ s1 s2)
(λ (n)
(if (even? n)
((enum-from e1) (/ n 2))
((enum-from e2) (/ (- n 1) 2))))
(λ (x)
(with-handlers ([exn:fail?
(λ (_)
(+ (* ((enum-to e2) x) 2)
1))])
(* ((enum-to e1) x) 2))))]))]
[(a b c . rest)
(sum/e a (apply sum/e b c rest))]))
;; map-pairs : (a, a -> b), (a -> b), listof a -> listof b
;; apply the function to every pair, applying f to the first element of an odd length list
(define (map-pairs f d l)
(define (map-pairs/even l)
(match l
['() '()]
[`(,x ,y ,rest ...)
(cons (f x y)
(map-pairs f d rest))]))
(if (even? (length l))
(map-pairs/even l)
(cons (d (car l))
(map-pairs/even (cdr l)))))
(apply sum/e (map-pairs sum/e identity (list* a b c rest)))]))
(define n*n
(enum +inf.f

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

@ -91,34 +91,33 @@
(test-begin
(let ([bool-or-num (sum/e bools/e
(from-list/e '(0 1 2)))]
(from-list/e '(0 1 2 3)))]
[bool-or-nat (sum/e bools/e
nats)]
[nat-or-bool (sum/e nats
bools/e)]
[odd-or-even (sum/e evens/e
odds/e)])
(check-equal? (size bool-or-num)
5)
(check-equal? (size bool-or-num) 6)
(check-equal? (decode bool-or-num 0) #t)
(check-equal? (decode bool-or-num 1) #f)
(check-equal? (decode bool-or-num 2) 0)
(check-equal? (decode bool-or-num 1) 0)
(check-equal? (decode bool-or-num 2) #f)
(check-equal? (decode bool-or-num 3) 1)
(check-equal? (decode bool-or-num 4) 2)
(check-equal? (decode bool-or-num 5) 3)
(check-exn exn:fail?
(λ ()
(decode bool-or-num 5)))
(check-equal? (encode bool-or-num #f) 1)
(check-equal? (encode bool-or-num 2) 4)
(decode bool-or-num 6)))
(check-bijection? bool-or-num)
(check-equal? (size bool-or-nat)
+inf.f)
(check-equal? (decode bool-or-nat 0) #t)
(check-equal? (decode bool-or-nat 2) 0)
(check-equal? (decode bool-or-nat 1) 0)
(check-bijection? bool-or-nat)
(check-equal? (encode bool-or-num #f) 1)
(check-equal? (encode bool-or-num 2) 4)
(check-equal? (size odd-or-even)
+inf.f)
(check-equal? (decode odd-or-even 0) 0)