From b13aa6a26e303ab2cf57a79673a103295ec9a6f1 Mon Sep 17 00:00:00 2001 From: = Date: Fri, 12 Sep 2014 15:56:32 -0700 Subject: [PATCH] pathfinding is reasonably fast. --- desktop/src-common/advent/pathfind.clj | 85 ++++++++++++--------- desktop/src-common/advent/screens/scene.clj | 2 +- 2 files changed, 50 insertions(+), 37 deletions(-) diff --git a/desktop/src-common/advent/pathfind.clj b/desktop/src-common/advent/pathfind.clj index a18c8785..de06495d 100644 --- a/desktop/src-common/advent/pathfind.clj +++ b/desktop/src-common/advent/pathfind.clj @@ -12,73 +12,86 @@ PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture VertexAttributes$Usage])) +(def compare-count (atom 0)) + +(def scale 2) + +(def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (< a b)))) + +(defn from-scale [[x y]] + [(int (* scale x)) (int (* scale y))]) + +(defn to-scale [[x y]] + [(int (/ x scale)) (int (/ y scale ))]) + (defn printmap [my-map & [skip]] (let [skip (or skip 1)] (doseq [row (take-nth skip my-map)] (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 5 5 0]))))))))) +(defn random-map [] (-> (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 [candidates [[^long (dec x) ^long (dec y)] [x ^long (dec y)] [^long (inc x) ^long (dec y)] - [^long (dec x) y] [^long (inc x) y] - [^long (dec x) ^long (inc y)] [x ^long (inc y)] [^long (inc x) ^long (inc y)]] + (let [x (long x) + y (long y) + 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] + [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 [[x y]] (and (< -1 x width) - (< -1 y height))) candidates)))) + (filter (fn [[^long x ^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)] (if (or (= current-node play-loc) (nil? current-node)) - (reverse (conj path current-node)) + (reverse (conj path (from-scale current-node))) (recur - (conj path current-node) + (conj path (from-scale current-node)) (came-from (vec current-node)))))))) -(def d2 ^double (- (Math/sqrt 2) 1)) -(defn heuristic [^long goal-x ^long goal-y ^long current-x ^long current-y] - (let [dist-x ^long (if (< goal-x current-x) - ^long (- current-x goal-x) - ^long (- goal-x current-x )) - dist-y ^long (if (< goal-y current-y) - ^long (- current-y goal-y) - ^long (- goal-y current-y))] - ^long (+ dist-x dist-y (* ^double d2 - ^long (min dist-x dist-y))))) +(def d2 ^double (- (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) + (unchecked-subtract current-x goal-x) + (unchecked-subtract goal-x current-x )) + 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))))) -(def my-count (atom 0)) - -(def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (do (swap! my-count inc) (< a b))))) (defn visit-all [my-map play-loc target-loc] - (reset! my-count 0) - (let [play-loc (vec play-loc) - target-log (vec 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)) 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. 100 cost-comparator)] + fronteir ^java.util.PriorityQueue (java.util.PriorityQueue. (/ (* 320 240) scale) cost-comparator)] (.offer fronteir {:cost 0 :loc play-loc}) (loop [current-loc (.poll fronteir)] (if (or (nil? current-loc) (= (:loc current-loc) target-loc)) - (do (println @my-count) - (resolve-path came-from play-loc 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))] @@ -106,17 +119,17 @@ (let [my-map (random-map) path (visit-all my-map [1 1] [639 479 ])] (println "Test") - #_(print-resolved path my-map) + (print-resolved path my-map) (println path))) (defn map-from-resource [filename] (let [pm (pixmap filename) black (color 0 0 0 255) painful (color 255 0 0 255)] - (vec (for [x (range (pixmap! pm :get-width))] - (vec (for [y (reverse (range (pixmap! pm :get-height))) - :let [current-color (color (pixmap! pm :get-pixel x y))]] - (cond - (color! current-color :equals black) 0 - (color! current-color :equals painful) 1 - :else 1))))))) + (vec (take-nth scale (for [x (range (pixmap! pm :get-width))] + (vec (take-nth scale (for [y (reverse (range (pixmap! pm :get-height))) + :let [current-color (color (pixmap! pm :get-pixel x y))]] + (cond + (color! current-color :equals black) 0 + (color! current-color :equals painful) 2 + :else 1))))))))) diff --git a/desktop/src-common/advent/screens/scene.clj b/desktop/src-common/advent/screens/scene.clj index d3db0d12..e22c97ad 100644 --- a/desktop/src-common/advent/screens/scene.clj +++ b/desktop/src-common/advent/screens/scene.clj @@ -123,7 +123,7 @@ house (texture "house.png") overdirt (texture "overdirt.png") music (sound "town-music.mp3") - _ (sound! music :loop) + ;;_ (sound! music :loop) ] { :cursor {:id "cursor" :current :walk }