Day 18: Part 1 second attempt (unsolved).

src/18.rkt

@@ -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,48 +35,99 @@
         #\#
         (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)
-  (match-let ([(list x y) coord])
-    (let ([U (list x (sub1 y))]
-          [D (list x (add1 y))]
-          [L (list (sub1 x) y)]
-          [R (list (add1 x) y)])
-      (filter-not
-       (∘ (∂ char=? #\#) (∂ get-char))
-       (list U D L R)))))
+  (if (char=? #\# (get-char coord)) '()
+      (match-let ([(list x y) coord])
+        (let ([U (list x (sub1 y))]
+              [D (list x (add1 y))]
+              [L (list (sub1 x) y)]
+              [R (list (add1 x) y)])
+          (filter-not
+           (∘ (∂ char=? #\#) (∂ get-char))
+           (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)])
-            (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))))))
+;; 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)
+            (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))