From 48d9aacb697f361cbabbd2a111df61484a9ba8a7 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 5 Jun 2020 13:08:51 +0100
Subject: [PATCH] Written, not yet working.

---
 project.clj             |  1 +
 src/walkmap/routing.clj | 84 +++++++++++++++++++++--------------------
 2 files changed, 45 insertions(+), 40 deletions(-)

diff --git a/project.clj b/project.clj
index 0a448bb..7a61a63 100644
--- a/project.clj
+++ b/project.clj
@@ -13,6 +13,7 @@
                  [com.taoensso/timbre "4.10.0"]
                  [dali "0.7.4"] ;; not currently used because performance issues.
                  [hiccup "1.0.5"]
+                 [macroz/search "0.3.0"]
                  [me.raynes/fs "1.4.6"]
                  [smee/binary "0.5.5"]]
   :deploy-repositories [["releases" :clojars]
diff --git a/src/walkmap/routing.clj b/src/walkmap/routing.clj
index c9f7c7c..4d3c4d6 100644
--- a/src/walkmap/routing.clj
+++ b/src/walkmap/routing.clj
@@ -2,6 +2,8 @@
   "Finding optimal routes to traverse a map."
   (:require [clojure.math.numeric-tower :as m :only [expt]]
             [clojure.set :refer [intersection]]
+            [clojure.string :as cs :only [join]]
+            [search.core :refer [a*]]
             [walkmap.edge :as e]
             [walkmap.path :as p]
             [walkmap.polygon :as q]
@@ -36,14 +38,12 @@
   -2)
 
 (defn traversable?
-  "True if this object can be considered as part of the walkmap."
+  "True if this `object` is a polygon which can be considered as part of
+  the walkmap."
   [object]
   (and
-    (or
-      (and
-        (q/polygon? object)
-        (:centre object))
-      (p/path? object))
+    (q/polygon? object)
+    (:centre object)
     (not (t/tagged? object :no-traversal))))
 
 (declare traversal-cost)
@@ -149,7 +149,8 @@
 
 (defn extend-frontier
   "Return a sequence like `frontier` with all of these `candidates` which are
-  not already members either of `frontier` or of `rejects` appended."
+  not already members either of `frontier` or of `rejects` appended. Assumes
+  candidates are traversable."
   ([frontier candidates]
    (extend-frontier frontier candidates nil))
   ([frontier candidates rejects]
@@ -165,37 +166,40 @@
 ;; (extend-frontier '(1 2 3 4 5) nil)
 ;; (extend-frontier nil '(1 2 3 4 5))
 
-(defn route
-  ;; NOT YET GOOD ENOUGH! Simple breadth first, and although it will
-  ;; reach the goal
-  ([from to s search-radius]
-   (loop [f from
-          t to
-          frontier (extend-frontier
-                     nil
-                     (s/neighbour-ids
-                       (s/nearest s from :centre search-radius)
-                       traversable?
-                       s))
-          visited nil
-          track nil]
-     (let [here (s/retrieve (first frontier) s)]
-       (cond
-         (< (e/length (e/edge (:centre here)) to) search-radius)
-         ;; close enough
-         (apply p/path (cons (:centre here) track))
-         (empty? (rest frontier))
-         ;; failed
-         nil
-         :else
-         (recur
-           f
-           t
-           (extend-frontier
-             (rest frontier)
-             (s/neighbour-ids here traversable? s)
-             visited)
-           (cons here visited)
-           ;; this is going to be wrong, and I need to think about how to fix.
-           (cons here track)))))))
+(def ^:dynamic *route-goal*
+  "The goal of the route currently sought."
+  nil)
 
+(defn find-traversable-facet
+  "Return the nearest traversable walkmap facet within `search-radius` of
+  `target`, or throw an exception if none is found."
+  [target search-radius s]
+  (let [r (s/nearest s target traversable? search-radius)]
+    (when-not r (throw
+                  (Exception.
+                    (cs/join " " ["Unable to find walkable facet within"
+                                  search-radius
+                                  "of"
+                                  target]))))
+    r))
+
+(defn route
+  ;; architectural problem: needs to return not the route, but a modified
+  ;; superstructure with the new route stored in it.
+  ([from to s]
+   (route from to s traversal-cost 5))
+  ([from to s cost-fn search-radius]
+   (let [from' (find-traversable-facet from search-radius s)
+         to' (find-traversable-facet to search-radius s)]
+     (a* from'
+         #(v/vertex= % (:centre to')) ;; goal?-fn - 'have we got there yet?'
+         #(cost-fn %1 %2 s)           ;; distance-fn - what is the distance/cost
+                                      ;; between these vertices?
+         #(e/length (e/edge (:centre %) to))
+                                      ;; heuristic: how far to the end goal
+         #(s/neighbours % traversable? s)
+                                      ;; neighbours-fn - return the traversable
+                                      ;; neighbours of the current facet
+         (int (* search-radius (e/length (e/edge from to))))
+                                      ;; how long a path we'll accept
+         ))))