Day 23: Complete refactor, with Part 2 complete.

src/23.rkt

@@ -4,36 +4,57 @@
 
 (define input '(3 6 2 9 8 1 7 5 4))
 
-(define (succ idx)
-  (modulo (add1 idx) 9))
+(define CUPS 1000000)
+(define MOVES 10000000)
 
-(define (add1* c)
-  (if (= c 9) 1 (add1 c)))
+(define cups
+  (build-vector
+   (add1 CUPS)
+   #{cond
+      [(or (= % 0) (= % CUPS)) (first input)]
+      [(<= % (length input))
+       (let ([i (index-of input %)])
+         (if (< i (sub1 (length input)))
+             (list-ref input (add1 i))
+             (add1 (length input))))]
+      [(< % CUPS) (add1 %)]}))
 
-(define (sub1* c)
-  (if (= c 1) 9 (sub1 c)))
-
-(define (play current cups moves stop)
-  (if (= moves stop)
-      cups
-      (let* ([curr-idx (index-of cups current)]
-             [picked-up (list (list-ref cups (succ curr-idx))
-                              (list-ref cups (succ (succ curr-idx)))
-                              (list-ref cups (succ (succ (succ curr-idx)))))]
-             [dest-idx (let loop ([c (sub1* current)])
-                         (if (member c picked-up)
-                             (loop (sub1* c))
-                             (index-of cups c)))])
-        (define-values (front back) (split-at cups (+ dest-idx 1)))
-        (let ([cups (append (remove* picked-up front) picked-up (remove* picked-up back))])
-          (play (list-ref cups (succ (index-of cups current))) cups (add1 moves) stop)))))
+(define (play cup [cups cups] [CUPS CUPS])
+  (define (prev cup)
+    (if (= cup 1) CUPS (sub1 cup)))
+  (let* ([one (vector-ref cups cup)]
+         [two (vector-ref cups one)]
+         [three (vector-ref cups two)]
+         [four (vector-ref cups three)]
+         [dest (let loop ([dest (prev cup)])
+                 (if (or (= dest one) (= dest two) (= dest three))
+                     (loop (prev dest))
+                     dest))]
+         [next (vector-ref cups dest)])
+    (vector-set! cups cup four)
+    (vector-set! cups three next)
+    (vector-set! cups dest one)
+    (vector-ref cups cup)))
 
 (define part1
-  (let* ([cups (play (first input) input 0 100)]
-         [i (index-of cups 1)]
-         [labels (append (drop cups (succ i)) (take cups i))])
-    (apply string-append (map number->string labels))))
+  (let ([cups (vector 0 7 9 6 3 4 2 5 1 8)])
+    (let loop ([cup (first input)]
+               [moves 0])
+      (if (= moves 100)
+          (let loop ([result '()] [cup 1])
+            (define next (vector-ref cups cup))
+            (if (= next 1)
+                (apply string-append (map number->string (reverse result)))
+                (loop (cons next result) next)))
+          (loop (play cup cups (length input)) (add1 moves))))))
 
-(define part2 #f)
+(define part2
+  (let loop ([cup (first input)]
+             [moves 0])
+    (if (= moves MOVES)
+        (let* ([one (vector-ref cups 1)]
+               [two (vector-ref cups one)])
+          (* one two))
+        (loop (play cup) (add1 moves)))))
 
 (show-solution part1 part2)