Day 18: Part 1 second attempt (unsolved).

This commit is contained in:
Jonathan Chan 2019-12-18 23:23:51 -08:00
parent 160655eecc
commit 73494014a7
1 changed files with 101 additions and 42 deletions

View File

@ -1,6 +1,6 @@
#lang racket
(require data/queue
(require data/heap
graph
(except-in "../lib.rkt" transpose))
@ -19,6 +19,14 @@
(define height
(length list-grid))
;; start : (coord . char)
;; coord = (list number number)
(define start
(cons (list (round (/ width 2))
(round (/ height 2)))
#\@))
;; get-char : coord -> char
(define (get-char coord)
(match-let ([(list x y) coord])
(if (or (< x 0) (< y 0)
@ -27,7 +35,11 @@
#\#
(vector-ref (vector-ref vector-grid y) x))))
;; neighbours : coord -> (listof coord)
;; If the coordinate is occupiable (by a key, door, or bot),
;; return the neighbouring coordinates that are also occupiable
(define (neighbours coord)
(if (char=? #\# (get-char coord)) '()
(match-let ([(list x y) coord])
(let ([U (list x (sub1 y))]
[D (list x (add1 y))]
@ -35,40 +47,87 @@
[R (list (add1 x) y)])
(filter-not
( ( char=? #\#) ( get-char))
(list U D L R)))))
(list U D L R))))))
(define key-door-graph
(let* ([Q (make-queue)]
[entrance (list (round (/ width 2))
(round (/ height 2)))]
[visited (make-hash `((,entrance . #t)))]
[graph (weighted-graph/undirected '())])
(enqueue! Q (list entrance #\@ 0))
(let loop ()
(if (queue-empty? Q)
graph
(match-let* ([(list coord prev dist) (dequeue! Q)]
[ncoords (neighbours coord)])
;; graph-grid : unweighted, undirected graph
;; Vertices are (coord . char)
;; 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)
(let ([ncoords (neighbours coord)])
(for-each
(λ (ncoord)
(let ([nc (get-char ncoord)])
(cond
[(hash-ref visited ncoord #f)]
[(char=? #\. nc)
(hash-set! visited ncoord #t)
(enqueue! Q (list ncoord prev (add1 dist)))]
[else
(hash-set! visited ncoord #t)
(enqueue! Q (list ncoord nc 0))
(add-edge! graph prev nc (add1 dist))])))
ncoords)
(loop))))))
(add-edge! graph
(cons coord (get-char coord))
(cons ncoord (get-char ncoord))))
ncoords)))
coords)
graph))
(define ordered-keys
(let ([keys (filter char-lower-case? (get-vertices key-door-graph))])
(displayln keys)
(define (sort-fn c1 c2)
(not (member (char-upcase c2) (fewest-vertices-path key-door-graph #\@ c1))))
(sort keys sort-fn)))
;; keys : (listof (coord . char))
;; Pairs of keys and their coordinates, including #\@
(define keys
(let ([coords (cartesian-product (range 1 (sub1 width))
(range 1 (sub1 height)))])
(foldl (λ (coord keys)
(let ([char (get-char coord)])
(if (or (char=? #\@ char)
(char-lower-case? char))
(cons (cons coord char) keys)
keys)))
'() coords)))
;; 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))
;; key-graph : weighted, undirected graph
;; Vertices are char (keys)
;; Edges between neighbouring keys
;; Weights are distances between keys
(define key-graph
(let ([graph (weighted-graph/undirected '())]
[key-pairs (combinations keys 2)])
(for ([pair key-pairs])
(match-let* ([(list key1 key2) pair]
[path (fewest-vertices-path graph-grid key1 key2)]
[distance (sub1 (length path))])
(add-edge! graph (cdr key1) (cdr 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)])
(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))])
(for ([nkey visitable])
(heap-add! heap
(list nkey
(hash-set hash nkey #t)
(+ count (edge-weight key-graph key nkey)))))
(loop (heap-min heap)))))))
#;(for-each displayln (map (λ (s) (string-replace (string-replace s "#" "") "." " ")) input))