day 23: make it faste

23.rkt

@@ -4,54 +4,70 @@
 
 ;; solution for day 23
 
+;; this doesn't noticably change execution time :(
+; (require racket/unsafe/ops)
+; (define-simple-macro (mcar x) (unsafe-mcar x))
+; (define-simple-macro (mcdr x) (unsafe-mcdr x))
+; (define-simple-macro (set-mcar! l x) (unsafe-set-mcar! l x))
+; (define-simple-macro (set-mcdr! l x) (unsafe-set-mcdr! l x))
+; (define-simple-macro (vector-ref v i) (unsafe-vector-ref v i))
+; (define-simple-macro (= a b) (unsafe-fx= a b))
+; (define-simple-macro (sub1 x) (unsafe-fx- x 1))
+; (define-simple-macro (zero? x) (unsafe-fx= x 0))
+
 (define (move-opt* input times)
-  (define items-map (for/vector ([i (in-range 0 (add1 (vector-length input)))])
-                      (if (zero? i) #f (mcons i #f))))
-  (define fst (vector-ref items-map (vector-ref input 0)))
-  (define lst (vector-ref items-map (vector-ref input (sub1 (vector-length input)))))
-  (set-mcdr! lst fst)
-  (for ([i (in-range 1 (vector-length input))])
-    (define item (vector-ref items-map (vector-ref input i)))
-    (define prev (vector-ref items-map (vector-ref input (sub1 i))))
-    (set-mcdr! prev item))
-
   (define total (vector-length input))
+  (define-values [total+ total-] (values (add1 total) (sub1 total)))
 
-  (define (do-round item-ref)
+  (define items-map
+    (for/vector ([i (in-range total+)])
+      (if (zero? i) #f (mcons i #f))))
+
+  ;; wrap it
+  (define fst (vector-ref items-map (vector-ref input 0)))
+  (define lst (vector-ref items-map (vector-ref input total-)))
+  (set-mcdr! lst fst)
+
+  ;; fill in the rest
+  (for ([i (in-range 1 total)])
+    (set-mcdr! (vector-ref items-map (vector-ref input (sub1 i)))
+               (vector-ref items-map (vector-ref input i))))
+
+  (for/fold ([item-ref fst]) ([i (in-range times)])
     (define current (mcar item-ref))
+    ;; 🦈
     (define top (mcdr item-ref))
-    (define bottom (mcdr (mcdr top)))
-    (define cset
-      (let loop ([d top] [cards (set)])
-        (if (eq? d bottom)
-          (set-add cards (mcar d))
-          (loop (mcdr d) (set-add cards (mcar d))))))
+    (define mid (mcdr top))
+    (define bottom (mcdr mid))
+    ;; the card values, for comparison against the card number to insert after
+    (define-values [tv mv bv] (values (mcar top) (mcar mid) (mcar bottom)))
+
+    ;; unlink
     (set-mcdr! item-ref (mcdr bottom))
-    (set-mcdr! bottom #f)
-    (define wanted-value (let loop ([wanted (sub1 current)])
+
+    (define wanted-value
+      (let loop ([wanted (sub1 current)])
         (cond [(zero? wanted) (loop total)]
-                                 [(set-member? cset wanted) (loop (sub1 wanted))]
+              [(or (= wanted tv) (= wanted mv) (= wanted bv))
+               (loop (sub1 wanted))]
               [else wanted])))
 
+    ;; relink in new place
     (define wanted-ref (vector-ref items-map wanted-value))
     (set-mcdr! bottom (mcdr wanted-ref))
     (set-mcdr! wanted-ref top)
+    ;; return next head ref
     (mcdr item-ref))
 
-  (for/fold ([v fst]) ([i (in-range times)])
-    (do-round v))
   (vector-ref items-map 1))
 
 (define (part1 input)
-  ;; TODO:  What are the labels on the cups after cup 1?
-  ;; unimplemented lol
   (define res (move-opt* input 100))
   (let loop ([x (mcdr res)])
     (if (eq? x res)
       ""
       (string-append (number->string (mcar x)) (loop (mcdr x))))))
 
-
 (define (part2 input)
   (define rst (for/vector ([x (in-range (add1 (vector-length input)) 1000001)]) x))
   (define all (vector-append input rst))
@@ -60,8 +76,7 @@
 
 ;; parse input file
 (define (parse fname)
-  (define input (file->string fname))
-  (list->vector (filter identity (map string->number (string-split input "")))))
+  (~>> fname file->string (regexp-match* #px"\\d") (map string->number) list->vector))
 
 (module+ main
   (define input (parse "inputs/23"))