d09 (fast)

2018/09-test.txt

@@ -1 +1 @@
-10 players; last marble is worth 1618 points
+9 players; last marble is worth 25 points

2018/09.rkt

@@ -1,38 +1,59 @@
 #lang debug br
 (require racket/file)
 
-(define (nth-mpr mprs n)
-  (for/fold ([mprs mprs])
-            ([i (in-range n)])
-    (mcdr mprs)))
-
-(define (★)
-  (match-define (list player-count max-marbles)
-    (map string->number (regexp-match* #px"\\d+" (file->string "09.txt"))))
+#|
+This puzzle seemed annoying at first but turned out to be educational.
+An epic difference between the naive solution (= make a list and iterate from the start)
+and using a double-linked list, which minimizes traversal.
+|#
+
+(struct dll (val prev next) #:mutable)
+
+(define (move-by dll n)
+  (define iterator
+    (match n
+      [(? positive?) dll-next]
+      [(? negative?) dll-prev]
+      [_ values]))
+  (for/fold ([dll dll])
+            ([i (in-range (abs n))])
+    (iterator dll)))
+
+(define (remove-marble! marble)
+  (set-dll-next! (dll-prev marble) (dll-next marble))
+  (set-dll-prev! (dll-next marble) (dll-prev marble)))
+
+(define (find-winner player-count max-marbles)
   (define scores (make-hasheqv))
-  (define circle (mcons #f (mcons 0 null)))
-  (let loop ([marble 1] [marbles-in-circle 1] [pos 0])
+  (define first-marble (dll 0 #f #f))
+  (set-dll-prev! first-marble first-marble)
+  (set-dll-next! first-marble first-marble)
+  (for/fold ([current-marble first-marble]
+             #:result (cdr (argmax cdr (hash->list scores))))
+            ([marble (in-range 1 max-marbles)])
     (cond
-      [(> marble max-marbles) (cdr (argmax cdr (hash->list scores)))]
-     [(zero? (modulo marble 23))
-       (define deletion-pos (modulo (+ (- pos 7) marbles-in-circle) marbles-in-circle))
-       (define last-left-mpr (nth-mpr circle deletion-pos))
-       (define removed-marble (mcar (mcdr last-left-mpr)))
-       (set-mcdr! last-left-mpr (mcdr (mcdr last-left-mpr)))
+      [(zero? (modulo marble 23))
+       (define marble-to-remove (move-by current-marble -7))
+       (remove-marble! marble-to-remove)
        (define player (modulo marble player-count))
-       (hash-update! scores player (λ (sc) (+ removed-marble marble sc)) 0)
-       (loop (add1 marble) (sub1 marbles-in-circle) deletion-pos)]
+       (hash-update! scores player (λ (sc) (+ (dll-val marble-to-remove) marble sc)) 0)
+       (dll-next marble-to-remove)]
       [else
-       (define next-pos (add1 (modulo (add1 pos) marbles-in-circle)))
-       (define last-left-mpr (nth-mpr circle next-pos))
-       (set-mcdr! last-left-mpr (mcons marble (mcdr last-left-mpr)))
-       (loop (add1 marble) (add1 marbles-in-circle) next-pos)])))
+       (define left-marble (move-by current-marble 1))
+       (define right-marble (dll-next left-marble))
+       (define new-marble (dll marble left-marble right-marble))
+       (set-dll-next! left-marble new-marble)
+       (set-dll-prev! right-marble new-marble)
+       new-marble])))
+
+(match-define (list player-count max-marbles)
+  (map string->number (regexp-match* #px"\\d+" (file->string "09.txt"))))
+
+(define (★) (find-winner player-count max-marbles))
 
-#;(define (★★)
-    )
-#;(★★)
+(define (★★) (find-winner player-count (* 100 max-marbles)))
 
 (module+ test
-    (require rackunit)
-    (check-equal? (time (★)) 437654)
-    #;(check-equal? (time (★★)) 566))
+  (require rackunit)
+  (check-equal? (time (★)) 437654)
+  (check-equal? (time (★★)) 3689913905))