ionchy
/
adventofcode
1
0
Fork 0
Code

Day 18: Part 1 finally!!!

This commit is contained in:
Jonathan Chan 2019-12-22 20:59:59 -08:00
parent ab1a1ce9bf
commit 76904fe41a
1 changed files with 81 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
src/18.rkt
View File

@ -1,6 +1,7 @@
#lang racket #lang racket
(require data/heap (require racket/set
data/heap
graph graph
(except-in "../lib.rkt" transpose)) (except-in "../lib.rkt" transpose))
@ -22,9 +23,8 @@
;; start : (coord . char) ;; start : (coord . char)
;; coord = (list number number) ;; coord = (list number number)
(define start (define start
(cons (list (round (/ width 2)) (cons #\@ (list (round (/ width 2))
(round (/ height 2))) (round (/ height 2)))))
#\@))
;; get-char : coord -> char ;; get-char : coord -> char
(define (get-char coord) (define (get-char coord)
@ -50,52 +50,57 @@
(list U D L R)))))) (list U D L R))))))
;; graph-grid : unweighted, undirected graph ;; graph-grid : unweighted, undirected graph
;; Vertices are (coord . char) ;; Vertices are (char . coord)
;; Edges between traversable coordinates ;; Edges between traversable coordinates
(define graph-grid (define graph-grid
(let* ([coords (cartesian-product (range 1 (sub1 width)) (let* ([coords (cartesian-product (range 1 (sub1 width))
(range 1 (sub1 height)))] (range 1 (sub1 height)))]
[graph (unweighted-graph/undirected '())]) [graph (unweighted-graph/undirected '())])
(for-each (for ([coord coords])
(λ (coord)
(let ([ncoords (neighbours coord)]) (let ([ncoords (neighbours coord)])
(for-each (for ([ncoord ncoords])
(λ (ncoord)
(add-edge! graph (add-edge! graph
(cons coord (get-char coord)) (cons (get-char coord) coord)
(cons ncoord (get-char ncoord)))) (cons (get-char ncoord) ncoord)))))
ncoords)))
coords)
graph)) graph))
;; keys : (listof (coord . char)) ;; keys-hash : (hashof (char => coord))
;; Pairs of keys and their coordinates, including #\@ ;; A hashmap from keys to their coordinates, including #\@
(define keys (define keys-hash
(let ([coords (cartesian-product (range 1 (sub1 width)) (let ([hash (make-immutable-hash)]
[coords (cartesian-product (range 1 (sub1 width))
(range 1 (sub1 height)))]) (range 1 (sub1 height)))])
(foldl (λ (coord keys) (foldl (λ (coord hash)
(let ([char (get-char coord)]) (let ([char (get-char coord)])
(if (or (char=? #\@ char) (if (or (char=? #\@ char)
(char-lower-case? char)) (char-lower-case? char))
(cons (cons coord char) keys) (hash-set hash char coord)
keys))) hash)))
'() coords))) hash coords)))
;; inter-keys-hash : (hashof (char => char))
;; A hashmap from keys to the keys that must be collected
;; when taking the shortest path from #\@ to that key
(define inter-keys-hash
(let ([hash (make-immutable-hash)])
(foldl (λ (keycoord hash)
(match-let* ([(cons key _) keycoord]
[path (map car (fewest-vertices-path graph-grid start keycoord))]
[inter-keys (remove* (list #\@ key) (filter char-lower-case? path))])
(hash-set hash key inter-keys)))
hash (hash->list keys-hash))))
;; doors : (hashof (char => (listof char))) ;; doors : (hashof (char => (listof char)))
;; A hashmap from keys to the list of keys for the doors ;; A hashmap from keys to the list of keys for the doors
;; that stand between the starting point #\@ and that key ;; that stand between the starting point #\@ and that key
(define doors-hash (define doors-hash
(let ([hash (make-hash)]) (let ([hash (make-immutable-hash)])
(for ([key keys]) (foldl (λ (keycoord hash)
(let ([path (fewest-vertices-path graph-grid start key)]) (match-let* ([(cons key _) keycoord]
(hash-set! hash (cdr key) [path (map car (fewest-vertices-path graph-grid start keycoord))]
(filter-map [doors (map char-downcase (filter char-upper-case? path))])
(λ (v) (hash-set hash key doors)))
(if (char-upper-case? (cdr v)) hash (hash->list keys-hash))))
(char-downcase (cdr v))
#f))
path))))
hash))
;; key-graph : weighted, undirected graph ;; key-graph : weighted, undirected graph
;; Vertices are char (keys) ;; Vertices are char (keys)
@ -103,31 +108,55 @@
;; Weights are distances between keys ;; Weights are distances between keys
(define key-graph (define key-graph
(let ([graph (weighted-graph/undirected '())] (let ([graph (weighted-graph/undirected '())]
[key-pairs (combinations keys 2)]) [key-pairs (combinations (hash-keys keys-hash) 2)])
(for ([pair key-pairs]) (for ([pair key-pairs])
(match-let* ([(list key1 key2) pair] (match-let* ([(list key1 key2) pair]
[path (fewest-vertices-path graph-grid key1 key2)] [keycoord1 (cons key1 (hash-ref keys-hash key1))]
[keycoord2 (cons key2 (hash-ref keys-hash key2))]
[path (fewest-vertices-path graph-grid keycoord1 keycoord2)]
[distance (sub1 (length path))]) [distance (sub1 (length path))])
(add-edge! graph (cdr key1) (cdr key2) distance))) (add-edge! graph key1 key2 distance)))
graph)) graph))
(define (search) ;; visitable? : (setof char) -> char -> boolean
(let ([heap (make-heap (λ (v1 v2) (< (last v1) (last v2))))]) ;; Given a set of visited keys and a prospective key,
(heap-add! heap (list #\@ (make-immutable-hash '((#\@ . #t))) 0)) ;; return whether we visit that key based on three conditions:
(match-let loop ([(list key hash count) (heap-min heap)]) ;; - There isn't a closer key we could visit;
;; - The key has not yet been visited; and
;; - We have the keys needed to open all doors leading to that key.
(define (visitable? visited key)
(let* ([visitable-inter-keys (filter-not (∂ set-member? visited) (hash-ref inter-keys-hash key))])
(and (empty? visitable-inter-keys)
(not (set-member? visited key))
(andmap (∂ set-member? visited) (hash-ref doors-hash key)))))
(struct state (key visited steps) #:transparent)
(define (state=? st1 st2)
(and (equal? (state-key st1) (state-key st2))
(equal? (state-visited st1) (state-visited st2))))
(define (state<? st1 st2)
(< (state-steps st1) (state-steps st2)))
(define part1
(let ([heap (make-heap state<?)]
[memo (make-hash)])
(heap-add! heap (state #\@ (set #\@) 0))
(match-let loop ([(state key visited steps) (heap-min heap)])
(heap-remove-min! heap) (heap-remove-min! heap)
(if (= (hash-count hash) (length keys)) (if (= (set-count visited) (hash-count keys-hash))
count steps
(let* ([visitable (let* ([visitable (filter (∂ visitable? visited) (get-neighbors key-graph key))])
(filter (λ (nkey)
(and (not (hash-has-key? hash nkey))
(andmap (∂ hash-has-key? hash) (hash-ref doors-hash nkey))))
(get-neighbors key-graph key))])
(for ([nkey visitable]) (for ([nkey visitable])
(heap-add! heap (let* ([visited (set-add visited nkey)]
(list nkey [steps (+ steps (edge-weight key-graph key nkey))]
(hash-set hash nkey #t) [memo-steps (hash-ref memo (cons nkey visited) +inf.0)]
(+ count (edge-weight key-graph key nkey))))) [st (state nkey visited steps)])
(when (< steps memo-steps)
(hash-set! memo (cons nkey visited) steps)
(heap-remove! heap st #:same? state=?)
(heap-add! heap st))))
(loop (heap-min heap))))))) (loop (heap-min heap)))))))
#;(for-each displayln (map (λ (s) (string-replace (string-replace s "#" "█") "." " ")) input)) #;(for-each displayln (map (λ (s) (string-replace (string-replace s "#" "█") "." " ")) input))