way faster with mutable pairs

master
Matthew Butterick 6 years ago
parent c9f3bcb6c8
commit de4018ffd5

@ -5,16 +5,30 @@
(define fpbs (port->bytes fp)) (define fpbs (port->bytes fp))
(define (react fpbs) (define-macro (for/mutable-list (SEQ ...) . BODY)
(let/ec exit #'(let loop ([mprs null][xs (reverse (for/list (SEQ ...) . BODY))])
(for/fold ([bs fpbs]) (if (empty? xs)
([i (in-naturals)]) mprs
(or (loop (mcons (car xs) mprs) (cdr xs)))))
(for/first ([(left lidx) (in-indexed bs)]
[right (in-bytes (subbytes bs 1))] (define (reactive-pair? mprs)
#:when (= 32 (abs (- left right)))) (= 32 (abs (- (mcar (mcdr mprs)) (mcar (mcdr (mcdr mprs)))))))
(bytes-append (subbytes bs 0 lidx) (subbytes bs (+ lidx 2))))
(exit (bytes-length bs)))))) (define (react [fpbs fpbs])
(define mprs0 (mcons #f (for/mutable-list ([b (in-bytes fpbs)])
b)))
(let loop ([mprs mprs0][found? #false])
(cond
[(or (empty? mprs)
(empty? (mcdr mprs))
(empty? (mcdr (mcdr mprs))))
(if found? (loop mprs0 #false) mprs0)]
[(reactive-pair? mprs)
(set-mcdr! mprs (mcdr (mcdr (mcdr mprs))))
(loop (mcdr mprs) #true)]
[else (loop (mcdr mprs) found?)]))
(for/sum ([val (in-mlist (mcdr mprs0))])
1))
(define () (define ()
(react fpbs)) (react fpbs))
@ -23,19 +37,13 @@
(map char->integer (remove-duplicates (map char-upcase (map integer->char (bytes->list fpbs))) char=?))) (map char->integer (remove-duplicates (map char-upcase (map integer->char (bytes->list fpbs))) char=?)))
(define (remove-unit fbps unit) (define (remove-unit fbps unit)
(apply bytes (regexp-replace* (regexp (format "[~a~a]" (integer->char unit) (integer->char (+ unit 32)))) fbps ""))
(for/list ([b (in-bytes fbps)]
#:unless (or (= b unit)
(= b (+ unit 32))))
b)))
;; very slow.
(define (★★) (define (★★)
(argmin cdr (apply min (for/list ([unit (in-list possible-units)])
(for/list ([(unit idx) (in-indexed possible-units)]) (react (remove-unit fpbs unit)))))
(cons unit (react (remove-unit fpbs unit))))))
(module+ test (module+ test
(require rackunit) (require rackunit)
(check-equal? (time ()) 10564) (check-equal? (time ()) 10564)
(check-equal? (time (★★)) 6336)) (check-equal? (time (★★)) 6336))