(ns advent.pathfind (:require [play-clj.core :refer :all] [play-clj.ui :refer :all] [play-clj.utils :refer :all] [play-clj.g2d :refer :all] [clojure.pprint] [clojure.data.priority-map :refer [priority-map]]) (:import [com.badlogic.gdx.files FileHandle] [com.badlogic.gdx Files] [java.lang Math] [com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture VertexAttributes$Usage])) (def compare-count (atom 0)) (def scale 2) (def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (< a b)))) (defn from-scale [[x y]] [(int (* scale x)) (int (* scale y))]) (defn to-scale [[x y]] [(int (/ x scale)) (int (/ y scale ))]) (defn printmap [my-map & [skip]] (let [skip (or skip 1)] (doseq [row (take-nth skip my-map)] (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]))))))))) (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) 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] [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)))) (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)] (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)))))))) (def d2 ^double (- (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) (unchecked-subtract current-x goal-x) (unchecked-subtract goal-x current-x )) 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))))) (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)) 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}) (loop [current-loc (.poll fronteir)] (if (or (nil? current-loc) (= (:loc current-loc) 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))))))))) (defn print-resolved [path my-map] (doseq [row (reduce (fn [acc path] (if path (update-in acc (reverse path) (constantly "X")) acc)) my-map path)] (println (map {1 \space 5 "." 0 "W" "X" "X"} row))) nil) (defn test-pathfind [] (let [my-map (random-map) path (visit-all my-map [1 1] [639 479 ])] (println "Test") (print-resolved path my-map) (println path))) (defn map-from-resource [filename] (let [pm (pixmap filename) black (color 0 0 0 255) painful (color 255 0 0 255)] (vec (take-nth scale (for [x (range (pixmap! pm :get-width))] (vec (take-nth scale (for [y (reverse (range (pixmap! pm :get-height))) :let [current-color (color (pixmap! pm :get-pixel x y))]] (cond (color! current-color :equals black) 0 (color! current-color :equals painful) 2 :else 1)))))))))