adventofcode
/
2019
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Day 18: Part 1 finally!!!

This commit is contained in:
Jonathan Chan 2019-12-22 20:59:59 -08:00
parent 8ebadd2ee2
commit 9ff845aad4
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
(require data/heap
(require racket/set
data/heap
graph
(except-in "../lib.rkt" transpose))
@ -22,9 +23,8 @@
;; start : (coord . char)
;; coord = (list number number)
(define start
(cons (list (round (/ width 2))
(round (/ height 2)))
#\@))
(cons #\@ (list (round (/ width 2))
(round (/ height 2)))))
;; get-char : coord -> char
(define (get-char coord)
@ -50,52 +50,57 @@
(list U D L R))))))
;; graph-grid : unweighted, undirected graph
;; Vertices are (coord . char)
;; Vertices are (char . coord)
;; Edges between traversable coordinates
(define graph-grid
(let* ([coords (cartesian-product (range 1 (sub1 width))
(range 1 (sub1 height)))]
[graph (unweighted-graph/undirected '())])
(for-each
(λ (coord)
(for ([coord coords])
(let ([ncoords (neighbours coord)])
(for-each
(λ (ncoord)
(for ([ncoord ncoords])
(add-edge! graph
(cons coord (get-char coord))
(cons ncoord (get-char ncoord))))
ncoords)))
coords)
(cons (get-char coord) coord)
(cons (get-char ncoord) ncoord)))))
graph))
;; keys : (listof (coord . char))
;; Pairs of keys and their coordinates, including #\@
(define keys
(let ([coords (cartesian-product (range 1 (sub1 width))
;; keys-hash : (hashof (char => coord))
;; A hashmap from keys to their coordinates, including #\@
(define keys-hash
(let ([hash (make-immutable-hash)]
[coords (cartesian-product (range 1 (sub1 width))
(range 1 (sub1 height)))])
(foldl (λ (coord keys)
(foldl (λ (coord hash)
(let ([char (get-char coord)])
(if (or (char=? #\@ char)
(char-lower-case? char))
(cons (cons coord char) keys)
keys)))
'() coords)))
(hash-set hash char coord)
hash)))
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)))
;; A hashmap from keys to the list of keys for the doors
;; that stand between the starting point #\@ and that key
(define doors-hash
(let ([hash (make-hash)])
(for ([key keys])
(let ([path (fewest-vertices-path graph-grid start key)])
(hash-set! hash (cdr key)
(filter-map
(λ (v)
(if (char-upper-case? (cdr v))
(char-downcase (cdr v))
#f))
path))))
hash))
(let ([hash (make-immutable-hash)])
(foldl (λ (keycoord hash)
(match-let* ([(cons key _) keycoord]
[path (map car (fewest-vertices-path graph-grid start keycoord))]
[doors (map char-downcase (filter char-upper-case? path))])
(hash-set hash key doors)))
hash (hash->list keys-hash))))
;; key-graph : weighted, undirected graph
;; Vertices are char (keys)
@ -103,31 +108,55 @@
;; Weights are distances between keys
(define key-graph
(let ([graph (weighted-graph/undirected '())]
[key-pairs (combinations keys 2)])
[key-pairs (combinations (hash-keys keys-hash) 2)])
(for ([pair key-pairs])
(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))])
(add-edge! graph (cdr key1) (cdr key2) distance)))
(add-edge! graph key1 key2 distance)))
graph))
(define (search)
(let ([heap (make-heap (λ (v1 v2) (< (last v1) (last v2))))])
(heap-add! heap (list #\@ (make-immutable-hash '((#\@ . #t))) 0))
(match-let loop ([(list key hash count) (heap-min heap)])
;; visitable? : (setof char) -> char -> boolean
;; Given a set of visited keys and a prospective key,
;; return whether we visit that key based on three conditions:
;; - 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)
(if (= (hash-count hash) (length keys))
count
(let* ([visitable
(filter (λ (nkey)
(and (not (hash-has-key? hash nkey))
(andmap (∂ hash-has-key? hash) (hash-ref doors-hash nkey))))
(get-neighbors key-graph key))])
(if (= (set-count visited) (hash-count keys-hash))
steps
(let* ([visitable (filter (∂ visitable? visited) (get-neighbors key-graph key))])
(for ([nkey visitable])
(heap-add! heap
(list nkey
(hash-set hash nkey #t)
(+ count (edge-weight key-graph key nkey)))))
(let* ([visited (set-add visited nkey)]
[steps (+ steps (edge-weight key-graph key nkey))]
[memo-steps (hash-ref memo (cons nkey visited) +inf.0)]
[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)))))))
#;(for-each displayln (map (λ (s) (string-replace (string-replace s "#" "█") "." " ")) input))