Move back to old finite, infinite list/e (significantly faster)
This commit is contained in:
Max New
Robby Findler
parent
6a31cc882f
commit
1e2c92bf86
|
|
@ -1059,8 +1059,9 @@
|
|||
(cons (car fins) acc))])])))
|
||||
(values decon recon))
|
||||
|
||||
;; list/e : listof (enum any) -> enum (listof any)
|
||||
(define (list/e . es)
|
||||
;; Attempt at mixing finite and infinite pairing in a more principled way
|
||||
;; Slower than using inf-fin-cons/e as in list/e
|
||||
(define (inf-fin-fair-list/e . es)
|
||||
(define nat/es
|
||||
(for/list ([e (in-list es)])
|
||||
(take/e nat/e (size e))))
|
||||
|
|
@ -1177,6 +1178,113 @@
|
|||
rest-fis
|
||||
(cons #f acc))])]))))
|
||||
|
||||
(define (inf-fin-cons/e e1 e2)
|
||||
(define s1 (size e1))
|
||||
(define s2 (size e2))
|
||||
(define fst-finite? (not (infinite? s1)))
|
||||
(define fin-size
|
||||
(cond [fst-finite? s1]
|
||||
[else s2]))
|
||||
(define (dec n)
|
||||
(define-values (q r)
|
||||
(quotient/remainder n fin-size))
|
||||
(define x1 (decode e1 (if fst-finite? r q)))
|
||||
(define x2 (decode e2 (if fst-finite? q r)))
|
||||
(cons x1 x2))
|
||||
(define/match (enc p)
|
||||
[((cons x1 x2))
|
||||
(define n1 (encode e1 x1))
|
||||
(define n2 (encode e2 x2))
|
||||
(define q (if fst-finite? n2 n1))
|
||||
(define r (if fst-finite? n1 n2))
|
||||
(+ (* fin-size q)
|
||||
r)])
|
||||
(enum (* s1 s2) dec enc))
|
||||
|
||||
(define (list/e . es)
|
||||
(define l (length es))
|
||||
(cond
|
||||
[(= l 0) (const/e '())]
|
||||
[(= l 1) (map/e list car (car es))]
|
||||
[(all-infinite? es) (apply box-list/e es)]
|
||||
[(all-finite? es) (apply nested-cons-list/e es)]
|
||||
[else
|
||||
(define tagged-es
|
||||
(for/list ([i (in-naturals)]
|
||||
[e (in-list es)])
|
||||
(cons e i)))
|
||||
(define-values (inf-eis fin-eis)
|
||||
(partition (compose infinite?
|
||||
size
|
||||
car)
|
||||
tagged-es))
|
||||
(define inf-es (map car inf-eis))
|
||||
(define inf-is (map cdr inf-eis))
|
||||
(define fin-es (map car fin-eis))
|
||||
(define fin-is (map cdr fin-eis))
|
||||
(define inf-slots
|
||||
(reverse
|
||||
(let loop ([inf-is inf-is]
|
||||
[fin-is fin-is]
|
||||
[acc '()])
|
||||
(match* (inf-is fin-is)
|
||||
[('() '()) acc]
|
||||
[((cons _ _) '())
|
||||
(append (for/list ([_ (in-list inf-is)]) #t) acc)]
|
||||
[('() (cons _ _))
|
||||
(append (for/list ([_ (in-list fin-is)]) #f) acc)]
|
||||
[((cons ii rest-iis) (cons fi rest-fis))
|
||||
(cond [(ii . < . fi)
|
||||
(loop rest-iis
|
||||
fin-is
|
||||
(cons #t acc))]
|
||||
[else
|
||||
(loop inf-is
|
||||
rest-fis
|
||||
(cons #f acc))])]))))
|
||||
(define/match (reconstruct infs-fins)
|
||||
[((cons infs fins))
|
||||
(let loop ([infs infs]
|
||||
[fins fins]
|
||||
[inf?s inf-slots]
|
||||
[acc '()])
|
||||
(match inf?s
|
||||
['() (reverse acc)]
|
||||
[(cons inf? rest)
|
||||
(cond [inf?
|
||||
(loop (cdr infs)
|
||||
fins
|
||||
rest
|
||||
(cons (car infs) acc))]
|
||||
[else
|
||||
(loop infs
|
||||
(cdr fins)
|
||||
rest
|
||||
(cons (car fins) acc))])]))])
|
||||
(define (deconstruct xs)
|
||||
(let loop ([xs xs]
|
||||
[inf-acc '()]
|
||||
[fin-acc '()]
|
||||
[inf?s inf-slots])
|
||||
(match* (xs inf?s)
|
||||
[('() '()) (cons (reverse inf-acc)
|
||||
(reverse fin-acc))]
|
||||
[((cons x rest-xs) (cons inf? rest-inf?s))
|
||||
(cond [inf?
|
||||
(loop rest-xs
|
||||
(cons x inf-acc)
|
||||
fin-acc
|
||||
rest-inf?s)]
|
||||
[else
|
||||
(loop rest-xs
|
||||
inf-acc
|
||||
(cons x fin-acc)
|
||||
rest-inf?s)])])))
|
||||
(map/e reconstruct
|
||||
deconstruct
|
||||
(inf-fin-cons/e (apply list/e inf-es)
|
||||
(apply list/e fin-es)))]))
|
||||
|
||||
(define (nested-cons-list/e . es)
|
||||
(define l (length es))
|
||||
(define split-point (quotient l 2))
|
||||
|
|
@ -1188,7 +1296,6 @@
|
|||
(cons left right))
|
||||
(fin-cons/e (apply list/e left) (apply list/e right))))
|
||||
|
||||
|
||||
(define (all-infinite? es)
|
||||
(all-sizes-something? infinite? es))
|
||||
|
||||
|
|
|
|||
|
|
@ -144,13 +144,13 @@
|
|||
;; Please don't reformat this!
|
||||
'("" a 0 #t ()
|
||||
"a" b 1 #f (#t)
|
||||
"aa" c 2 (#t #t)
|
||||
"b" d 3 (#f)
|
||||
"ba" 4 (#f #t)
|
||||
5 (#t #t #t)
|
||||
6 (#f #t #t)
|
||||
7 (#t #f)
|
||||
8 (#f #f)
|
||||
"b" c 2 (#f)
|
||||
"c" d 3 (#t #t)
|
||||
"d" 4 (#f #t)
|
||||
5 (#t #f)
|
||||
6 (#f #f)
|
||||
7 (#t #t #t)
|
||||
8 (#f #t #t)
|
||||
9 (#t #f #t)))
|
||||
|
||||
(check-bijection? multi-layered))
|
||||
|
|
@ -284,57 +284,6 @@
|
|||
(define (below/e n)
|
||||
(take/e nat/e n))
|
||||
|
||||
;; mixed finite/infinite list/e tests
|
||||
(test-begin
|
||||
|
||||
(check-equal?
|
||||
(to-list (list/e (below/e 3) (below/e 3) (below/e 3)))
|
||||
(to-list (take/e (list/e nat/e nat/e nat/e) 27)))
|
||||
|
||||
(define n*2 (list/e nat/e (below/e 2)))
|
||||
(check-range? n*2 0 1 '((0 0)))
|
||||
(check-range? n*2 1 4 '((0 1) (1 0) (1 1)))
|
||||
(check-range? n*2 4 6 '((2 0) (2 1)))
|
||||
(check-range? n*2 6 8 '((3 0) (3 1)))
|
||||
|
||||
(define n*1*2 (list/e nat/e (below/e 1) (below/e 2)))
|
||||
(check-range? n*1*2 0 1 '((0 0 0)))
|
||||
(check-range? n*1*2 1 4 '((0 0 1) (1 0 0) (1 0 1)))
|
||||
(check-range? n*1*2 4 6 '((2 0 0) (2 0 1)))
|
||||
(check-range? n*1*2 6 8 '((3 0 0) (3 0 1)))
|
||||
|
||||
(define n*2*4 (list/e nat/e (below/e 2) (below/e 4)))
|
||||
(check-range? n*2*4 0 1 '((0 0 0)))
|
||||
(check-range? n*2*4 1 8 '((0 0 1) (0 1 1) (0 1 0)
|
||||
(1 0 0) (1 0 1) (1 1 0) (1 1 1)))
|
||||
(check-range? n*2*4 8 18 ;; (8 previous . + . (2 magnitude of exhausted enums
|
||||
;; . * . (9 3^(number left) . - . 4 2^(number left)))
|
||||
|
||||
'((0 0 2) (0 1 2)
|
||||
(1 0 2) (1 1 2)
|
||||
(2 0 0) (2 1 0)
|
||||
(2 0 1) (2 1 1)
|
||||
(2 0 2) (2 1 2)))
|
||||
(check-range? n*2*4 18 32 ;; 18 + (2 * (4^2 - 3^2))
|
||||
'((0 0 3) (0 1 3)
|
||||
(1 0 3) (1 1 3)
|
||||
(2 0 3) (2 1 3)
|
||||
(3 0 0) (3 1 0)
|
||||
(3 0 1) (3 1 1)
|
||||
(3 0 2) (3 1 2)
|
||||
(3 0 3) (3 1 3)))
|
||||
(check-range? n*2*4 32 40
|
||||
'((4 0 0) (4 0 1) (4 0 2) (4 0 3)
|
||||
(4 1 0) (4 1 1) (4 1 2) (4 1 3)))
|
||||
(check-range? n*2*4 40 48
|
||||
'((5 0 0) (5 0 1) (5 0 2) (5 0 3)
|
||||
(5 1 0) (5 1 1) (5 1 2) (5 1 3)))
|
||||
|
||||
(check-bijection? (list/e bool/e (cons/e bool/e bool/e) (fin/e 'foo 'bar 'baz)))
|
||||
(check-bijection? (list/e nat/e string/e (many/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
|
||||
(define sums/e
|
||||
(map/e
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user