From 0c9ed24eccc50193395c48df7eb084f9db5cc6d4 Mon Sep 17 00:00:00 2001 From: Paul Stadig Date: Sat, 13 Sep 2014 17:02:43 -0400 Subject: [PATCH] Changes for about a 2x performance improvement. --- desktop/project.clj | 6 +- desktop/src-common/advent/pathfind.clj | 80 +++++++++++++++----------- 2 files changed, 50 insertions(+), 36 deletions(-) diff --git a/desktop/project.clj b/desktop/project.clj index 66fec16e..51778ae5 100644 --- a/desktop/project.clj +++ b/desktop/project.clj @@ -1,6 +1,6 @@ (defproject advent "0.0.1-SNAPSHOT" :description "FIXME: write description" - + :dependencies [[com.badlogicgames.gdx/gdx "1.3.0"] [com.badlogicgames.gdx/gdx-backend-lwjgl "1.3.0"] [com.badlogicgames.gdx/gdx-box2d "1.3.0"] @@ -15,8 +15,8 @@ [org.clojure/clojure "1.6.0"] #_[play-clj "0.3.9"] [org.clojure/data.priority-map "0.0.5"] - [org.clojure/core.async "0.1.338.0-5c5012-alpha"]] - + [org.clojure/core.async "0.1.338.0-5c5012-alpha"]] + :source-paths ["src" "src-common"] :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"] :aot [advent.core.desktop-launcher] diff --git a/desktop/src-common/advent/pathfind.clj b/desktop/src-common/advent/pathfind.clj index e3c798c5..0888ebf9 100644 --- a/desktop/src-common/advent/pathfind.clj +++ b/desktop/src-common/advent/pathfind.clj @@ -4,13 +4,16 @@ (def scale 2) -(def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (< a b)))) +(def cost-comparator (fn [[a] [b]] + (let [a (long a) + b (long b)] + (unchecked-subtract a b)))) (defn from-scale [[x y]] - [(int (* scale x)) (int (* scale y))]) + [(* scale x) (* scale y)]) (defn to-scale [[x y]] - [(int (/ x scale)) (int (/ y scale ))]) + [(quot x scale) (quot y scale)]) (defn printmap [my-map & [skip]] (let [skip (or skip 1)] @@ -18,40 +21,43 @@ (println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row)))))) (defn random-map [] - (-> (vec (take 640 (repeatedly (fn [] (vec (take 480 (repeatedly (fn [] (rand-nth [1 1 1 1 1 0]))))))))) + (-> (vec (take 640 (repeatedly (fn [] (vec (take 480 (repeatedly (fn [] (rand-nth [1 1 1 1 1 0]))))))))) (update-in [1 1] (constantly 1)) (update-in [639 479] (constantly 1)))) -(defn neighbors [[^long x ^long y] my-map] - (let [x (long x) - y (long y) - left-x (unchecked-subtract x 1) +(defn neighbors [^long x ^long y my-map] + (let [left-x (unchecked-subtract x 1) right-x (unchecked-add x 1) top-y (unchecked-subtract y 1) below-y (unchecked-add y 1) - candidates [[left-x top-y] [x top-y] [right-x top-y] + candidates [[left-x top-y] [x top-y] [right-x top-y] [left-x y] [right-x y] [left-x below-y] [x below-y] [right-x below-y]] height (count (first my-map)) width (count my-map)] - (remove #(= 0 (get-in my-map %)) - (filter (fn [[^long x ^long y]] (and (< -1 x width) - (< -1 y height))) candidates)))) + (remove (fn [[x y]] + (= 0 (nth (nth my-map x) y))) + (filter (fn [[x y]] + (let [x (long x) + y (long y)] + (and (< -1 x width) + (< -1 y height)))) + candidates)))) (defn resolve-path [came-from play-loc target-loc] (let [came-from (into {} came-from)] (if (nil? (came-from target-loc)) nil (loop [path [] - current-node (vec target-loc)] + current-node target-loc] (if (or (= current-node play-loc) (nil? current-node)) (reverse (conj path (from-scale current-node))) (recur (conj path (from-scale current-node)) - (came-from (vec current-node)))))))) + (came-from current-node))))))) -(def d2 ^double (- (Math/sqrt 2) 2)) +(def d2 (- (Math/sqrt 2) 2)) (defn heuristic ^long [^long goal-x ^long goal-y ^long current-x ^long current-y] (let [dist-x (if (< goal-x current-x) @@ -60,33 +66,41 @@ dist-y (if (< goal-y current-y) (unchecked-subtract current-y goal-y) (unchecked-subtract goal-y current-y)) - min-dist ^double (double (min dist-x dist-y))] - (unchecked-add (unchecked-add dist-x dist-y ) - (long (unchecked-multiply ^double d2 min-dist))))) + min-dist (double (min dist-x dist-y))] + (unchecked-add (unchecked-add dist-x dist-y) + (long (unchecked-multiply (double d2) min-dist))))) (defn visit-all [my-map play-loc target-loc] - (let [play-loc (vec (to-scale play-loc)) - target-loc (vec (to-scale target-loc))] - (if (= 0 (get-in my-map target-loc)) + (let [play-loc (to-scale play-loc) + [tx ty :as target-loc] (to-scale target-loc) + tx (long tx) + ty (long ty)] + (if (= 0 (nth (nth my-map tx) ty)) nil (let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0}) came-from ^java.util.HashMap (java.util.HashMap.) fronteir ^java.util.PriorityQueue (java.util.PriorityQueue. (/ (* 320 240) scale) cost-comparator)] - (.offer fronteir {:cost 0 :loc play-loc}) + (.offer fronteir [0 play-loc]) (loop [current-loc (.poll fronteir)] (if (or (nil? current-loc) - (= (:loc current-loc) target-loc)) + (= (nth current-loc 1) target-loc)) (resolve-path came-from play-loc target-loc) - (do (doseq [neighbor (neighbors (:loc current-loc) my-map)] - (let [cost-for-neighbor (.get cost-so-far neighbor) - new-cost (+ (.get cost-so-far (:loc current-loc)) (get-in my-map neighbor))] - (when (or (nil? cost-for-neighbor) - (< new-cost cost-for-neighbor)) - (.put came-from (vec neighbor) (vec (:loc current-loc))) - (.put cost-so-far (vec neighbor) new-cost) - (.offer fronteir {:cost (+ new-cost (heuristic (first target-loc) (second target-loc) (first neighbor) (second neighbor))) - :loc neighbor})))) - (recur (.poll fronteir))))))))) + (let [[_ [cx cy :as current-loc]] current-loc + cx (long cx) + cy (long cy)] + (doseq [[nx ny :as neighbor] (neighbors cx cy my-map) + :let [nx (long nx) + ny (long ny)]] + (let [cost-for-neighbor (.get cost-so-far neighbor) + new-cost (unchecked-add (long (.get cost-so-far current-loc)) + (long (nth (nth my-map nx) ny)))] + (when (or (nil? cost-for-neighbor) + (< new-cost cost-for-neighbor)) + (.put came-from neighbor current-loc) + (.put cost-so-far neighbor new-cost) + (.offer fronteir [(unchecked-add new-cost (heuristic tx ty nx ny)) + neighbor])))) + (recur (.poll fronteir))))))))) (defn print-resolved [path my-map] (doseq [row (reduce (fn [acc path]