-
-
Save mjg123/95c34515794822e549e83a3b12c71e24 to your computer and use it in GitHub Desktop.
| ;; Rewrite of https://en.wikipedia.org/wiki/A*_search_algorithm#Pseudocode in a functional way | |
| #?(:cljs (def INFINITY 9007199254740991)) ;; Math.pow(2,53)-1 | |
| #?(:clj (def INFINITY Integer/MAX_VALUE)) | |
| (defn a* | |
| ([graph start goal heuristic] (a* graph start goal heuristic | |
| #{start} #{} {} | |
| {start 0} {start (heuristic start goal)})) | |
| ([graph start goal h | |
| open-set closed-set came-from | |
| g-score f-score] | |
| (if (empty? open-set) | |
| :disjoint-graph-no-route-possible | |
| (let [current (apply min-key #(get f-score % INFINITY) open-set) | |
| open-set (disj open-set current) | |
| closed-set (conj closed-set current)] | |
| (if (= current goal) | |
| ;; We made it! Reconstruct the path using the came-from map | |
| (loop [path [goal]] | |
| (if (came-from (last path)) | |
| (recur (conj path (came-from (last path)))) | |
| (reverse path))) | |
| (loop [neighbours (graph current) | |
| open-set open-set | |
| came-from came-from | |
| f-score f-score | |
| g-score g-score] | |
| (if-let [[neighbour cost] (first neighbours)] | |
| (if (or ;; we already finished with this neighbour | |
| (closed-set neighbour) | |
| ;; or the score isn't any better coming this way | |
| (>= (+ cost (g-score current)) (get g-score neighbour INFINITY))) | |
| ;; disregard this neighbour and carry on | |
| (recur (rest neighbours) open-set came-from f-score g-score) | |
| ;; We found a new best path to this neighbour! | |
| (recur (rest neighbours) | |
| (conj open-set neighbour) | |
| (assoc came-from neighbour current) | |
| (assoc f-score neighbour (+ cost (g-score current) (h neighbour goal))) | |
| (assoc g-score neighbour (+ cost (g-score current))))) | |
| (a* graph start goal h open-set closed-set came-from g-score f-score)))))))) ;; NON-TCO :( | |
| (def the-graph | |
| {:a [[:b 2] [:c 1]] ;; a --(2)-- b --(9)-- e | |
| :b [[:a 2] [:d 3] [:e 9]] ;; | | / | |
| :c [[:a 1] [:d 9]] ;; (1) (3) (4) | |
| :d [[:c 9] [:b 3] [:e 4]] ;; | | / | |
| :e [[:b 9] [:d 4]]}) ;; c --(9)-- d-----/ | |
| (a* the-graph :c :e (constantly 0)) ;; => (:c :a :b :d :e) | |
Does this make it more readable? maybe more functional?
(defn recover-path
[goal came-from]
(loop [path [goal]]
(if-let [node (came-from (last path))]
(recur (conj path node))
(reverse path))))
(defn a*_t
([graph start goal h
open-set closed-set came-from
g-score f-score]
(let [current (or (apply min-key f-score open-set) INFINITY)
closed-set (conj closed-set current)]
(cond
(empty? open-set) :disjoint-graph-no-route-possible
(= current goal) (recover-path goal came-from)
:else (loop [[[neighbour cost] & rest-neighbours] (graph current)
open-set (disj open-set current)
came-from came-from
f-score f-score
g-score g-score]
(cond
(not (and neighbour cost)) (fn []
(a*_t graph start goal h open-set closed-set came-from g-score f-score))
;; we already finished with this neighbour
(closed-set neighbour) (recur rest-neighbours open-set came-from f-score g-score)
;; or the score isn't any better coming this way
(>= (+ cost (g-score current))
(get g-score neighbour INFINITY)) (recur rest-neighbours open-set came-from f-score g-score)
;; We found a new best path to this neighbour!
:else (recur rest-neighbours
(conj open-set neighbour)
(assoc came-from neighbour current)
(assoc f-score neighbour (+ cost (g-score current) (h neighbour goal)))
(assoc g-score neighbour (+ cost (g-score current))))))))))
(defn a*
[graph start goal heuristic]
(trampoline a*_t graph start goal heuristic
#{start} #{} {}
{start 0} {start (heuristic start goal)}))
Yes! Thanks @suchbinary. I like the first version and the second version. I'm playing with something which will run this over pretty large graphs so it's nice to have it not oveflow. This destructuring is nice: [[neighbour cost] & rest-neighbours] (graph current). And trampoline is the right answer I think because recur will always target it's closest thing, so you can't recur back to an outer loop.
There's two things I didn't like about my original code which have persisted still.
1/ (let [current (apply min-key #(get f-score % INFINITY) open-set) .... - This is more complicated than necessary because everything in open-set is guaranteed to be in f-score as well (lines 46,48) so we don't need to specify the default of INFINITY here. In your code, I'd say we can:
(let [current (or (apply min-key f-score open-set) INFINITY) ... => (let [current (apply min-key f-score open-set) ...
(current should be the name of a node, so setting it to INFINITY doesn't make sense, but we'd never hit that case anyway)
2/ I don't like shadowing vars - (let [open-set (disj open-set current)] ... confuses me because when I see an open-set in code I have to check carefully which one it is.
My next thing to do with it is add this to a web-page and fire up the Chrome profiler to look for perf gains.
Can you please post the numbers when you have time..I'm interested to see the difference
Yup... trampoline seems to do the job.. I've rejigged the code a bit