scaling = faster.

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

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

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 []
+  (if (nil? (came-from target-loc))
-         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)))
     nil
-    (loop [came-from {}
+    (loop [path []
-           fronteir [play-loc]]
+           current-node target-loc]
-      (let [[current-x current-y] (first fronteir)]
+      (if (or (= current-node play-loc)
-        (if (or (empty? fronteir)
+              (nil? current-node))
-                (= [current-x current-y] target-loc))
+        (reverse (map (fn [[x y]] [(* x 2) (* y 2)]) (conj path current-node)))
-          (if (nil? (came-from target-loc))
+        (recur
-            nil
+         (conj path current-node)
-            (resolve came-from play-loc target-loc))
+         (came-from current-node))))))
-          (let [neighbors (neighbors current-x current-y my-map)
+
-                [came-from fronteir] (reduce (fn [[came-from fronteir] neighbor]
+(defn heuristic [[goal-x goal-y] [current-x current-y]]
-                                               (if (came-from neighbor)
+  (+ (Math/abs (- goal-x current-x ))
-                                                 [came-from (vec fronteir)]
+     (Math/abs (- goal-y current-y))))
-                                                 [(assoc came-from neighbor [current-x current-y])
+
-                                                  (vec (conj fronteir neighbor))]))
+(defn ->scale [loc]
-                                             [came-from fronteir]
+  (vec (map (fn [x] (int (/ x 2))) loc)))
-                                             neighbors)]
+(defn visit-all [my-map play-loc target-loc]
-            (recur came-from (vec (rest fronteir)))))))))
+  (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)]
+  (let [pm (pixmap filename)
-    (vec (for [y (reverse (range (pixmap! pm :get-height)))]
+        black (color 0 0 0 255)
-           (vec (for [x (range (pixmap! pm :get-width))]
+        painful (color 255 0 0 255)]
-                  (if (color! (color (pixmap! pm :get-pixel x y)) :equals (color 0 0 0 255))
+    (vec (take-nth 2 (for [y (reverse (range (pixmap! pm :get-height)))]
-                    1 0)))))))
+                       (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)))))))))