2019/src/18.rkt

#lang racket

(require data/heap
         graph
         (except-in "../lib.rkt" transpose))

(define input
  (problem-input 18))

(define list-grid
  (map string->list input))

(define vector-grid
  (lists->vectors list-grid))

(define width
  (length (car list-grid)))

(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)
            (>= x width)
            (>= y height))
        #\#
        (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))]
              [L (list (sub1 x) y)]
              [R (list (add1 x) y)])
          (filter-not
           (∘ (∂ char=? #\#) (∂ get-char))
           (list U D L R))))))

;; 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))

;; 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))