Factor out A* implementation

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

diff --git a/src/adventofcode2019/day18.clj b/src/adventofcode2019/day18.clj
index cbe88c9c011070216c294dd469f66de1fad33050..5cc644b97e79232708a512c0c997d1d08f38210b 100644 (file)
--- a/src/adventofcode2019/day18.clj
+++ b/src/adventofcode2019/day18.clj
@@ -4,8 +4,7 @@
    [clojure.string :as str]
    [clojure.set :as set]
    [clojure.core.match :refer [match]]
-   [clojure.math.combinatorics :as combo]
-   [clojure.data.priority-map :refer [priority-map-by]]])
+   [clojure.math.combinatorics :as combo]])
 
 (defn build-world [input]
   (let [point-encode (->> input
@@ -34,25 +33,14 @@
      :d doors}))
 
 (defn path-between [trav point-a point-b]
-  (let [succ (fn [sn [x y]]
-               (filter (every-pred trav (complement sn))
+  (let [succ (fn [[x y]]
+               (filter trav
                        [[(inc x) y] [(dec x) y]
                         [x (inc y)] [x (dec y)]]))
-        update-openl (fn [ol sn pt ds]
-                       (reduce (fn [m p] 
-                                 (assoc m p [ds (manhattan-distance p point-b)]))
-                               ol (succ sn pt)))
-        openl (priority-map-by (fn [[ag ah] [bg bh]]
-                                 (compare (+ ag ah) (+ bg bh))))]
-    (loop [openl (assoc openl point-a 
-                        [0 (manhattan-distance point-a point-b)])
-           seen #{point-a}]
-      (cond 
-        (contains? openl point-b) (first (openl point-b))
-        (empty? openl) ##Inf
-        :else (let [[point [dist _]] (peek openl)
-                    seen (conj seen point)]
-                (recur (update-openl (pop openl) seen point (inc dist)) seen))))))
+        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
@@ -60,23 +48,31 @@
        (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]
-  (if (empty? (world :k)) 0
-    (let [accessible-keys (accessible world)
-          successor-world (fn [[kc ds]]
-                            (let [kp (get-in world [:k kc])
-                                  dc (Character/toUpperCase kc)
-                                  dp (get-in world [:d dc])]
-                              [ds (-> world
-                                      (assoc :p kp)
-                                      (update :t conj dp)
-                                      (update-in [:k] dissoc kc))]))
-          successors (map successor-world accessible-keys)
-          combine-levels (fn [[ds wo]] (+ ds (acquire-all-keys wo)))
-          ret (reduce min (map combine-levels successors))]
-      (clojure.pprint/pprint world)
-      (clojure.pprint/pprint ret)
-      ret)))
+  (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))