From feee839834143d6932659f03bea30633f5defcd8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 19 Dec 2018 16:34:44 -0800 Subject: [PATCH] d09 (fast) --- 2018/09-test.txt | 2 +- 2018/09.rkt | 77 ++++++++++++++++++++++++++++++------------------ 2 files changed, 50 insertions(+), 29 deletions(-) diff --git a/2018/09-test.txt b/2018/09-test.txt index f94a71a..b9a6ea9 100644 --- a/2018/09-test.txt +++ b/2018/09-test.txt @@ -1 +1 @@ -10 players; last marble is worth 1618 points \ No newline at end of file +9 players; last marble is worth 25 points \ No newline at end of file diff --git a/2018/09.rkt b/2018/09.rkt index 6499555..7f2f90d 100644 --- a/2018/09.rkt +++ b/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)) \ No newline at end of file + (require rackunit) + (check-equal? (time (★)) 437654) + (check-equal? (time (★★)) 3689913905)) \ No newline at end of file