From 9ff845aad4c96c9dbd1c48ed0ce6316e522cf45d Mon Sep 17 00:00:00 2001
From: Jonathan Chan <jonathanhwchan@gmail.com>
Date: Sun, 22 Dec 2019 20:59:59 -0800
Subject: [PATCH] Day 18: Part 1 finally!!!

---
 src/18.rkt | 133 ++++++++++++++++++++++++++++++++---------------------
 1 file changed, 81 insertions(+), 52 deletions(-)

diff --git a/src/18.rkt b/src/18.rkt
index aa96c42..a9dca78 100644
--- a/src/18.rkt
+++ b/src/18.rkt
@@ -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)
-       (let ([ncoords (neighbours coord)])
-         (for-each
-          (λ (ncoord)
-            (add-edge! graph
-                       (cons  coord (get-char  coord))
-                       (cons ncoord (get-char ncoord))))
-          ncoords)))
-     coords)
+    (for ([coord coords])
+      (let ([ncoords (neighbours coord)])
+        (for ([ncoord ncoords])
+          (add-edge! graph
+                     (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))
\ No newline at end of file