Factor out A* implementation

[adventofcode2019.git] / src / adventofcode2019 / day18.clj

(ns adventofcode2019.day18
  [:require [adventofcode2019.lib :refer :all]
   [adventofcode2019.intcode :as i]
   [clojure.string :as str]
   [clojure.set :as set]
   [clojure.core.match :refer [match]]
   [clojure.math.combinatorics :as combo]])

(defn build-world [input]
  (let [point-encode (->> input
                          (map-indexed
                           (fn [y xs]
                             (map-indexed
                              (fn [x c]
                                [c [x y]]) xs)))
                          (apply concat))
        passages (->> point-encode
                      (filter #(= \. (first %)))
                      (map second)
                      (set))
        interesting (->> point-encode
                         (filter #(and (not= \. (first %))
                                       (not= \# (first %))))
                         (into {}))
        dkeys (select-keys interesting (filter #(Character/isLowerCase %)
                                               (keys interesting)))
        doors (select-keys interesting (filter #(Character/isUpperCase %)
                                               (keys interesting)))
        player (interesting \@)]
    {:p player
     :t (apply conj passages player (vals dkeys))
     :k dkeys
     :d doors}))

(defn path-between [trav point-a point-b]
  (let [succ (fn [[x y]]
               (filter trav
                       [[(inc x) y] [(dec x) y]
                        [x (inc y)] [x (dec y)]]))
        cost (fn [cs pt] (inc cs))
        heur (partial manhattan-distance point-b)
        des? (fn [pt] (= pt point-b))]
    (second (a-star succ cost heur point-a des?))))

(defn accessible [{player :p dkeys :k trav :t}]
  (->> dkeys
       (mmap (partial path-between trav player))
       (remove #(= ##Inf (second %)))
       (into {})))

#_(let [goto-nearest (fn [[p d k]]
                       (let [l (apply (partial min-key (partial manhattan-distance p)) k)]
                         [l (+ d (manhattan-distance p l)) (remove #{l} k)]))]
    (as-> [p 0 (vals k)] it
      (iterate goto-nearest it)
      (nth it (dec (count k)))
      (second it)))
(defn acquire-all-keys [world]
  (let [successor-world (fn [wo [kc ds]]
                          (let [kp (get-in wo [:k kc])
                                dc (Character/toUpperCase kc)
                                dp (get-in wo [:d dc])]
                            (-> wo
                                (assoc :p kp)
                                (assoc :$ ds)
                                (update :t conj dp)
                                (update-in [:k] dissoc kc)
                                (update-in [:l] conj kc))))
        succ (fn [wo] (map (partial successor-world wo) (accessible wo)))
        heur (fn [{:keys [p k]}]
               (if (empty? k) 0
                 (reduce max (map (partial manhattan-distance p) (vals k)))))
        cost (fn [cs pt] (+ cs (pt :$)))
        des? (fn [pt] (empty? (pt :k)))]
    (second (a-star succ cost heur (assoc world :l []) des?))))

(defn day18 []
  (let [input (get-list-from-file (input-file))
        world (build-world input)]
    (part1 (acquire-all-keys world))
    #_(part2)))