diff --git a/desktop/project.clj b/desktop/project.clj index 2215da1e..13da26f0 100644 --- a/desktop/project.clj +++ b/desktop/project.clj @@ -12,7 +12,8 @@ [com.badlogicgames.gdx/gdx-platform "1.3.0" :classifier "natives-desktop"] [org.clojure/clojure "1.6.0"] - [play-clj "0.3.9"]] + [play-clj "0.3.9"] + [org.clojure/data.priority-map "0.0.5"]] :source-paths ["src" "src-common"] :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"] diff --git a/desktop/resources/pathfind-test-big.png b/desktop/resources/pathfind-test-big.png index 38611a98..eccd3afe 100644 Binary files a/desktop/resources/pathfind-test-big.png and b/desktop/resources/pathfind-test-big.png differ diff --git a/desktop/src-common/advent/core.clj b/desktop/src-common/advent/core.clj index 96d06c0e..ff438347 100644 --- a/desktop/src-common/advent/core.clj +++ b/desktop/src-common/advent/core.clj @@ -33,7 +33,7 @@ (defn left-click [screen entities] (let [{:keys [x y]} (input->screen screen {:x (:input-x screen) :y (:input-y screen)})] - (assoc-in entities [:ego :target-path] (take-nth 10 (advent.pathfind/visit-all + (assoc-in entities [:ego :target-path] (take-nth 2 (advent.pathfind/visit-all (:collision (:background entities)) [(int (:x (:ego entities))) (int (:y (:ego entities)))] [(int x) (int y)]))))) diff --git a/desktop/src-common/advent/pathfind.clj b/desktop/src-common/advent/pathfind.clj index c58ae5e9..17f051aa 100644 --- a/desktop/src-common/advent/pathfind.clj +++ b/desktop/src-common/advent/pathfind.clj @@ -3,7 +3,8 @@ [play-clj.ui :refer :all] [play-clj.utils :refer :all] [play-clj.g2d :refer :all] - [clojure.pprint]) + [clojure.pprint] + [clojure.data.priority-map :refer [priority-map]]) (:import [com.badlogic.gdx.files FileHandle] [com.badlogic.gdx Files] [com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera @@ -13,52 +14,66 @@ (defn printmap [my-map & [skip]] (let [skip (or skip 1)] (doseq [row (take-nth skip my-map)] - (println (take-nth skip (map {0 \space 1 "W" "X" "X" "." "."} row)))))) + (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 neighbors [x y my-map] +(defn neighbors [[x y] my-map] (let [candidates [[(dec x) (dec y)] [x (dec y)] [(inc x) (dec y)] [(dec x) y] [(inc x) y] [(dec x) (inc y)] [x (inc y)] [(inc x) (inc y)]]] - (remove #(= 1 (get-in my-map (reverse %))) + (remove #(= 0 (get-in my-map (reverse %))) (filter (fn [[x y]] (and (< -1 x (count (first my-map))) (< -1 y (count my-map)))) candidates)))) (defn resolve [came-from play-loc target-loc] - (loop [path [] - current-node target-loc] - (if (or (= current-node play-loc) - (nil? current-node)) - (reverse (conj path current-node)) - (recur - (conj path current-node) - (came-from current-node))))) - -(defn visit-all [my-map play-loc target-loc ] - (if (= 1 (get-in my-map (reverse target-loc))) + (if (nil? (came-from target-loc)) nil - (loop [came-from {} - fronteir [play-loc]] - (let [[current-x current-y] (first fronteir)] - (if (or (empty? fronteir) - (= [current-x current-y] target-loc)) - (if (nil? (came-from target-loc)) - nil - (resolve came-from play-loc target-loc)) - (let [neighbors (neighbors current-x current-y my-map) - [came-from fronteir] (reduce (fn [[came-from fronteir] neighbor] - (if (came-from neighbor) - [came-from (vec fronteir)] - [(assoc came-from neighbor [current-x current-y]) - (vec (conj fronteir neighbor))])) - [came-from fronteir] - neighbors)] - (recur came-from (vec (rest fronteir))))))))) + (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)))))) + +(defn heuristic [[goal-x goal-y] [current-x current-y]] + (+ (Math/abs (- goal-x current-x )) + (Math/abs (- goal-y current-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 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] @@ -69,12 +84,17 @@ my-map path)] - (println (map {0 \space 1 "W" "X" "X"} row))) + (println (map {1 \space 2 "." 0 "W" "X" "X"} row))) nil) (defn map-from-resource [filename] - (let [pm (pixmap filename)] - (vec (for [y (reverse (range (pixmap! pm :get-height)))] - (vec (for [x (range (pixmap! pm :get-width))] - (if (color! (color (pixmap! pm :get-pixel x y)) :equals (color 0 0 0 255)) - 1 0))))))) + (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)))))))))