Factor out A* implementation
authorJack Kinsey <kinsey_john@bah.com>
Fri, 20 Dec 2019 21:56:02 +0000 (16:56 -0500)
committerJack Kinsey <kinsey_john@bah.com>
Fri, 20 Dec 2019 21:56:02 +0000 (16:56 -0500)
Also, day18pt1 is now almost definitely correct. It's still too slow,
though.

src/adventofcode2019/day18.clj
src/adventofcode2019/lib.clj
test/adventofcode2019/day18_test.clj

index cbe88c9c011070216c294dd469f66de1fad33050..5cc644b97e79232708a512c0c997d1d08f38210b 100644 (file)
@@ -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
      :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
        (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))
index e81b3062011eb7d0149008ad82c4ab0cabb12535..aaeac0ca8f64ca9652c516494d1fe3b234027a38 100644 (file)
@@ -2,7 +2,8 @@
   [:require [clojure.string :as str]
    [clojure.edn :as edn]
    [clojure.java.io :as io]
-   [clojure.java.shell :refer [sh]]])
+   [clojure.java.shell :refer [sh]]
+   [clojure.data.priority-map :refer [priority-map-by]]])
 
 (defn get-list-from-file
   ([file-name]
   (+ (Math/abs (- ax bx))
      (Math/abs (- ay by))))
 
+(defn a-star
+  "succ :: state -> [state]
+  cost :: cost -> state -> cost
+  heur :: state -> cost
+  init :: state
+  des? :: state -> bool"
+  [succ cost heur init des?]
+  (let [update-openl (fn [ol sn pt cs]
+                       (reduce (fn [o p]
+                                 (assoc o p [(cost cs p) (heur p)]))
+                               ol (remove sn (succ pt))))
+        openl (priority-map-by (fn [[ag ah] [bg bh]]
+                                 (let [cmp (compare (+ ag ah) (+ bg bh))
+                                       cmp-g (compare ag bg)
+                                       cmp-h (compare ah bh)]
+                                   (if-not (zero? cmp)
+                                     cmp
+                                     (if-not (zero? cmp-g)
+                                       cmp-g
+                                       cmp-h)))))]
+    (loop [openl (assoc openl init [0 (heur init)])
+           seen #{init}]
+      (let [[point [dist _]] (peek openl)]
+        (cond
+          (empty? openl) [nil ##Inf]
+          (des? point) [point dist]
+          :else (let [openl (update-openl (pop openl) seen point dist)
+                      seen (apply conj seen (keys openl))]
+                  (recur openl seen)))))))
+
 (defn mmap [f m]
   (zipmap (keys m) (map f (vals m))))
 
index e962b491e5cd1d23a78ef8fa2aea9eff8fa0e2e3..239dae2d8ec8d5be0b08b3faf12780423b5fe1c7 100644 (file)
   (is (= 2 (path-between ((build-world ["#########"
                                         "#b.A.@.a#"
                                         "#########"]) :t)
-                         [5 1] [7 1]))))
+                         [5 1] [7 1])))
+  (is (= 28 (path-between ((build-world ["########################"
+                                         "#...............@.C.D.f#"
+                                         "#.######################"
+                                         "#.......a...c.d.A.e.F.g#"
+                                         "########################"]) :t)
+                          [16 1] [12 3]))))
 
 (deftest test-accessible
   (is (= {\a 2}
                                              "#.######################"
                                              "#.....@.a.B.c.d.A.e.F.g#"
                                              "########################"]))))
-  #_(is (= 136 (acquire-all-keys (build-world ["#################"
-                                               "#i.G..c...e..H.p#"
-                                               "########.########"
-                                               "#j.A..b...f..D.o#"
-                                               "########@########"
-                                               "#k.E..a...g..B.n#"
-                                               "########.########"
-                                               "#l.F..d...h..C.m#"
-                                               "#################"]))))
+  (is (= 136 (acquire-all-keys (build-world ["#################"
+                                             "#i.G..c...e..H.p#"
+                                             "########.########"
+                                             "#j.A..b...f..D.o#"
+                                             "########@########"
+                                             "#k.E..a...g..B.n#"
+                                             "########.########"
+                                             "#l.F..d...h..C.m#"
+                                             "#################"]))))
   (is (= 81 (acquire-all-keys (build-world ["########################"
                                             "#@..............ac.GI.b#"
                                             "###d#e#f################"