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"
: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]

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

@@ -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]