way faster with mutable pairs

2018/05.rkt

@@ -5,16 +5,30 @@
 
 (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 (★)
   (react fpbs))
@@ -23,19 +37,13 @@
   (map char->integer (remove-duplicates (map char-upcase (map integer->char (bytes->list fpbs))) char=?)))
 
 (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 (★★)
-  (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
-    (require rackunit)
+  (require rackunit)
-    (check-equal? (time (★)) 10564)
+  (check-equal? (time (★)) 10564)
-    (check-equal? (time (★★)) 6336))
+  (check-equal? (time (★★)) 6336))