day 23, part 2

2020/23.rkt

@@ -3,59 +3,51 @@
 
 (define ints (map string->number (regexp-match* #rx"." "389547612")))
 
-(struct cup (val prev next) #:mutable)
-
-(define (link-cups! left right)
-  (set-cup-next! left right)
-  (set-cup-prev! right left))
-
-(define (find-cup cups dest-val)
-  (for/first ([c (in-list cups)]
-              #:when (eq? (cup-val c) dest-val))
-    c))
-
-(define (next-cups start count)
-  (cdr (reverse (foldl (λ (val acc) (cons (cup-next (car acc)) acc))
-                       (list start)
-                       (range count)))))
-
 (define (solve ints [max-int 9] [turns 100] [string-result? #true])
+
   (define cups (let* ([ints (if (= max-int (apply max ints))
                                 ints
                                 (append ints (for/list ([i (in-range 1 (add1 max-int))]
                                                         #:unless (memq i ints))
                                                i)))]
-                      [cups (for/list ([int ints])
-                              (cup int #f #f))])
-                 (for-each link-cups! cups (append (cdr cups) (list (car cups))))
+                      [cups (make-vector (length ints))])
+                 (for ([int (in-list ints)]
+                       [next (in-list (append (cdr ints) (list (car ints))))])
+                   (vector-set! cups (sub1  int) next))
                  cups))
 
+  (define (cup-next val)
+    (vector-ref cups (sub1 val)))
+
+  (define (link-cups! this next)
+    (vector-set! cups (sub1 this) next))
+  
+  (define (next-cups start count)
+    (cdr (reverse (foldl (λ (val acc) (cons (cup-next (car acc)) acc))
+                         (list start)
+                         (range count)))))
+
   (define min-cup-val (apply min ints))
   (define max-cup-val max-int)
 
-  (for/fold ([current (car cups)]
+  (for/fold ([current (first ints)]
              #:result (void))
             ([turn (in-range turns)])
     (match-define (list cup1 cup2 cup3 cup4) (next-cups current 4))
     (link-cups! current cup4)
-    (define dest-cup (let ([pickup-vals (map cup-val (list cup1 cup2 cup3))])
-                       (let loop ([dest (sub1 (cup-val current))])
+    (define dest (let ([pickup-vals (list cup1 cup2 cup3)])
+                   (let loop ([dest (sub1 current)])
                      (cond
                        [(< dest min-cup-val) (loop max-cup-val)]
                        [(memq dest pickup-vals) (loop (sub1 dest))]
-                           [else (find-cup cups dest)]))))
-    (define dest-cup-next (cup-next dest-cup))
-    (link-cups! dest-cup cup1)
-    (link-cups! cup3 dest-cup-next)
+                       [else dest]))))
+    (link-cups! cup3 (cup-next dest))
+    (link-cups! dest cup1)
     (cup-next current))
 
   (if string-result?
-      (string-append*
-       (for/list ([cup (next-cups (find-cup cups 1) (sub1 (length cups)))])
-         (~a (cup-val cup))))
-      (apply * (map cup-val (next-cups (find-cup cups 1) 2)))))
-
-(check-equal? (solve ints) "45286397")
+      (string-append* (map ~a (next-cups 1 (sub1 (vector-length cups)))))
+      (apply * (next-cups 1 2))))
 
-;; brutality won't be fast enough, but it was worth trying
-#;(solve ints 1000000 10000000 #f)
+(check-equal? (solve ints 9 100) "45286397")
+(check-equal? (solve ints 1000000 10000000 #f) 836763710)