notid/gitea-docker
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changes for about a 2x performance improvement.

Browse Source
This commit is contained in:
Paul Stadig
2014-09-13 17:02:43 -04:00
parent fb91cdcb68
commit 0c9ed24ecc
2 changed files with 50 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
desktop/project.clj
View File

@@ -1,6 +1,6 @@
(defproject advent "0.0.1-SNAPSHOT" (defproject advent "0.0.1-SNAPSHOT"
:description "FIXME: write description" :description "FIXME: write description"
:dependencies [[com.badlogicgames.gdx/gdx "1.3.0"] :dependencies [[com.badlogicgames.gdx/gdx "1.3.0"]
[com.badlogicgames.gdx/gdx-backend-lwjgl "1.3.0"] [com.badlogicgames.gdx/gdx-backend-lwjgl "1.3.0"]
[com.badlogicgames.gdx/gdx-box2d "1.3.0"] [com.badlogicgames.gdx/gdx-box2d "1.3.0"]
@@ -15,8 +15,8 @@
[org.clojure/clojure "1.6.0"] [org.clojure/clojure "1.6.0"]
#_[play-clj "0.3.9"] #_[play-clj "0.3.9"]
[org.clojure/data.priority-map "0.0.5"] [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"] :source-paths ["src" "src-common"]
:javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"] :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]
:aot [advent.core.desktop-launcher] :aot [advent.core.desktop-launcher]

80
desktop/src-common/advent/pathfind.clj
View File

@@ -4,13 +4,16 @@
(def scale 2) (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]] (defn from-scale [[x y]]
[(int (* scale x)) (int (* scale y))]) [(* scale x) (* scale y)])
(defn to-scale [[x y]] (defn to-scale [[x y]]
[(int (/ x scale)) (int (/ y scale ))]) [(quot x scale) (quot y scale)])
(defn printmap [my-map & [skip]] (defn printmap [my-map & [skip]]
(let [skip (or skip 1)] (let [skip (or skip 1)]
@@ -18,40 +21,43 @@
(println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row)))))) (println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row))))))
(defn random-map [] (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 [1 1] (constantly 1))
(update-in [639 479] (constantly 1)))) (update-in [639 479] (constantly 1))))
(defn neighbors [[^long x ^long y] my-map] (defn neighbors [^long x ^long y my-map]
(let [x (long x) (let [left-x (unchecked-subtract x 1)
y (long y)
left-x (unchecked-subtract x 1)
right-x (unchecked-add x 1) right-x (unchecked-add x 1)
top-y (unchecked-subtract y 1) top-y (unchecked-subtract y 1)
below-y (unchecked-add 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 y] [right-x y]
[left-x below-y] [x below-y] [right-x below-y]] [left-x below-y] [x below-y] [right-x below-y]]
height (count (first my-map)) height (count (first my-map))
width (count my-map)] width (count my-map)]
(remove #(= 0 (get-in my-map %)) (remove (fn [[x y]]
(filter (fn [[^long x ^long y]] (and (< -1 x width) (= 0 (nth (nth my-map x) y)))
(< -1 y height))) candidates)))) (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] (defn resolve-path [came-from play-loc target-loc]
(let [came-from (into {} came-from)] (let [came-from (into {} came-from)]
(if (nil? (came-from target-loc)) (if (nil? (came-from target-loc))
nil nil
(loop [path [] (loop [path []
current-node (vec target-loc)] current-node target-loc]
(if (or (= current-node play-loc) (if (or (= current-node play-loc)
(nil? current-node)) (nil? current-node))
(reverse (conj path (from-scale current-node))) (reverse (conj path (from-scale current-node)))
(recur (recur
(conj path (from-scale current-node)) (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] (defn heuristic ^long [^long goal-x ^long goal-y ^long current-x ^long current-y]
(let [dist-x (if (< goal-x current-x) (let [dist-x (if (< goal-x current-x)
@@ -60,33 +66,41 @@
dist-y (if (< goal-y current-y) dist-y (if (< goal-y current-y)
(unchecked-subtract current-y goal-y) (unchecked-subtract current-y goal-y)
(unchecked-subtract goal-y current-y)) (unchecked-subtract goal-y current-y))
min-dist ^double (double (min dist-x dist-y))] min-dist (double (min dist-x dist-y))]
(unchecked-add (unchecked-add dist-x dist-y ) (unchecked-add (unchecked-add dist-x dist-y)
(long (unchecked-multiply ^double d2 min-dist))))) (long (unchecked-multiply (double d2) min-dist)))))
(defn visit-all [my-map play-loc target-loc] (defn visit-all [my-map play-loc target-loc]
(let [play-loc (vec (to-scale play-loc)) (let [play-loc (to-scale play-loc)
target-loc (vec (to-scale target-loc))] [tx ty :as target-loc] (to-scale target-loc)
(if (= 0 (get-in my-map target-loc)) tx (long tx)
ty (long ty)]
(if (= 0 (nth (nth my-map tx) ty))
nil nil
(let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0}) (let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0})
came-from ^java.util.HashMap (java.util.HashMap.) came-from ^java.util.HashMap (java.util.HashMap.)
fronteir ^java.util.PriorityQueue (java.util.PriorityQueue. (/ (* 320 240) scale) cost-comparator)] 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)] (loop [current-loc (.poll fronteir)]
(if (or (nil? current-loc) (if (or (nil? current-loc)
(= (:loc current-loc) target-loc)) (= (nth current-loc 1) target-loc))
(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 [[_ [cx cy :as current-loc]] current-loc
(let [cost-for-neighbor (.get cost-so-far neighbor) cx (long cx)
new-cost (+ (.get cost-so-far (:loc current-loc)) (get-in my-map neighbor))] cy (long cy)]
(when (or (nil? cost-for-neighbor) (doseq [[nx ny :as neighbor] (neighbors cx cy my-map)
(< new-cost cost-for-neighbor)) :let [nx (long nx)
(.put came-from (vec neighbor) (vec (:loc current-loc))) ny (long ny)]]
(.put cost-so-far (vec neighbor) new-cost) (let [cost-for-neighbor (.get cost-so-far neighbor)
(.offer fronteir {:cost (+ new-cost (heuristic (first target-loc) (second target-loc) (first neighbor) (second neighbor))) new-cost (unchecked-add (long (.get cost-so-far current-loc))
:loc neighbor})))) (long (nth (nth my-map nx) ny)))]
(recur (.poll fronteir))))))))) (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] (defn print-resolved [path my-map]
(doseq [row (reduce (fn [acc path] (doseq [row (reduce (fn [acc path]