From: Jack Kinsey Date: Fri, 20 Dec 2019 21:56:02 +0000 (-0500) Subject: Factor out A* implementation X-Git-Url: http://git.jkinsey.net/?p=adventofcode2019.git;a=commitdiff_plain;h=fa02619ed39b05a9d8bb83e73aac4779dd38cac5 Factor out A* implementation Also, day18pt1 is now almost definitely correct. It's still too slow, though. --- diff --git a/src/adventofcode2019/day18.clj b/src/adventofcode2019/day18.clj index cbe88c9..5cc644b 100644 --- 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)) diff --git a/src/adventofcode2019/lib.clj b/src/adventofcode2019/lib.clj index e81b306..aaeac0c 100644 --- a/src/adventofcode2019/lib.clj +++ b/src/adventofcode2019/lib.clj @@ -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] @@ -24,6 +25,36 @@ (+ (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)))) diff --git a/test/adventofcode2019/day18_test.clj b/test/adventofcode2019/day18_test.clj index e962b49..239dae2 100644 --- a/test/adventofcode2019/day18_test.clj +++ b/test/adventofcode2019/day18_test.clj @@ -15,7 +15,13 @@ (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} @@ -37,15 +43,15 @@ "#.######################" "#.....@.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################"