From dc40512eda9973d34c0f5fe406e6d0cb7cb2f991 Mon Sep 17 00:00:00 2001 From: = Date: Thu, 11 Sep 2014 12:49:21 -0700 Subject: [PATCH] Removed scaling. Hopefully we will make this fast enough where it doesn't matter. --- desktop/src-common/advent/actions.clj | 2 +- desktop/src-common/advent/pathfind.clj | 96 +++++++++++++------------- 2 files changed, 49 insertions(+), 49 deletions(-) diff --git a/desktop/src-common/advent/actions.clj b/desktop/src-common/advent/actions.clj index 9fc83ec8..1d1abfc2 100644 --- a/desktop/src-common/advent/actions.clj +++ b/desktop/src-common/advent/actions.clj @@ -45,7 +45,7 @@ (defn from-path [screen entities target-id [x y]] (let [entity (target-id entities) - path (vec (take-nth 2 (advent.pathfind/visit-all + path (vec (take-nth 4 (advent.pathfind/visit-all (:collision (:background entities)) [(int (:x entity)) (int (:y entity))] [(int x) (int y)]))) diff --git a/desktop/src-common/advent/pathfind.clj b/desktop/src-common/advent/pathfind.clj index 323a3a50..ad329928 100644 --- a/desktop/src-common/advent/pathfind.clj +++ b/desktop/src-common/advent/pathfind.clj @@ -16,9 +16,9 @@ (doseq [row (take-nth skip my-map)] (println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row)))))) -(defn random-map [] (-> (vec (take (/ 240 2) (repeatedly (fn [] (vec (take (/ 320 2) (repeatedly (fn [] (rand-nth [0 0 1 ]))))))))) - (update-in [1 1] (constantly 0)) - (update-in [50 50] (constantly 0)))) +(defn random-map [] (-> (vec (take (/ 240 4) (repeatedly (fn [] (vec (take (/ 320 4) (repeatedly (fn [] (rand-nth [1 1 1 1 1 5 0]))))))))) + (update-in [1 1] (constantly 1)) + (update-in [50 50] (constantly 1)))) (defn neighbors [[x y] my-map] @@ -31,16 +31,16 @@ (defn resolve-path [came-from play-loc target-loc] - (if (nil? (came-from target-loc)) - nil - (loop [path [] - current-node target-loc] - (if (or (= current-node play-loc) - (nil? current-node)) - (reverse (map (fn [[x y]] [(* x 2) (* y 2)]) (conj path current-node))) - (recur - (conj path current-node) - (came-from current-node)))))) + (doto (if (nil? (came-from target-loc)) + nil + (loop [path [] + current-node target-loc] + (if (or (= current-node play-loc) + (nil? current-node)) + (reverse (map (fn [[x y]] [x y]) (conj path current-node))) + (recur + (conj path current-node) + (came-from current-node))))) println)) (defn heuristic [[goal-x goal-y] [current-x current-y]] (let [dist-x (Math/abs (- goal-x current-x )) @@ -49,34 +49,30 @@ (+ dist-x dist-y (* (- d2 1) (min dist-x dist-y))))) -(defn ->scale [loc] - (vec (map (fn [x] (int (/ x 2))) loc))) (defn visit-all [my-map play-loc target-loc] - (let [play-loc (->scale play-loc) - target-loc (->scale target-loc)] - (if (= 0 (get-in my-map (reverse target-loc))) - nil - (loop [cost-so-far {play-loc 0} - came-from {} - fronteir (priority-map play-loc 0)] - (let [current-loc (first (keys fronteir))] - (if (or (empty? fronteir) - (= current-loc target-loc)) - (resolve-path came-from play-loc target-loc) - (let [neighbors (neighbors current-loc my-map) - [cost-so-far came-from fronteir] (reduce (fn [[cost-so-far came-from fronteir] neighbor] - (let [new-cost (+ (cost-so-far current-loc) (get-in my-map (reverse neighbor)))] - (if (or (nil? (cost-so-far neighbor)) - (< new-cost (cost-so-far neighbor))) - [(assoc cost-so-far neighbor new-cost) - (assoc came-from neighbor current-loc) - (assoc fronteir neighbor (+ new-cost (heuristic target-loc neighbor)))] - [cost-so-far came-from fronteir] - ))) - [cost-so-far came-from fronteir] - neighbors)] - - (recur cost-so-far came-from (dissoc fronteir current-loc))))))))) + (if (= 0 (get-in my-map (reverse target-loc))) + nil + (loop [cost-so-far {play-loc 0} + came-from {} + fronteir (priority-map play-loc 0)] + (let [current-loc (first (keys fronteir))] + (if (or (empty? fronteir) + (= current-loc target-loc)) + (resolve-path came-from play-loc target-loc) + (let [neighbors (neighbors current-loc my-map) + [cost-so-far came-from fronteir] (reduce (fn [[cost-so-far came-from fronteir] neighbor] + (let [new-cost (+ (cost-so-far current-loc) (get-in my-map (reverse neighbor)))] + (if (or (nil? (cost-so-far neighbor)) + (< new-cost (cost-so-far neighbor))) + [(assoc cost-so-far neighbor new-cost) + (assoc came-from neighbor current-loc) + (assoc fronteir neighbor (+ new-cost (heuristic target-loc neighbor)))] + [cost-so-far came-from fronteir] + ))) + [cost-so-far came-from fronteir] + neighbors)] + + (recur cost-so-far came-from (dissoc fronteir current-loc)))))))) (defn print-resolved [path my-map] @@ -87,17 +83,21 @@ my-map path)] - (println (map {1 \space 2 "." 0 "W" "X" "X"} row))) + (println (map {1 \space 5 "." 0 "W" "X" "X"} row))) nil) +(defn test-pathfind [] + (let [my-map (random-map)] + (print-resolved (visit-all my-map [1 1] [50 50]) my-map))) + (defn map-from-resource [filename] (let [pm (pixmap filename) black (color 0 0 0 255) painful (color 255 0 0 255)] - (vec (take-nth 2 (for [y (reverse (range (pixmap! pm :get-height)))] - (vec (take-nth 2 (for [x (range (pixmap! pm :get-width)) - :let [current-color (color (pixmap! pm :get-pixel x y))]] - (cond - (color! current-color :equals black) 0 - (color! current-color :equals painful) 10 - :else 1))))))))) + (vec (for [y (reverse (range (pixmap! pm :get-height)))] + (vec (for [x (range (pixmap! pm :get-width)) + :let [current-color (color (pixmap! pm :get-pixel x y))]] + (cond + (color! current-color :equals black) 0 + (color! current-color :equals painful) 10 + :else 1)))))))