mbutterick
/
aoc-racket
Archived
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

day 23, part 2

Browse Source
master
Matthew Butterick 4 years ago
parent 8318605d86
commit 7fea07bd11
1 changed files with 29 additions and 37 deletions
Show Stats Download Patch File Download Diff File

60
2020/23.rkt
Unescape Escape View File

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