From 99a6c6824a2fa050639e363ef00f6d882488dd52 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 4 Jun 2020 16:16:02 +0100 Subject: [PATCH] Enormous progress on routing, but not there yet. All existing unit tests still pass, but new code is not instrumented yet. --- docs/cloverage/index.html | 148 +- docs/cloverage/walkmap/edge.clj.html | 22 +- docs/cloverage/walkmap/microworld.clj.html | 236 ++-- docs/cloverage/walkmap/path.clj.html | 237 ++-- docs/cloverage/walkmap/polygon.clj.html | 370 +++-- docs/cloverage/walkmap/read_svg.clj.html | 9 + docs/cloverage/walkmap/routing.clj.html | 595 +++++++- .../cloverage/walkmap/superstructure.clj.html | 1251 +++++++++-------- docs/cloverage/walkmap/utils.clj.html | 18 + docs/codox/index.html | 2 +- docs/codox/walkmap.microworld.html | 2 +- docs/codox/walkmap.path.html | 6 +- docs/codox/walkmap.polygon.html | 2 +- docs/codox/walkmap.routing.html | 2 +- docs/codox/walkmap.superstructure.html | 11 +- docs/codox/walkmap.utils.html | 4 +- src/walkmap/edge.clj | 10 +- src/walkmap/microworld.clj | 5 +- src/walkmap/path.clj | 5 +- src/walkmap/polygon.clj | 34 +- src/walkmap/read_svg.clj | 3 + src/walkmap/routing.clj | 128 +- src/walkmap/superstructure.clj | 47 +- src/walkmap/utils.clj | 6 + 24 files changed, 2050 insertions(+), 1103 deletions(-) diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index f8390be..90ed216 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -16,18 +16,18 @@ walkmap.edge
703
725
12
-98.32 % +98.37 %
100
102
5
100.00 % -17717105 +17717107 walkmap.id
walkmap.microworld
3
167
-1.76 % + style="width:98.40425531914893%; + float:left;"> 185
+1.60 %
3
37
7.50 % -971140 +75640 walkmap.ocean
walkmap.path
250
249
16
-93.98 % +93.96 %
34
3
1
-97.37 % -94938 + style="width:88.88888888888889%; + float:left;"> 32
4
+100.00 % +93936 walkmap.polygon
338
171
-66.40 % + style="width:50.87976539589443%; + float:left;"> 347
335
+50.88 %
45
6
12
-80.95 % -1251363 + style="width:61.333333333333336%; + float:left;"> 46
7
22
+70.67 % +1551475 walkmap.read-svg
39
15.22 % -97646 +100846 walkmap.routing
1
-100.00 % + style="width:5.678233438485805%; + float:left;"> 18
299
+5.68 %
1
-100.00 % -1821 + style="width:17.56756756756757%; + float:left;"> 13
2
59
+20.27 % +2012174 walkmap.stl
walkmap.superstructure
258
225
-53.42 % + style="width:44.61538461538461%; + float:left;"> 261
324
+44.62 %
62
65
4
43
-60.55 % -22119109 + style="width:48.507462686567166%; + float:left;"> 65 +51.49 % +27222134 walkmap.svg
walkmap.utils
756
23
-97.05 % + style="width:96.31043256997455%; + float:left;"> 757
29
+96.31 %
36
37
1
5
-88.10 % -113942 + style="width:17.391304347826086%; + float:left;"> 8 +82.61 % +1191046 walkmap.vertex
Totals: -69.99 % +62.51 % -65.94 % +59.55 % diff --git a/docs/cloverage/walkmap/edge.clj.html b/docs/cloverage/walkmap/edge.clj.html index 5d60f3e..0d22b25 100644 --- a/docs/cloverage/walkmap/edge.clj.html +++ b/docs/cloverage/walkmap/edge.clj.html @@ -23,7 +23,7 @@ 006              [walkmap.utils :as u]
- 007              [walkmap.vertex :refer [canonicalise ensure2d ensure3d vertex vertex= vertex?]])) + 007              [walkmap.vertex :refer [canonicalise check-vertex ensure2d ensure3d vertex vertex= vertex?]]))
008   @@ -37,17 +37,17 @@ 011    [v1 v2]
- - 012    (if + + 012    {:kind :edge
- - 013      (and (vertex? v1) (vertex? v2)) + + 013     :walkmap.id/id (keyword (gensym "edge"))
- - 014      {:kind :edge :walkmap.id/id (keyword (gensym "edge")) :start v1 :end v2} + + 014     :start (check-vertex v1)
- - 015      (throw (IllegalArgumentException. "Must be vertices.")))) + + 015     :end (check-vertex v2)})
016   @@ -145,7 +145,7 @@ 047        (+ (:z s) (/ (- (:z e) (:z s)) 2)))))
- + 048  
@@ -154,7 +154,7 @@ 050    "Return an vertex parallel to `e` starting from the coordinate origin. Two
- + 051    edges which are parallel will have the same unit vector."
diff --git a/docs/cloverage/walkmap/microworld.clj.html b/docs/cloverage/walkmap/microworld.clj.html index 560d445..e2e0a07 100644 --- a/docs/cloverage/walkmap/microworld.clj.html +++ b/docs/cloverage/walkmap/microworld.clj.html @@ -26,274 +26,208 @@ 007              [clojure.string :as s]
- 008              [mw-cli.core :refer [process]] + 008              [taoensso.timbre :as l]
- 009              [mw-engine.core :refer [run-world]] + 009              [walkmap.edge :as e]
- 010              [mw-engine.heightmap :as h] + 010              [walkmap.polygon :as p :only [rectangle]]
- 011              [mw-engine.drainage :as d] + 011              [walkmap.superstructure :refer [store]]
- 012              [mw-parser.bulk :as parser] + 012              [walkmap.tag :as t :only [tag]]
- 013              [taoensso.timbre :as l] + 013              [walkmap.vertex :as v :only [check-vertex vertex vertex?]]
- 014              [walkmap.edge :as e] -
- - 015              [walkmap.polygon :as p :only [check-polygon polygon? rectangle]] -
- - 016              [walkmap.superstructure :refer [store]] -
- - 017              [walkmap.tag :as t :only [tag tags]] -
- - 018              [walkmap.utils :as u :only [check-kind-type check-kind-type-seq kind-type truncate]] -
- - 019              [walkmap.vertex :as v :only [vertex vertex?]])) + 014              [walkmap.utils :as u :only [truncate]]))
- 020   -
- - 021  ;; (def settlement-rules (parser/compile-file "resources/rules/settlement_rules.txt")) -
- - 022   -
- - 023  ;; (def w0 (h/apply-heightmap "../the-great-game/resources/maps/heightmap.png")) -
- - 024  ;; (def w1 (d/rain-world (d/flood-hollows w0))) -
- - 025  ;; (def w2 (drainage/flow-world-nr w1)) -
- - 026   -
- - 027  ;; (def w3 (run-world w2 nil settlement-rules 100)) -
- - 028   -
- - 029  ;; (with-open [w (clojure.java.io/writer "settlement_1.edn")] -
- - 030  ;;   (binding [*out* w] -
- - 031  ;;     (pr -
- - 032  ;;       (run-world w0 nil settlement-rules 100)))) -
- - 033   -
- - 034  ;; (process -
- - 035  ;;   (h/apply-heightmap "resources/small_hill.png") -
- - 036  ;;   (parser/compile-file "resources/rules/settlement_rules.txt") -
- - 037  ;;   100 -
- - 038  ;;   "small_hill.edn" -
- - 039  ;;   "small_hill.html") -
- - 040   + 015  
- 041  (defn cell->polygon + 016  (defn cell->polygon
- 042    ([cell] + 017    "From this MicroWorld `cell`, construct a walkmap polygon (specifically, +
+ + 018    a rectangle. If `scale-vector` passed and is a vertex, scale all the vertices +
+ + 019    in the cell by that vector." +
+ + 020    ([cell]
- 043     (cell->polygon cell (v/vertex 1 1 1))) + 021     (cell->polygon cell (v/vertex 1 1 1)))
- 044    ([cell scale-vector] + 022    ([cell scale-vector]
- 045     (t/tag + 023     (t/tag
- 046       (assoc + 024       (assoc
- 047         (merge + 025         (merge
- 048           cell + 026           cell
- - 049           (let [w (* (:x cell) (:x scale-vector)) + + 027           (let [w (* (:x cell) (:x (v/check-vertex scale-vector)))
- 050                 s (* (:y cell) (:y scale-vector)) + 028                 s (* (:y cell) (:y scale-vector))
- 051                 e (+ w (:x scale-vector)) + 029                 e (+ w (:x scale-vector))
- 052                 n (+ s (:y scale-vector)) + 030                 n (+ s (:y scale-vector))
- 053                 z (* (:altitude cell) (:z scale-vector))] + 031                 z (* (:altitude cell) (:z scale-vector))]
- 054           (p/rectangle + 032           (p/rectangle
- 055             (v/vertex s w z) + 033             (v/vertex s w z)
- 056             (v/vertex n e z)))) + 034             (v/vertex n e z))))
- 057         :walkmap.id/id + 035         :walkmap.id/id
- 058         (keyword (gensym "mw-cell"))) + 036         (keyword (gensym "mw-cell")))
- 059       (:state cell)))) + 037       (:state cell))))
- 060   + 038  
- 061  (defn load-microworld-edn + 039  (defn load-microworld-edn
- 062    "While it would be possible to call MicroWorld functions directly from + 040    "While it would be possible to call MicroWorld functions directly from
- 063    Walkmap, the fact is that running MicroWorld is so phenomenally + 041    Walkmap, the fact is that running MicroWorld is so phenomenally
- 064    compute-heavy that it's much more sensible to do it in batch mode. So the + 042    compute-heavy that it's much more sensible to do it in batch mode. So the
- 065    better plan is to be able to pull the output from MicroWorld - as an EDN + 043    better plan is to be able to pull the output from MicroWorld - as an EDN
- 066    structure - into a walkmap superstructure." + 044    structure - into a walkmap superstructure."
- 067    ([filename] + 045    ([filename]
- 068     (load-microworld-edn filename :mw)) + 046     (load-microworld-edn filename :mw))
- 069    ([filename map-kind] -
- - 070     (when-not -
- - 071       (keyword? map-kind) -
- - 072       (throw (IllegalArgumentException. -
- - 073                (u/truncate -
- - 074                  (str "Must be a keyword: " (or map-kind "nil")) 80)))) + 047    ([filename map-kind]
- 075     (load-microworld-edn filename map-kind nil)) + 048     (when-not +
+ + 049       (keyword? map-kind) +
+ + 050       (throw (IllegalArgumentException. +
+ + 051                (u/truncate +
+ + 052                  (str "Must be a keyword: " (or map-kind "nil")) 80)))) +
+ + 053     (load-microworld-edn filename map-kind nil))
- 076    ([filename mapkind superstucture] + 054    ([filename mapkind superstucture]
- 077     (load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1))) + 055     (load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1)))
- 078    ([filename map-kind superstructure scale-vertex] + 056    ([filename map-kind superstructure scale-vertex]
- 079     (let [mw (try + 057     (let [mw (try
- 080                (with-open [r (io/reader filename)] + 058                (with-open [r (io/reader filename)]
- 081                  (edn/read (java.io.PushbackReader. r))) + 059                  (edn/read (java.io.PushbackReader. r)))
- 082                (catch RuntimeException e + 060                (catch RuntimeException e
- 083                  (l/error "Error parsing edn file '%s': %s\n" + 061                  (l/error "Error parsing edn file '%s': %s\n"
- 084                           filename (.getMessage e)))) + 062                           filename (.getMessage e))))
- 085           polys (reduce + 063           polys (reduce
- 086                   concat + 064                   concat
- 087                   (map (fn [row] (map cell->polygon row)) mw))] + 065                   (map (fn [row] (map cell->polygon row)) mw))]
- 088       (if (map? superstructure) + 066       (if (map? superstructure)
- 089         (reduce + 067         (reduce
- 090           #(store %2 %1) + 068           #(store %2 %1)
- 091           superstructure + 069           superstructure
- 092           polys) + 070           polys)
- 093         polys)))) + 071         polys))))
- 094   + 072  
- 095   + 073  
- 096   + 074  
- 097   + 075  
diff --git a/docs/cloverage/walkmap/path.clj.html b/docs/cloverage/walkmap/path.clj.html index be05352..c05fb77 100644 --- a/docs/cloverage/walkmap/path.clj.html +++ b/docs/cloverage/walkmap/path.clj.html @@ -32,7 +32,7 @@ 009              [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
- 010              [walkmap.vertex :refer [vertex?]])) + 010              [walkmap.vertex :refer [check-vertices vertex?]]))
011   @@ -88,203 +88,200 @@ 028    [& vertices]
- - 029    (check-kind-type-seq vertices vertex? :vertex) -
- 030    (if + 029    (if
- - 031      (> (count vertices) 1) + + 030      (> (count (check-vertices vertices)) 1)
- 032      {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path} + 031      {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path}
- 033      (throw (IllegalArgumentException. "Path must have more than one vertex.")))) + 032      (throw (IllegalArgumentException. "Path must have more than one vertex."))))
- 034   + 033  
- 035  (defmacro check-path + 034  (defmacro check-path
- 036    "If `o` is not a path, throw an `IllegalArgumentException` with an + 035    "If `o` is not a path, throw an `IllegalArgumentException` with an
- 037    appropriate message; otherwise, returns `o`. Macro, so exception is thrown + 036    appropriate message; otherwise, returns `o`. Macro, so exception is thrown
- 038    from the calling function." + 037    from the calling function."
- 039    [o] + 038    [o]
- 040    `(check-kind-type ~o path? :path)) + 039    `(check-kind-type ~o path? :path))
- 041   + 040  
- 042  (defmacro check-paths + 041  (defmacro check-paths
- 043    "If `o` is not a sequence of paths, throw an `IllegalArgumentException` with an + 042    "If `o` is not a sequence of paths, throw an `IllegalArgumentException` with an
- 044    appropriate message; otherwise, returns `o`. Macro, so exception is thrown + 043    appropriate message; otherwise, returns `o`. Macro, so exception is thrown
- 045    from the calling function." + 044    from the calling function."
- 046    [o] + 045    [o]
- 047    `(check-kind-type-seq ~o path? :path)) -
- - 048   -
- - 049  (defn polygon->path -
- - 050    "If `o` is a polygon, return an equivalent path. What's different about -
- - 051    a path is that in polygons there is an implicit edge between the first -
- - 052    vertex and the last. In paths, there isn't, so we need to add that -
- - 053    edge explicitly. + 046    `(check-kind-type-seq ~o path? :path))
- 054   + 047   +
+ + 048  (defn polygon->path
- 055    If `o` is not a polygon, will throw an exception." + 049    "If `o` is a polygon, return an equivalent path. What's different about
- 056    [o] + 050    a path is that in polygons there is an implicit edge between the first
- 057  ;; this is breaking, but I have NO IDEA why! + 051    vertex and the last. In paths, there isn't, so we need to add that
- 058  ;;  (check-polygon o polygon? :polygon) -
- - 059    (assoc (dissoc o :vertices) -
- - 060      :kind :path -
- - 061      ;; `concat` rather than `conj` because order matters. -
- - 062      :vertices (concat (:vertices o) (list (first (:vertices o)))))) + 052    edge explicitly.
- 063   -
- - 064  (defn path->edges + 053  
- 065    "if `o` is a path, a polygon, or a sequence of vertices, return a sequence of + 054    If `o` is not a polygon, will throw an exception."
- 066    edges representing that path, polygon or sequence. -
- - 067   + 055    [o]
- 068    Throws `IllegalArgumentException` if `o` is not a path, a polygon, or + 056  ;; this is breaking, but I have NO IDEA why!
- 069    sequence of vertices." -
- - 070    [o] -
- - 071    (cond -
- - 072      (seq? o) (when -
- - 073                 (and -
- - 074                   (vertex? (first o)) -
- - 075                   (vertex? (first (rest o)))) -
- - 076                 (cons -
- - 077                   ;; TODO: think about: when constructing an edge from a path, should the -
- - 078                   ;; constructed edge be tagged with the tags of the path? + 057  ;;  (check-polygon o polygon? :polygon)
- 079                   (e/edge (first o) (first (rest o))) -
- - 080                   (path->edges (rest o)))) -
- - 081      (path? o) (path->edges (:vertices o)) -
- - 082      (polygon? o) (path->edges (polygon->path o)) + 058    (assoc (dissoc o :vertices)
- 083      :else -
- - 084      (throw (IllegalArgumentException. + 059      :kind :path
- 085               "Not a path or sequence of vertices!")))) + 060      ;; `concat` rather than `conj` because order matters. +
+ + 061      :vertices (concat (:vertices o) (list (first (:vertices o))))))
- 086   + 062  
- 087  (defn length + 063  (defn path->edges
- 088    "Return the length of this path, in metres. **Note that** + 064    "if `o` is a path, a polygon, or a sequence of vertices, return a sequence of
- 089    1. This is not the same as the distance from the start to the end of the + 065    edges representing that path, polygon or sequence. +
+ + 066  
- 090    path, which, except for absolutely straight paths, will be shorter; + 067    Throws `IllegalArgumentException` if `o` is not a path, a polygon, or
- 091    2. It is not even quite the same as the length of the path *as rendered*, + 068    sequence of vertices."
- 092    since paths will generally be rendered as spline curves." + 069    [o] +
+ + 070    (cond +
+ + 071      (seq? o) (when +
+ + 072                 (and +
+ + 073                   (vertex? (first o)) +
+ + 074                   (vertex? (first (rest o)))) +
+ + 075                 (cons
- 093    [path] + 076                   ;; TODO: think about: when constructing an edge from a path, should the +
+ + 077                   ;; constructed edge be tagged with the tags of the path? +
+ + 078                   (e/edge (first o) (first (rest o))) +
+ + 079                   (path->edges (rest o)))) +
+ + 080      (path? o) (path->edges (:vertices o)) +
+ + 081      (polygon? o) (path->edges (polygon->path o)) +
+ + 082      :else +
+ + 083      (throw (IllegalArgumentException. +
+ + 084               "Not a path or sequence of vertices!")))) +
+ + 085   +
+ + 086  (defn length +
+ + 087    "Return the length of this path, in metres. **Note that** +
+ + 088    1. This is not the same as the distance from the start to the end of the +
+ + 089    path, which, except for absolutely straight paths, will be shorter; +
+ + 090    2. It is not even quite the same as the length of the path *as rendered*, +
+ + 091    since paths will generally be rendered as spline curves." +
+ + 092    [path]
- 094    (reduce + (map e/length (path->edges (check-path path))))) + 093    (reduce + (map e/length (path->edges (check-path path)))))
diff --git a/docs/cloverage/walkmap/polygon.clj.html b/docs/cloverage/walkmap/polygon.clj.html index afa6805..f308c6c 100644 --- a/docs/cloverage/walkmap/polygon.clj.html +++ b/docs/cloverage/walkmap/polygon.clj.html @@ -20,364 +20,454 @@ 005              [walkmap.tag :as t]
- 006              [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]] + 006              [walkmap.utils :refer [check-kind-type
- 007              [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]])) + 007                                     check-kind-type-seq +
+ + 008                                     kind-type +
+ + 009                                     not-yet-implemented]] +
+ + 010              [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]]))
- 008   + 011  
- 009  (defn polygon? + 012  (defn polygon?
- 010    "True if `o` satisfies the conditions for a polygon. A polygon shall be a + 013    "True if `o` satisfies the conditions for a polygon. A polygon shall be a
- 011    map which has a value for the key `:vertices`, where that value is a sequence + 014    map which has a value for the key `:vertices`, where that value is a sequence
- 012    of vertices." + 015    of vertices."
- 013    [o] + 016    [o]
- 014    (let + 017    (let
- 015      [v (:vertices o)] + 018      [v (:vertices o)]
- 016      (and + 019      (and
- 017        (coll? v) + 020        (coll? v)
- 018        (> (count v) 2) + 021        (> (count v) 2)
- 019        (every? vertex? v) + 022        (every? vertex? v)
- 020        (:walkmap.id/id o) + 023        (:walkmap.id/id o)
- 021        (or (nil? (:kind o)) (= (:kind o) :polygon))))) + 024        (or (nil? (:kind o)) (= (:kind o) :polygon)))))
- 022   + 025  
- 023  (defmacro check-polygon + 026  (defmacro check-polygon
- 024    "If `o` is not a polygon, throw an `IllegalArgumentException` with an + 027    "If `o` is not a polygon, throw an `IllegalArgumentException` with an
- 025    appropriate message; otherwise, returns `o`. Macro, so exception is thrown + 028    appropriate message; otherwise, returns `o`. Macro, so exception is thrown
- 026    from the calling function." + 029    from the calling function."
- 027    [o] + 030    [o]
- 028    `(check-kind-type ~o polygon? :polygon)) + 031    `(check-kind-type ~o polygon? :polygon))
- 029   + 032  
- 030  (defmacro check-polygons + 033  (defmacro check-polygons
- 031    "If `o` is not a sequence of polygons, throw an `IllegalArgumentException` with an + 034    "If `o` is not a sequence of polygons, throw an `IllegalArgumentException` with an
- 032    appropriate message; otherwise, returns `o`. Macro, so exception is thrown + 035    appropriate message; otherwise, returns `o`. Macro, so exception is thrown
- 033    from the calling function." + 036    from the calling function."
- 034    [o] + 037    [o]
- 035    `(check-kind-type-seq ~o polygon? :polygon)) + 038    `(check-kind-type-seq ~o polygon? :polygon))
- 036   + 039  
- 037  (defn triangle? + 040  (defn triangle?
- 038    "True if `o` satisfies the conditions for a triangle. A triangle shall be a + 041    "True if `o` satisfies the conditions for a triangle. A triangle shall be a
- 039    polygon with exactly three vertices." + 042    polygon with exactly three vertices."
- 040    [o] + 043    [o]
- 041    (and + 044    (and
- 042      (coll? o) + 045      (coll? o)
- 043      (= (count (:vertices o)) 3))) + 046      (= (count (:vertices o)) 3)))
- 044   + 047  
- - 045  (defmacro check-triangle + + 048  (defmacro check-triangle
- 046    "If `o` is not a triangle, throw an `IllegalArgumentException` with an + 049    "If `o` is not a triangle, throw an `IllegalArgumentException` with an
- 047    appropriate message; otherwise, returns `o`. Macro, so exception is thrown + 050    appropriate message; otherwise, returns `o`. Macro, so exception is thrown
- - 048    from the calling function." + + 051    from the calling function."
- 049    [o] + 052    [o]
- 050    `(check-kind-type ~o triangle? :triangle)) + 053    `(check-kind-type ~o triangle? :triangle))
- - 051   + + 054  
- 052  (defn polygon + 055  (defn polygon
- 053    "Return a polygon constructed from these `vertices`." + 056    "Return a polygon constructed from these `vertices`."
- 054    [& vertices] + 057    [& vertices]
- - 055    (if + + 058    (if
- 056      (> (count vertices) 2) + 059      (> (count vertices) 2)
- 057      {:vertices (check-vertices vertices) + 060      {:vertices (check-vertices vertices)
- - 058       :walkmap.id/id (keyword (gensym "poly")) + + 061       :walkmap.id/id (keyword (gensym "poly"))
- 059       :kind :polygon} + 062       :kind :polygon}
- 060      (throw (IllegalArgumentException. + 063      (throw (IllegalArgumentException.
- 061               "A polygon must have at least 3 vertices.")))) + 064               "A polygon must have at least 3 vertices."))))
- 062   + 065  
- 063  (defn rectangle + 066  (defn rectangle
- 064    "Return a rectangle, with edges aligned east-west and north-south, whose + 067    "Return a rectangle, with edges aligned east-west and north-south, whose
- 065    south-west corner is the vertex `vsw` and whose north-east corner is the + 068    south-west corner is the vertex `vsw` and whose north-east corner is the
- 066    vertex `vne`." + 069    vertex `vne`."
- 067    [vsw vne] + 070    [vsw vne]
- 068    ;; we can actually create any rectangle in the xy plane based on two opposite + 071    ;; we can actually create any rectangle in the xy plane based on two opposite
- - 069    ;; corners, but the maths are a bit to advanced for me today. TODO: do it! + + 072    ;; corners, but the maths are a bit to advanced for me today. TODO: do it!
- 070    (let [vnw (vertex (:x (check-vertex vsw)) + 073    (let [vnw (vertex (:x (check-vertex vsw))
- 071                      (:y (check-vertex vne)) -
- - 072                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) -
- - 073          vse (vertex (:x vne) -
- - 074                      (:y vsw) + 074                      (:y (check-vertex vne))
- 075                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))] + 075                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) +
+ + 076          vse (vertex (:x vne)
- 076      (t/tag + 077                      (:y vsw)
- - 077        (assoc + + 078                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))
- 078          (polygon vsw vnw vne vse) -
- - 079          :centre -
- - 080          (vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2)) -
- - 081                  (+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2)) + 079          height-order (sort-by :z [vsw vne])]
- 082                  (:z vse))) + 080      (t/tag +
+ + 081        (assoc +
+ + 082          (polygon vsw vnw vne vse)
- 083        :rectangle))) + 083          :gradient
- - 084   + + 084          (e/unit-vector (e/edge (first height-order) (last height-order)))
- 085  ;; (rectangle (vertex 1 2 3) (vertex 7 9 4)) + 085          :centre +
+ + 086          (vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2)) +
+ + 087                  (+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2)) +
+ + 088                  (:z vse))) +
+ + 089        :rectangle)))
- 086   + 090   +
+ + 091  ;; (rectangle (vertex 1 2 3) (vertex 7 9 4)) +
+ + 092  
- 087  (defn gradient + 093  (defn gradient
- 088    "Return a polygon like `triangle` but with a key `:gradient` whose value is a + 094    "Return a polygon like `triangle` but with a key `:gradient` whose value is a
- 089    unit vector representing the gradient across `triangle`." + 095    unit vector representing the gradient across `triangle`."
- 090    [triangle] + 096    [triangle]
- 091    (let [order (sort #(max (:z %1) (:z %2)) + 097    (let [order (sort #(max (:z %1) (:z %2))
- 092                      (:vertices (check-triangle triangle))) + 098                      (:vertices (check-triangle triangle)))
- 093          highest (first order) + 099          highest (first order)
- 094          lowest (last order)] + 100          lowest (last order)]
- 095       (assoc triangle :gradient (e/unit-vector (e/edge lowest highest))))) + 101       (assoc triangle :gradient (e/unit-vector (e/edge lowest highest)))))
- 096   + 102  
- 097  (defn triangle-centre + 103  (defn triangle-centre
- 098    "Return a canonicalised `facet` (i.e. a triangular polygon) with an added + 104    "Return a canonicalised `facet` (i.e. a triangular polygon) with an added
- 099    key `:centre` whose value represents the centre of this facet in 3 + 105    key `:centre` whose value represents the centre of this facet in 3
- 100    dimensions. This only works for triangles, so is here not in + 106    dimensions. This only works for triangles, so is here not in
- 101    `walkmap.polygon`. It is an error (although no exception is currently + 107    `walkmap.polygon`. It is an error (although no exception is currently
- 102    thrown) if the object past is not a triangular polygon." + 108    thrown) if the object past is not a triangular polygon."
- 103    [facet] + 109    [facet]
- 104    (let [vs (:vertices (check-triangle facet)) + 110    (let [vs (:vertices (check-triangle facet))
- 105          v1 (first vs) + 111          v1 (first vs)
- 106          opposite (e/edge (nth vs 1) (nth vs 2)) + 112          opposite (e/edge (nth vs 1) (nth vs 2))
- 107          oc (e/centre opposite)] + 113          oc (e/centre opposite)]
- 108        (assoc + 114        (assoc
- 109        facet + 115        facet
- 110        :centre + 116        :centre
- 111        (vertex + 117        (vertex
- 112          (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3)) + 118          (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
- 113          (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3)) + 119          (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
- 114          (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3)))))) + 120          (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
- 115   + 121  
- 116  (defn centre + 122  (defn centre
- 117    [poly] + 123    [poly]
- 118    (case (count (:vertices (check-polygon poly))) + 124    (case (count (:vertices (check-polygon poly)))
- 119      3 (triangle-centre poly) + 125      3 (triangle-centre poly)
- 120      ;; else + 126      ;; else
- 121      (throw + 127      (throw
- 122        (UnsupportedOperationException. + 128        (UnsupportedOperationException.
- 123          "The general case of centre for polygons is not yet implemented.")))) + 129          "The general case of centre for polygons is not yet implemented."))))
- 124   + 130   +
+ + 131  (defmacro on2dtriangle? +
+ + 132    "Is the projection of this `vertex` on the x, y plane within the +
+ + 133    projection of this triangle on that plane?" +
+ + 134    [vertex poly] +
+ + 135    `(not-yet-implemented "on2d? for triangles."))
- 125   + 136   +
+ + 137  (defn on2drectangle? +
+ + 138    "Is the projection of this `vertex` on the x, y plane within the +
+ + 139    projection of this rectangle on that plane?" +
+ + 140    [vertex rectangle] +
+ + 141    (let [xo (sort-by :x (:vertices rectangle)) +
+ + 142          yo (sort-by :x (:vertices rectangle))] +
+ + 143      (and +
+ + 144        (< (:x (first xo)) (:x vertex) (:x (last xo))) +
+ + 145        (< (:y (first yo)) (:y vertex) (:y (last yo)))))) +
+ + 146   +
+ + 147  (defmacro on2d? +
+ + 148    "Is the projection of this `vertex` on the x, y plane within the +
+ + 149    projection of this polygon `poly` on that plane?" +
+ + 150    [vertex poly] +
+ + 151    `(cond +
+ + 152      (rectangle? ~poly) (on2drectangle? ~vertex ~poly) +
+ + 153      (triangle? ~poly) (on2dtriangle? ~vertex ~poly) +
+ + 154      :else +
+ + 155      (not-yet-implemented "general case of on2d? for polygons.")))
diff --git a/docs/cloverage/walkmap/read_svg.clj.html b/docs/cloverage/walkmap/read_svg.clj.html index 0fd16df..4912ba9 100644 --- a/docs/cloverage/walkmap/read_svg.clj.html +++ b/docs/cloverage/walkmap/read_svg.clj.html @@ -295,5 +295,14 @@ 097        (remove nil? (map path-elt->path paths)))))
+ + 098   +
+ + 099  ;; (read-svg "resources/iom/manual_roads.svg") +
+ + 100   +
diff --git a/docs/cloverage/walkmap/routing.clj.html b/docs/cloverage/walkmap/routing.clj.html index ea31cf3..14f265d 100644 --- a/docs/cloverage/walkmap/routing.clj.html +++ b/docs/cloverage/walkmap/routing.clj.html @@ -11,52 +11,601 @@ 002    "Finding optimal routes to traverse a map."
- 003      (:require [walkmap.path :as p] + 003    (:require [clojure.math.numeric-tower :as m :only [expt]]
- 004              [walkmap.polygon :as q] + 004              [clojure.set :refer [intersection]]
- 005              [walkmap.stl :as s] + 005              [walkmap.edge :as e]
- 006              [walkmap.utils :as u] + 006              [walkmap.path :as p]
- 007              [walkmap.vertex :as v])) + 007              [walkmap.polygon :as q] +
+ + 008              [walkmap.superstructure :as s] +
+ + 009              [walkmap.tag :as t] +
+ + 010              [walkmap.utils :as u] +
+ + 011              [walkmap.vertex :as v]))
- 008   + 012  
- 009  ;; Breadth first search is a good algorithm for terrain in which all steps have + 013  ;; Breadth first search is a good algorithm for terrain in which all steps have
- 010  ;; equal, but in our world (like the real world), they don't. + 014  ;; equal, but in our world (like the real world), they don't.
- 011   + 015  
- 012  ;; Reading list: -
- - 013  ;; -
- - 014  ;; https://en.wikipedia.org/wiki/A*_search_algorithm -
- - 015  ;; https://www.redblobgames.com/pathfinding/a-star/introduction.html -
- - 016  ;; https://faculty.nps.edu/ncrowe/opmpaper2.htm + 016  ;; Reading list:
017  ;;
- 018  ;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html + 018  ;; https://en.wikipedia.org/wiki/A*_search_algorithm +
+ + 019  ;; https://www.redblobgames.com/pathfinding/a-star/introduction.html +
+ + 020  ;; https://faculty.nps.edu/ncrowe/opmpaper2.htm +
+ + 021  ;; +
+ + 022  ;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html +
+ + 023   +
+ + 024  (def ^:dynamic *gradient-exponent* +
+ + 025    "The exponent to be applied to `(inc (:z (unit-vector from to)))` +
+ + 026    of a path segment to calculate the gradient-related part of the +
+ + 027    cost of traversal. Dynamic, because we will want to tune this." +
+ + 028    2) +
+ + 029   +
+ + 030  (def ^:dynamic *traversals-exponent* +
+ + 031    "The (expected to be negative) exponent to be applied to the number +
+ + 032    of traversals of a path to compute the road bonus. Paths more travelled by +
+ + 033    should have larger bonuses, but not dramatically so - so the increase in +
+ + 034    bonus needs to scale significantly less than linearly with the number +
+ + 035    of traversals. Dynamic, because we will want to tune this." +
+ + 036    -2) +
+ + 037   +
+ + 038  (defn traversable? +
+ + 039    "True if this object can be considered as part of the walkmap." +
+ + 040    [object] +
+ + 041    (and +
+ + 042      (or +
+ + 043        (and +
+ + 044          (q/polygon? object) +
+ + 045          (:centre object)) +
+ + 046        (p/path? object)) +
+ + 047      (not (t/tagged? object :no-traversal)))) +
+ + 048   +
+ + 049  (declare traversal-cost) +
+ + 050   +
+ + 051  (defn vertices-traversal-cost +
+ + 052    [vertices s] +
+ + 053    (reduce +
+ + 054      + +
+ + 055      (map +
+ + 056        #(traversal-cost %1 %2 s) +
+ + 057        (v/check-vertices vertices) +
+ + 058        (rest vertices)))) +
+ + 059   +
+ + 060  (defn path-traversal-cost +
+ + 061    [path s] +
+ + 062    (vertices-traversal-cost (:vertices (p/check-path path)) s)) +
+ + 063   +
+ + 064  (defn barriers-crossed +
+ + 065    "Search superstructure `s` and return a sequence of barriers, if any, which +
+ + 066    obstruct traversal from vertex `from` to vertex `to`." +
+ + 067    [from to s] +
+ + 068    ;; TODO: implement +
+ + 069    '()) +
+ + 070   +
+ + 071  (defn crossing-penalty +
+ + 072    "TODO: should return the cost of crossing this `barrier`, initially mainly +
+ + 073    a watercourse, on the axis from vertex `from` to vertex `to`. in the context +
+ + 074    of superstructure `s`. If there's a bridge, ferry or other crossing mechanism +
+ + 075    in `s` at the intersection of the vertex and the barrier, then the penalty +
+ + 076    should be substantially less than it would otherwise be." +
+ + 077    [barrier from to s] +
+ + 078    ;; TODO: implement +
+ + 079    0) +
+ + 080   +
+ + 081  (defn gradient-cost +
+ + 082    "Compute the per-unit-distance cost of traversing this `edge`." +
+ + 083    [edge] +
+ + 084    (let [g (:z (e/unit-vector edge))] +
+ + 085      (if (pos? g) +
+ + 086        (m/expt (inc g) *gradient-exponent*) +
+ + 087        1))) +
+ + 088   +
+ + 089  ;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0))) +
+ + 090  ;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 0))) +
+ + 091  ;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 1))) +
+ + 092  ;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 1))) +
+ + 093  ;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0.0001))) +
+ + 094   +
+ + 095  (defn best-road +
+ + 096    "Find the best traversable path which links the vertices `from` and `to` +
+ + 097    in this superstructure `s`, or nil if there are none." +
+ + 098    [from to s] +
+ + 099    (let [f (fn [v] (set (s/touching v p/path? s)))] +
+ + 100      (first +
+ + 101        (sort-by +
+ + 102          ;;; I... chose the path more travelled by. +
+ + 103          #(or (:traversals %) 0) +
+ + 104          (filter traversable? (intersection (f from) (f to))))))) +
+ + 105   +
+ + 106  (defn road-bonus +
+ + 107    "Calculate the road bonus of the edge represented by the vertices `from`, +
+ + 108    `to`, in the context of the superstructure `s`. Obviously there only is +
+ + 109    such a bonus if there actually is an existing thoroughfare to use. Road +
+ + 110    bonuses scale with some fractional exponent of the number of traversals +
+ + 111    which have been made of the road segment in question." +
+ + 112    [from to s] +
+ + 113    (let [best (best-road from to s)] +
+ + 114      (when (:traversals best) +
+ + 115        (m/expt (:traversals best) *traversals-exponent*)))) +
+ + 116   +
+ + 117  (defn traversal-cost +
+ + 118    "Return the traversal cost of the edge represented by the vertices `from`, +
+ + 119    `to`, in the context of the superstructure `s`. It is legitimate to pass +
+ + 120    `nil` as the `to` argument, in which case the result will be zero, in order +
+ + 121    to allow `reduce` to be used to compute total path costs." +
+ + 122    [from to s] +
+ + 123    (if (nil? to) +
+ + 124      0 +
+ + 125      (let [edge (e/edge from to) +
+ + 126            distance (e/length edge)] +
+ + 127        (/ +
+ + 128          (+ +
+ + 129            (* distance +
+ + 130               (gradient-cost edge)) +
+ + 131            (reduce + +
+ + 132                    (map +
+ + 133                      #(crossing-penalty [% from to s]) +
+ + 134                      (barriers-crossed from to s)))) +
+ + 135          (or (road-bonus from to s) 1))))) +
+ + 136   +
+ + 137  ;; (def p '({:x 1.40625, :y 0, :kind :vertex, :walkmap.id/id :vert_1-40625_0} +
+ + 138  ;;        {:x 1.40625, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_1-40625_-10-703125} +
+ + 139  ;;        {:x 7.578125, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_7-578125_-10-703125} +
+ + 140  ;;        {:x 7.578125, :y 0, :kind :vertex, :walkmap.id/id :vert_7-578125_0} +
+ + 141  ;;        {:x 2.171875, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_2-171875_-0-765625} +
+ + 142  ;;        {:x 6.8125, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_6-8125_-0-765625})) +
+ + 143  ;; (v/check-vertices p) +
+ + 144  ;; (def p' (p/path p)) +
+ + 145   +
+ + 146  ;; (traversal-cost (first p) (nth p 1) {}) +
+ + 147  ;; (vertices-traversal-cost p {}) +
+ + 148  ;; (path-traversal-cost (p/path p)) +
+ + 149   +
+ + 150  (defn extend-frontier +
+ + 151    "Return a sequence like `frontier` with all of these `candidates` which are +
+ + 152    not already members either of `frontier` or of `rejects` appended." +
+ + 153    ([frontier candidates] +
+ + 154     (extend-frontier frontier candidates nil)) +
+ + 155    ([frontier candidates rejects] +
+ + 156    (if +
+ + 157      (empty? frontier) +
+ + 158      candidates +
+ + 159      (let [fs (set (concat frontier rejects))] +
+ + 160        (concat frontier (remove fs candidates)))))) +
+ + 161   +
+ + 162  ;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8) '(6 8)) +
+ + 163  ;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8)) +
+ + 164  ;; (extend-frontier '(1 2 3 4 5) '()) +
+ + 165  ;; (extend-frontier '(1 2 3 4 5) nil) +
+ + 166  ;; (extend-frontier nil '(1 2 3 4 5)) +
+ + 167   +
+ + 168  (defn route +
+ + 169    ;; NOT YET GOOD ENOUGH! Simple breadth first, and although it will +
+ + 170    ;; reach the goal +
+ + 171    ([from to s search-radius] +
+ + 172     (loop [f from +
+ + 173            t to +
+ + 174            frontier (extend-frontier +
+ + 175                       nil +
+ + 176                       (s/neighbour-ids +
+ + 177                         (s/nearest s from :centre search-radius) +
+ + 178                         traversable? +
+ + 179                         s)) +
+ + 180            visited nil +
+ + 181            track nil] +
+ + 182       (let [here (s/retrieve (first frontier) s)] +
+ + 183         (cond +
+ + 184           (< (e/length (e/edge (:centre here)) to) search-radius) +
+ + 185           ;; close enough +
+ + 186           (apply p/path (cons (:centre here) track)) +
+ + 187           (empty? (rest frontier)) +
+ + 188           ;; failed +
+ + 189           nil +
+ + 190           :else +
+ + 191           (recur +
+ + 192             f +
+ + 193             t +
+ + 194             (extend-frontier +
+ + 195               (rest frontier) +
+ + 196               (s/neighbour-ids here traversable? s) +
+ + 197               visited) +
+ + 198             (cons here visited) +
+ + 199             ;; this is going to be wrong, and I need to think about how to fix. +
+ + 200             (cons here track))))))) +
+ + 201  
diff --git a/docs/cloverage/walkmap/superstructure.clj.html b/docs/cloverage/walkmap/superstructure.clj.html index 25e2662..f804c56 100644 --- a/docs/cloverage/walkmap/superstructure.clj.html +++ b/docs/cloverage/walkmap/superstructure.clj.html @@ -97,575 +97,728 @@ 031    [o]
- - 032    (cond -
- - 033      (v/vertex? o) (list o) -
- - 034      (q/polygon? o) (:vertices o) -
- - 035      (p/path? o) (:vertices o))) -
- - 036   -
- - 037  (defn index-vertex -
- - 038    "Return a superstructure like `s` in which object `o` is indexed by vertex -
- - 039    `v`. It is an error (and an exception may be thrown) if -
- - 040   -
- - 041    1. `s` is not a map; -
- - 042    2. `o` is not a map; -
- - 043    3. `o` does not have a value for the key `:walkmap.id/id`; -
- - 044    4. `v` is not a vertex." -
- - 045    [s o v] -
- - 046    (if-not (v/vertex? o) -
- - 047      (if (:walkmap.id/id o) -
- - 048        (if (v/vertex? v) -
- - 049          (let [vi (or (::vertex-index s) {}) -
- - 050                current (or (vi (:walkmap.id/id v)) {})] -
- - 051            ;; deep-merge doesn't merge sets, only maps; so at this -
- - 052            ;; stage we need to build a map. -
- - 053            (assoc vi (:walkmap.id/id v) (assoc current (:walkmap.id/id o) (:walkmap.id/id v)))) -
- - 054          (throw (IllegalArgumentException. "Not a vertex: " v))) -
- - 055        (throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80)))) -
- - 056      ;; it shouldn't actually be an error to try to index a vertex, but it -
- - 057      ;; also isn't useful to do so, so I'd be inclined to ignore it. -
- - 058      (::vertex-index s))) -
- - 059   -
- - 060  (defn index-vertices -
- - 061    "Return a superstructure like `s` in which object `o` is indexed by its -
- - 062    vertices. It is an error (and an exception may be thrown) if -
- - 063   -
- - 064    1. `s` is not a map; -
- - 065    2. `o` is not a map; -
- - 066    3. `o` does not have a value for the key `:walkmap.id/id`." -
- - 067    [s o] -
- - 068    (u/deep-merge -
- - 069      s -
- - 070      {::vertex-index -
- - 071       (reduce -
- - 072         u/deep-merge -
- - 073         {} -
- - 074         (map -
- - 075           #(index-vertex s o %) -
- - 076           (:vertices o)))})) -
- - 077   -
- - 078  (defn in-retrieve -
- - 079    "Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a -
- - 080    walkmap superstructure. TODO: recursive, quite likely to blow the fragile -
- - 081    Clojure stack. Probably better to do this with `walk`, but I don't yet -
- - 082    understand that." -
- - 083    [x s] -
- - 084    (cond -
- - 085      ;; if it's a keyword identifying something in s, retrieve that something. -
- - 086      (keyword? x) (if (s x) -
- - 087                     (in-retrieve (s x) s) -
- - 088                     x) -
- - 089      ;; if it's a map, for every key which is not `:walkmap.id/id`, recurse. -
- - 090      (map? x) (let [v (reduce -
- - 091                         (fn [m k] -
- - 092                           (assoc m k (in-retrieve (x k) s))) -
- - 093                         {} -
- - 094                         (keys (dissoc x :walkmap.id/id))) -
- - 095                     id (:walkmap.id/id x)] -
- - 096                 ;; if it has an id, bind it to that id in the returned value. -
- - 097                 (if id -
- - 098                   (assoc -
- - 099                     v -
- - 100                     :walkmap.id/id -
- - 101                     (:walkmap.id/id x)) -
- - 102                   v)) -
- - 103      (set? x) x ;; TODO: should I search in sets for objects when storing? -
- - 104      (coll? x) (map #(in-retrieve % s) x) -
- - 105      :else x)) -
- - 106   -
- - 107  (defn retrieve -
- - 108    "Retrieve the canonical representation of the object with this `id` from the -
- - 109    superstructure `s`." -
- - 110    [id s] -
- - 111    (in-retrieve (id s) s)) -
- - 112   -
- - 113  (defn in-store-find-objects -
- - 114    "Return an id -> object map of every object within `o`. Internal to -
- - 115    `in-store`, q.v. Use at your own peril." -
- - 116    ([o] -
- - 117     (in-store-find-objects o {})) -
- - 118    ([o s] -
- - 119     (l/debug "Finding objects in:" o) -
- - 120     (cond -
- - 121       (set? o) s ;; TODO: should I search in sets for objects when storing? -
- - 122       (map? o) (if (:walkmap.id/id o) -
- - 123                  (assoc -
- - 124                    (in-store-find-objects (vals o) s) -
- - 125                    (:walkmap.id/id o) -
- - 126                    o) -
- - 127                  (in-store-find-objects (vals o) s)) -
- - 128       (coll? o) (reduce merge s (map #(in-store-find-objects % s) o)) -
- - 129       :else s))) -
- - 130   -
- - 131  (defn in-store-replace-with-keys -
- - 132    "Return a copy of `o` in which each reified walkmap object within `o` has -
- - 133    been replaced with the `:walkmap.id/id` of that object. Internal to -
- - 134    `in-store`, q.v. Use at your own peril." -
- - 135    [o] -
- - 136    (assoc -
- - 137      (postwalk #(or (:walkmap.id/id %) %) (dissoc o :walkmap.id/id)) -
- - 138      :walkmap.id/id -
- - 139      (:walkmap.id/id o))) -
- - 140   -
- - 141  ;; (in-store-replace-with-keys (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3))) -
- - 142  ;; (in-store-find-objects (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3))) -
- - 143   -
- - 144  (defn store -
- - 145    "Return a superstructure like `s` with object `o` added. If only one -
- - 146    argument is supplied it will be assumed to represent `o` and a new -
- - 147    superstructure will be returned. -
- - 148   -
- - 149    It is an error (and an exception may be thrown) if -
- - 150   -
- - 151    1. `s` is not a map; -
- - 152    2. `o` is not a recognisable walkmap object" -
- - 153    ([o] -
- - 154     (store o {})) -
- - 155    ([o s] -
- - 156     (when-not (:walkmap.id/id o) -
- - 157       (throw -
- - 158         (IllegalArgumentException. -
- - 159           (str "Not a walkmap object: no value for `:walkmap.id/id`: " -
- - 160                (u/kind-type o))))) -
- - 161     (when-not (map? s) -
- - 162       (throw -
- - 163         (IllegalArgumentException. -
- - 164           (str "Superstructure must be a map: " (u/kind-type s))))) -
- - 165     (assoc -
- - 166       (u/deep-merge s (in-store-find-objects o) (index-vertices s o)) -
- - 167       (:walkmap.id/id o) -
- - 168       (in-store-replace-with-keys o)))) -
- - 169   -
- - 170  (defn search-vertices -
- - 171    "Search superstructure `s` for vertices within the box defined by vertices -
- - 172    `minv` and `maxv`. Every coordinate in `minv` must have a lower value than -
- - 173    the equivalent coordinate in `maxv`. If `d2?` is supplied and not false, -
- - 174    search only in the x,y projection." -
- - 175    ([s minv maxv] -
- - 176     (search-vertices s minv maxv false)) -
- - 177    ([s minv maxv d2?] -
- - 178     (let [minv' (if d2? (assoc minv :z Double/NEGATIVE_INFINITY) minv) -
- - 179           maxv' (if d2? (assoc maxv :z Double/POSITIVE_INFINITY) maxv)] -
- - 180       (filter -
- 181         #(v/within-box? % minv maxv) -
- - 182         (filter #(= (:kind %) :vertex) (vals s)))))) -
- - 183   -
- - 184  (defn find-nearest -
- - 185    "Search superstructure `s` for the nearest object matching `filter-fn` to -
- - 186    the `target` vertex. Searches only with `radius` (slight misnomer, area -
- - 187    actually searched is a cube). Returns one object, or `nil` if no matching -
- - 188    object found. -
- - 189   -
- - 190    WARNING: currently only returns objects which have a defined `:centre` -
- - 191    (but most of the significant objects we have do)." -
- - 192    [s target filter-fn radius] -
- - 193    (let [minv (v/vertex -
- - 194                 (- (:x (v/check-vertex target)) radius) -
- - 195                 (- (:y target) radius) (- (or (:z target) 0) radius)) + 032    (when (map? o)
- 196          maxv (v/vertex + 033      (reduce
- - 197                 (+ (:x target) 0.5) (+ (:y target) 0.5) + + 034        concat +
+ + 035        (remove +
+ + 036          nil? +
+ + 037          (map +
+ + 038            #(cond +
+ + 039               (v/vertex? %) (list %)
- 198                 (+ (or (:z target) 0) 0.5))] -
- - 199      ;; filter those objects with the filter function, then sort that list -
- - 200      ;; by the edge distance from the target to the `:centre` of the object -
- - 201      ;; and take the first -
- - 202      (first + 040               (and (coll? %) (every? v/vertex? %)) %)
- 203        (sort-by -
- - 204          #(length (edge target (:centre %))) -
- - 205          (filter + 041            (vals o))))))
- 206            :centre -
- - 207            (map #(retrieve % s) + 042  ;;   (cond
- 208                 ;; for each vertex id in vids, get the objects associated with that id + 043  ;;     (v/vertex? o) (list o)
- 209                 ;; in the vertex index as a single flat list -
- - 210                 (reduce -
- - 211                   concat -
- - 212                   (remove -
- - 213                     nil? -
- - 214                     (map -
- - 215                       #(-> s ::vertex-index % keys) + 044  ;;     (q/polygon? o) (:vertices o)
- 216                       ;; get all the vertex ids within radius of the target -
- - 217                       (set -
- - 218                         (map + 045  ;;     (p/path? o) (:vertices o))
- 219                           :walkmap.id/id -
- - 220                           (search-vertices s minv maxv)))))))))))) + 046  ;;   )
- 221   + 047   +
+ + 048  (defn index-vertex +
+ + 049    "Return a superstructure like `s` in which object `o` is indexed by vertex +
+ + 050    `v`. It is an error (and an exception may be thrown) if +
+ + 051   +
+ + 052    1. `s` is not a map; +
+ + 053    2. `o` is not a map; +
+ + 054    3. `o` does not have a value for the key `:walkmap.id/id`; +
+ + 055    4. `v` is not a vertex." +
+ + 056    [s o v] +
+ + 057    (if-not (v/vertex? o) +
+ + 058      (if (:walkmap.id/id o) +
+ + 059        (if (v/vertex? v) +
+ + 060          (let [vi (or (::vertex-index s) {}) +
+ + 061                current (or (vi (:walkmap.id/id v)) {})] +
+ + 062            ;; deep-merge doesn't merge sets, only maps; so at this +
+ + 063            ;; stage we need to build a map. +
+ + 064            (assoc vi (:walkmap.id/id v) (assoc current (:walkmap.id/id o) (:walkmap.id/id v)))) +
+ + 065          (throw (IllegalArgumentException. "Not a vertex: " v))) +
+ + 066        (throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80)))) +
+ + 067      ;; it shouldn't actually be an error to try to index a vertex, but it +
+ + 068      ;; also isn't useful to do so, so I'd be inclined to ignore it. +
+ + 069      (::vertex-index s))) +
+ + 070   +
+ + 071  (defn index-vertices +
+ + 072    "Return a superstructure like `s` in which object `o` is indexed by its +
+ + 073    vertices. It is an error (and an exception may be thrown) if +
+ + 074   +
+ + 075    1. `s` is not a map; +
+ + 076    2. `o` is not a map; +
+ + 077    3. `o` does not have a value for the key `:walkmap.id/id`." +
+ + 078    [s o] +
+ + 079    (u/deep-merge +
+ + 080      s +
+ + 081      {::vertex-index +
+ + 082       (reduce +
+ + 083         u/deep-merge +
+ + 084         {} +
+ + 085         (map +
+ + 086           #(index-vertex s o %) +
+ + 087           (:vertices o)))})) +
+ + 088   +
+ + 089  (defn in-retrieve +
+ + 090    "Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a +
+ + 091    walkmap superstructure. TODO: recursive, quite likely to blow the fragile +
+ + 092    Clojure stack. Probably better to do this with `walk`, but I don't yet +
+ + 093    understand that." +
+ + 094    [x s] +
+ + 095    (cond +
+ + 096      ;; if it's a keyword identifying something in s, retrieve that something. +
+ + 097      (keyword? x) (if (s x) +
+ + 098                     (in-retrieve (s x) s) +
+ + 099                     x) +
+ + 100      ;; if it's a map, for every key which is not `:walkmap.id/id`, recurse. +
+ + 101      (map? x) (let [v (reduce +
+ + 102                         (fn [m k] +
+ + 103                           (assoc m k (in-retrieve (x k) s))) +
+ + 104                         {} +
+ + 105                         (keys (dissoc x :walkmap.id/id))) +
+ + 106                     id (:walkmap.id/id x)] +
+ + 107                 ;; if it has an id, bind it to that id in the returned value. +
+ + 108                 (if id +
+ + 109                   (assoc +
+ + 110                     v +
+ + 111                     :walkmap.id/id +
+ + 112                     (:walkmap.id/id x)) +
+ + 113                   v)) +
+ + 114      (set? x) x ;; TODO: should I search in sets for objects when storing? +
+ + 115      (coll? x) (map #(in-retrieve % s) x) +
+ + 116      :else x)) +
+ + 117   +
+ + 118  (defn retrieve +
+ + 119    "Retrieve the canonical representation of the object with this `id` from the +
+ + 120    superstructure `s`." +
+ + 121    [id s] +
+ + 122    (in-retrieve (id s) s)) +
+ + 123   +
+ + 124  (defn in-store-find-objects +
+ + 125    "Return an id -> object map of every object within `o`. Internal to +
+ + 126    `in-store`, q.v. Use at your own peril." +
+ + 127    ([o] +
+ + 128     (in-store-find-objects o {})) +
+ + 129    ([o s] +
+ + 130     (l/debug "Finding objects in:" o) +
+ + 131     (cond +
+ + 132       (set? o) s ;; TODO: should I search in sets for objects when storing? +
+ + 133       (map? o) (if (:walkmap.id/id o) +
+ + 134                  (assoc +
+ + 135                    (in-store-find-objects (vals o) s) +
+ + 136                    (:walkmap.id/id o) +
+ + 137                    o) +
+ + 138                  (in-store-find-objects (vals o) s)) +
+ + 139       (coll? o) (reduce merge s (map #(in-store-find-objects % s) o)) +
+ + 140       :else s))) +
+ + 141   +
+ + 142  (defn in-store-replace-with-keys +
+ + 143    "Return a copy of `o` in which each reified walkmap object within `o` has +
+ + 144    been replaced with the `:walkmap.id/id` of that object. Internal to +
+ + 145    `in-store`, q.v. Use at your own peril." +
+ + 146    [o] +
+ + 147    (assoc +
+ + 148      (postwalk #(or (:walkmap.id/id %) %) (dissoc o :walkmap.id/id)) +
+ + 149      :walkmap.id/id +
+ + 150      (:walkmap.id/id o))) +
+ + 151   +
+ + 152  ;; (in-store-replace-with-keys (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3))) +
+ + 153  ;; (in-store-find-objects (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3))) +
+ + 154   +
+ + 155  (defn store +
+ + 156    "Return a superstructure like `s` with object `o` added. If only one +
+ + 157    argument is supplied it will be assumed to represent `o` and a new +
+ + 158    superstructure will be returned. +
+ + 159   +
+ + 160    It is an error (and an exception may be thrown) if +
+ + 161   +
+ + 162    1. `s` is not a map; +
+ + 163    2. `o` is not a recognisable walkmap object" +
+ + 164    ([o] +
+ + 165     (store o {})) +
+ + 166    ([o s] +
+ + 167     (when-not (:walkmap.id/id o) +
+ + 168       (throw +
+ + 169         (IllegalArgumentException. +
+ + 170           (str "Not a walkmap object: no value for `:walkmap.id/id`: " +
+ + 171                (u/kind-type o))))) +
+ + 172     (when-not (map? s) +
+ + 173       (throw +
+ + 174         (IllegalArgumentException. +
+ + 175           (str "Superstructure must be a map: " (u/kind-type s))))) +
+ + 176     (assoc +
+ + 177       (u/deep-merge s (in-store-find-objects o) (index-vertices s o)) +
+ + 178       (:walkmap.id/id o) +
+ + 179       (in-store-replace-with-keys o)))) +
+ + 180   +
+ + 181  (defn search-vertices +
+ + 182    "Search superstructure `s` for vertices within the box defined by vertices +
+ + 183    `minv` and `maxv`. Every coordinate in `minv` must have a lower value than +
+ + 184    the equivalent coordinate in `maxv`. If `d2?` is supplied and not false, +
+ + 185    search only in the x,y projection. +
+ + 186   +
+ + 187    **NOTE THAT** this depends on the fact that vertices do not currently +
+ + 188    have properties which will be denormalised by `store`, and therefore do not +
+ + 189    have to restored with `retrieve`. If properties are added to vertices +
+ + 190    whose values are objects, then this will have to be rewritten." +
+ + 191    ([s minv maxv] +
+ + 192     (search-vertices s minv maxv false)) +
+ + 193    ([s minv maxv d2?] +
+ + 194     (let [minv' (if d2? (assoc minv :z Double/NEGATIVE_INFINITY) minv) +
+ + 195           maxv' (if d2? (assoc maxv :z Double/POSITIVE_INFINITY) maxv)] +
+ + 196       (filter +
+ + 197         #(v/within-box? % minv maxv) +
+ + 198         (filter #(= (:kind %) :vertex) (vals s)))))) +
+ + 199   +
+ + 200  (defn nearest +
+ + 201    "Search superstructure `s` for the nearest object matching `filter-fn` to +
+ + 202    the `target` vertex. Searches only with `radius` (slight misnomer, area +
+ + 203    actually searched is a cube). Returns one object, or `nil` if no matching +
+ + 204    object found. +
+ + 205   +
+ + 206    WARNING: currently only returns objects which have a defined `:centre` +
+ + 207    (but most of the significant objects we have do)." +
+ + 208    [s target filter-fn radius] +
+ + 209    (let [minv (v/vertex +
+ + 210                 (- (:x (v/check-vertex target)) radius) +
+ + 211                 (- (:y target) radius) (- (or (:z target) 0) radius)) +
+ + 212          maxv (v/vertex +
+ + 213                 (+ (:x target) 0.5) (+ (:y target) 0.5) +
+ + 214                 (+ (or (:z target) 0) 0.5))] +
+ + 215      ;; filter those objects with the filter function, then sort that list +
+ + 216      ;; by the edge distance from the target to the `:centre` of the object +
+ + 217      ;; and take the first +
+ + 218      (first +
+ + 219        (sort-by +
+ + 220          #(length (edge target (:centre %))) +
+ + 221          (filter +
+ + 222            :centre +
+ + 223            (map #(retrieve % s) +
+ + 224                 ;; for each vertex id in vids, get the objects associated with that id +
+ + 225                 ;; in the vertex index as a single flat list +
+ + 226                 (reduce +
+ + 227                   concat +
+ + 228                   (remove +
+ + 229                     nil? +
+ + 230                     (map +
+ + 231                       #(-> s ::vertex-index % keys) +
+ + 232                       ;; get all the vertex ids within radius of the target +
+ + 233                       (set +
+ + 234                         (map +
+ + 235                           :walkmap.id/id +
+ + 236                           (search-vertices s minv maxv)))))))))))) +
+ + 237   +
+ + 238  (defn touching +
+ + 239    "Return a sequence of all objects in superstructure `s` which are +
+ + 240    indexed as touching the vertex `v`." +
+ + 241    ([vertex s] +
+ + 242     (map +
+ + 243       #(retrieve % s) +
+ + 244       (set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys)))) +
+ + 245    ([vertex filter-fn s] +
+ + 246     (filter +
+ + 247       filter-fn +
+ + 248       (touching vertex s)))) +
+ + 249   +
+ + 250  (defn neighbours +
+ + 251    "Return a sequence of all those objects in superstructure `s` which share +
+ + 252    at least one vertex with `target`, and which are matched by `filter-fn` +
+ + 253    if supplied." +
+ + 254    ([target s] +
+ + 255     (neighbours identity s)) +
+ + 256    ([target filter-fn s] +
+ + 257     (remove +
+ + 258       #(= target %) +
+ + 259       (reduce +
+ + 260         concat +
+ + 261         (remove +
+ + 262           nil? +
+ + 263           (map #(touching % filter-fn s) (vertices target))))))) +
+ + 264   +
+ + 265  (defn neighbour-ids +
+ + 266    "Return a sequence of the ids all those objects in superstructure `s` which +
+ + 267    share at least one vertex with `target`, and which are matched by +
+ + 268    `filter-fn` if supplied." +
+ + 269    ([target s] +
+ + 270     (neighbour-ids target identity s)) +
+ + 271    ([target filter-fn s] +
+ + 272     (map :walkmap.id/id (neighbours target filter-fn s))))
diff --git a/docs/cloverage/walkmap/utils.clj.html b/docs/cloverage/walkmap/utils.clj.html index bf4b92c..c9bbe84 100644 --- a/docs/cloverage/walkmap/utils.clj.html +++ b/docs/cloverage/walkmap/utils.clj.html @@ -343,5 +343,23 @@ 113        (printf "Error parsing edn file '%s': %s\n" source (.getMessage e)))))
+ + 114   +
+ + 115  (defn not-yet-implemented +
+ + 116    [message] +
+ + 117    (throw +
+ + 118      (UnsupportedOperationException. +
+ + 119        (str "Not yet implemented: " message)))) +
diff --git a/docs/codox/index.html b/docs/codox/index.html index 819e75e..52315c7 100644 --- a/docs/codox/index.html +++ b/docs/codox/index.html @@ -1,3 +1,3 @@ -Walkmap 0.1.0-SNAPSHOT

Project

Topics

Namespaces

Walkmap 0.1.0-SNAPSHOT

Released under the EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0

A Clojure library designed to assist in computing walkmaps for games.

Installation

To install, add the following dependency to your project or build file:

[journeyman-cc/walkmap "0.1.0-SNAPSHOT"]

Topics

Namespaces

walkmap.edge

Essentially the specification for things we shall consider to be an edge. An edge is a line segment having just a start and an end, with no intervening nodes.

Public variables and functions:

walkmap.id

The namespace within which the privileged keyword :walkmap.id/id is defined.

Public variables and functions:

walkmap.microworld

An interface between walkmap and microworld, to allow use of microworld functionality to model things like rainfall, soil fertility, settlement and so on.

Public variables and functions:

walkmap.ocean

Deal with (specifically, at this stage, cull) ocean areas

Public variables and functions:

walkmap.path

Essentially the specification for things we shall consider to be path. Note that for these purposes path means any continuous linear feature, where such features specifically include watercourses.

Public variables and functions:

walkmap.polygon

Essentially the specification for things we shall consider to be polygons.

Public variables and functions:

walkmap.read-svg

Utility functions for scalable vector graphics (SVG) into walkmap structures.

Public variables and functions:

walkmap.routing

Finding optimal routes to traverse a map.

Public variables and functions:

    walkmap.stl

    Utility functions dealing with stereolithography (STL) files. Not a stable API yet!

    Public variables and functions:

    walkmap.superstructure

    single indexing structure for walkmap objects

    Public variables and functions:

    walkmap.svg

    Utility functions for writing stereolithography (STL) files (and possibly, later, other geometry files of interest to us) as scalable vector graphics (SVG).

    Public variables and functions:

    walkmap.tag

    Code for tagging, untagging, and finding tags on objects. Note the use of the namespaced keyword, :walkmap.tag/tags, denoted in this file ::tags. This is in an attempt to avoid name clashes with other uses of this key.

    Public variables and functions:

    walkmap.utils

    Miscellaneous utility functions.

    Public variables and functions:

    walkmap.vertex

    Essentially the specification for things we shall consider to be vertices.

    Public variables and functions:

    \ No newline at end of file +Walkmap 0.1.0-SNAPSHOT

    Project

    Topics

    Namespaces

    Walkmap 0.1.0-SNAPSHOT

    Released under the EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0

    A Clojure library designed to assist in computing walkmaps for games.

    Installation

    To install, add the following dependency to your project or build file:

    [journeyman-cc/walkmap "0.1.0-SNAPSHOT"]

    Topics

    Namespaces

    walkmap.edge

    Essentially the specification for things we shall consider to be an edge. An edge is a line segment having just a start and an end, with no intervening nodes.

    Public variables and functions:

    walkmap.id

    The namespace within which the privileged keyword :walkmap.id/id is defined.

    Public variables and functions:

    walkmap.microworld

    An interface between walkmap and microworld, to allow use of microworld functionality to model things like rainfall, soil fertility, settlement and so on.

    Public variables and functions:

    walkmap.ocean

    Deal with (specifically, at this stage, cull) ocean areas

    Public variables and functions:

    walkmap.path

    Essentially the specification for things we shall consider to be path. Note that for these purposes path means any continuous linear feature, where such features specifically include watercourses.

    Public variables and functions:

    walkmap.polygon

    Essentially the specification for things we shall consider to be polygons.

    Public variables and functions:

    walkmap.read-svg

    Utility functions for scalable vector graphics (SVG) into walkmap structures.

    Public variables and functions:

    walkmap.routing

    Finding optimal routes to traverse a map.

    Public variables and functions:

    walkmap.stl

    Utility functions dealing with stereolithography (STL) files. Not a stable API yet!

    Public variables and functions:

    walkmap.superstructure

    single indexing structure for walkmap objects

    Public variables and functions:

    walkmap.svg

    Utility functions for writing stereolithography (STL) files (and possibly, later, other geometry files of interest to us) as scalable vector graphics (SVG).

    Public variables and functions:

    walkmap.tag

    Code for tagging, untagging, and finding tags on objects. Note the use of the namespaced keyword, :walkmap.tag/tags, denoted in this file ::tags. This is in an attempt to avoid name clashes with other uses of this key.

    Public variables and functions:

    walkmap.utils

    Miscellaneous utility functions.

    Public variables and functions:

    walkmap.vertex

    Essentially the specification for things we shall consider to be vertices.

    Public variables and functions:

    \ No newline at end of file diff --git a/docs/codox/walkmap.microworld.html b/docs/codox/walkmap.microworld.html index f69ee8b..67788e4 100644 --- a/docs/codox/walkmap.microworld.html +++ b/docs/codox/walkmap.microworld.html @@ -1,3 +1,3 @@ -walkmap.microworld documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.microworld

    An interface between walkmap and microworld, to allow use of microworld functionality to model things like rainfall, soil fertility, settlement and so on.

    cell->polygon

    (cell->polygon cell)(cell->polygon cell scale-vector)

    TODO: write docs

    view source

    load-microworld-edn

    (load-microworld-edn filename)(load-microworld-edn filename map-kind)(load-microworld-edn filename mapkind superstucture)(load-microworld-edn filename map-kind superstructure scale-vertex)

    While it would be possible to call MicroWorld functions directly from Walkmap, the fact is that running MicroWorld is so phenomenally compute-heavy that it’s much more sensible to do it in batch mode. So the better plan is to be able to pull the output from MicroWorld - as an EDN structure - into a walkmap superstructure.

    view source
    \ No newline at end of file +walkmap.microworld documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.microworld

    An interface between walkmap and microworld, to allow use of microworld functionality to model things like rainfall, soil fertility, settlement and so on.

    cell->polygon

    (cell->polygon cell)(cell->polygon cell scale-vector)

    From this MicroWorld cell, construct a walkmap polygon (specifically, a rectangle. If scale-vector passed and is a vertex, scale all the vertices in the cell by that vector.

    view source

    load-microworld-edn

    (load-microworld-edn filename)(load-microworld-edn filename map-kind)(load-microworld-edn filename mapkind superstucture)(load-microworld-edn filename map-kind superstructure scale-vertex)

    While it would be possible to call MicroWorld functions directly from Walkmap, the fact is that running MicroWorld is so phenomenally compute-heavy that it’s much more sensible to do it in batch mode. So the better plan is to be able to pull the output from MicroWorld - as an EDN structure - into a walkmap superstructure.

    view source
    \ No newline at end of file diff --git a/docs/codox/walkmap.path.html b/docs/codox/walkmap.path.html index 33c8a59..44ffdd6 100644 --- a/docs/codox/walkmap.path.html +++ b/docs/codox/walkmap.path.html @@ -1,5 +1,5 @@ -walkmap.path documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.path

    Essentially the specification for things we shall consider to be path. Note that for these purposes path means any continuous linear feature, where such features specifically include watercourses.

    check-path

    macro

    (check-path o)

    If o is not a path, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-paths

    macro

    (check-paths o)

    If o is not a sequence of paths, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    length

    (length path)

    Return the length of this path, in metres. Note that 1. This is not the same as the distance from the start to the end of the path, which, except for absolutely straight paths, will be shorter; 2. It is not even quite the same as the length of the path as rendered, since paths will generally be rendered as spline curves.

    view source

    path

    (path & vertices)

    Return a path constructed from these vertices.

    view source

    path->edges

    (path->edges o)

    if o is a path, a polygon, or a sequence of vertices, return a sequence of edges representing that path, polygon or sequence.

    -

    Throws IllegalArgumentException if o is not a path, a polygon, or sequence of vertices.

    view source

    path?

    (path? o)

    True if o satisfies the conditions for a path. A path shall be a map having the key :vertices, whose value shall be a sequence of vertices as defined in walkmap.vertex.

    view source

    polygon->path

    (polygon->path o)

    If o is a polygon, return an equivalent path. What’s different about a path is that in polygons there is an implicit edge between the first vertex and the last. In paths, there isn’t, so we need to add that edge explicitly.

    -

    If o is not a polygon, will throw an exception.

    view source
    \ No newline at end of file +walkmap.path documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.path

    Essentially the specification for things we shall consider to be path. Note that for these purposes path means any continuous linear feature, where such features specifically include watercourses.

    check-path

    macro

    (check-path o)

    If o is not a path, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-paths

    macro

    (check-paths o)

    If o is not a sequence of paths, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    length

    (length path)

    Return the length of this path, in metres. Note that 1. This is not the same as the distance from the start to the end of the path, which, except for absolutely straight paths, will be shorter; 2. It is not even quite the same as the length of the path as rendered, since paths will generally be rendered as spline curves.

    view source

    path

    (path & vertices)

    Return a path constructed from these vertices.

    view source

    path->edges

    (path->edges o)

    if o is a path, a polygon, or a sequence of vertices, return a sequence of edges representing that path, polygon or sequence.

    +

    Throws IllegalArgumentException if o is not a path, a polygon, or sequence of vertices.

    view source

    path?

    (path? o)

    True if o satisfies the conditions for a path. A path shall be a map having the key :vertices, whose value shall be a sequence of vertices as defined in walkmap.vertex.

    view source

    polygon->path

    (polygon->path o)

    If o is a polygon, return an equivalent path. What’s different about a path is that in polygons there is an implicit edge between the first vertex and the last. In paths, there isn’t, so we need to add that edge explicitly.

    +

    If o is not a polygon, will throw an exception.

    view source
    \ No newline at end of file diff --git a/docs/codox/walkmap.polygon.html b/docs/codox/walkmap.polygon.html index f2b0b3e..9b766bf 100644 --- a/docs/codox/walkmap.polygon.html +++ b/docs/codox/walkmap.polygon.html @@ -1,3 +1,3 @@ -walkmap.polygon documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.polygon

    Essentially the specification for things we shall consider to be polygons.

    centre

    (centre poly)

    TODO: write docs

    view source

    check-polygon

    macro

    (check-polygon o)

    If o is not a polygon, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-polygons

    macro

    (check-polygons o)

    If o is not a sequence of polygons, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-triangle

    macro

    (check-triangle o)

    If o is not a triangle, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    gradient

    (gradient triangle)

    Return a polygon like triangle but with a key :gradient whose value is a unit vector representing the gradient across triangle.

    view source

    polygon

    (polygon & vertices)

    Return a polygon constructed from these vertices.

    view source

    polygon?

    (polygon? o)

    True if o satisfies the conditions for a polygon. A polygon shall be a map which has a value for the key :vertices, where that value is a sequence of vertices.

    view source

    rectangle

    (rectangle vsw vne)

    Return a rectangle, with edges aligned east-west and north-south, whose south-west corner is the vertex vsw and whose north-east corner is the vertex vne.

    view source

    triangle-centre

    (triangle-centre facet)

    Return a canonicalised facet (i.e. a triangular polygon) with an added key :centre whose value represents the centre of this facet in 3 dimensions. This only works for triangles, so is here not in walkmap.polygon. It is an error (although no exception is currently thrown) if the object past is not a triangular polygon.

    view source

    triangle?

    (triangle? o)

    True if o satisfies the conditions for a triangle. A triangle shall be a polygon with exactly three vertices.

    view source
    \ No newline at end of file +walkmap.polygon documentation

    Project

    Topics

    Namespaces

    Public Vars

    walkmap.polygon

    Essentially the specification for things we shall consider to be polygons.

    centre

    (centre poly)

    TODO: write docs

    view source

    check-polygon

    macro

    (check-polygon o)

    If o is not a polygon, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-polygons

    macro

    (check-polygons o)

    If o is not a sequence of polygons, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    check-triangle

    macro

    (check-triangle o)

    If o is not a triangle, throw an IllegalArgumentException with an appropriate message; otherwise, returns o. Macro, so exception is thrown from the calling function.

    view source

    gradient

    (gradient triangle)

    Return a polygon like triangle but with a key :gradient whose value is a unit vector representing the gradient across triangle.

    view source

    on2d?

    macro

    (on2d? vertex poly)

    Is the projection of this vertex on the x, y plane within the projection of this polygon poly on that plane?

    view source

    on2drectangle?

    (on2drectangle? vertex rectangle)

    Is the projection of this vertex on the x, y plane within the projection of this rectangle on that plane?

    view source

    on2dtriangle?

    macro

    (on2dtriangle? vertex poly)

    Is the projection of this vertex on the x, y plane within the projection of this triangle on that plane?

    view source

    polygon

    (polygon & vertices)

    Return a polygon constructed from these vertices.

    view source

    polygon?

    (polygon? o)

    True if o satisfies the conditions for a polygon. A polygon shall be a map which has a value for the key :vertices, where that value is a sequence of vertices.

    view source

    rectangle

    (rectangle vsw vne)

    Return a rectangle, with edges aligned east-west and north-south, whose south-west corner is the vertex vsw and whose north-east corner is the vertex vne.

    view source

    triangle-centre

    (triangle-centre facet)

    Return a canonicalised facet (i.e. a triangular polygon) with an added key :centre whose value represents the centre of this facet in 3 dimensions. This only works for triangles, so is here not in walkmap.polygon. It is an error (although no exception is currently thrown) if the object past is not a triangular polygon.

    view source

    triangle?

    (triangle? o)

    True if o satisfies the conditions for a triangle. A triangle shall be a polygon with exactly three vertices.

    view source
    \ No newline at end of file diff --git a/docs/codox/walkmap.routing.html b/docs/codox/walkmap.routing.html index f8bb0e0..78cd602 100644 --- a/docs/codox/walkmap.routing.html +++ b/docs/codox/walkmap.routing.html @@ -1,3 +1,3 @@ -walkmap.routing documentation

    Project

    Topics

    Namespaces

    Public Vars

      walkmap.routing

      Finding optimal routes to traverse a map.

      \ No newline at end of file +walkmap.routing documentation

      Project

      Topics

      Namespaces

      Public Vars

      walkmap.routing

      Finding optimal routes to traverse a map.

      *gradient-exponent*

      dynamic

      The exponent to be applied to (inc (:z (unit-vector from to))) of a path segment to calculate the gradient-related part of the cost of traversal. Dynamic, because we will want to tune this.

      view source

      *traversals-exponent*

      dynamic

      The (expected to be negative) exponent to be applied to the number of traversals of a path to compute the road bonus. Paths more travelled by should have larger bonuses, but not dramatically so - so the increase in bonus needs to scale significantly less than linearly with the number of traversals. Dynamic, because we will want to tune this.

      view source

      barriers-crossed

      (barriers-crossed from to s)

      Search superstructure s and return a sequence of barriers, if any, which obstruct traversal from vertex from to vertex to.

      view source

      best-road

      (best-road from to s)

      Find the best traversable path which links the vertices from and to in this superstructure s, or nil if there are none.

      view source

      crossing-penalty

      (crossing-penalty barrier from to s)

      TODO: should return the cost of crossing this barrier, initially mainly a watercourse, on the axis from vertex from to vertex to. in the context of superstructure s. If there’s a bridge, ferry or other crossing mechanism in s at the intersection of the vertex and the barrier, then the penalty should be substantially less than it would otherwise be.

      view source

      extend-frontier

      (extend-frontier frontier candidates)(extend-frontier frontier candidates rejects)

      Return a sequence like frontier with all of these candidates which are not already members either of frontier or of rejects appended.

      view source

      gradient-cost

      (gradient-cost edge)

      Compute the per-unit-distance cost of traversing this edge.

      view source

      path-traversal-cost

      (path-traversal-cost path s)

      TODO: write docs

      view source

      road-bonus

      (road-bonus from to s)

      Calculate the road bonus of the edge represented by the vertices from, to, in the context of the superstructure s. Obviously there only is such a bonus if there actually is an existing thoroughfare to use. Road bonuses scale with some fractional exponent of the number of traversals which have been made of the road segment in question.

      view source

      route

      (route from to s search-radius)

      TODO: write docs

      view source

      traversable?

      (traversable? object)

      True if this object can be considered as part of the walkmap.

      view source

      traversal-cost

      (traversal-cost from to s)

      Return the traversal cost of the edge represented by the vertices from, to, in the context of the superstructure s. It is legitimate to pass nil as the to argument, in which case the result will be zero, in order to allow reduce to be used to compute total path costs.

      view source

      vertices-traversal-cost

      (vertices-traversal-cost vertices s)

      TODO: write docs

      view source
      \ No newline at end of file diff --git a/docs/codox/walkmap.superstructure.html b/docs/codox/walkmap.superstructure.html index 0e62012..b917dc8 100644 --- a/docs/codox/walkmap.superstructure.html +++ b/docs/codox/walkmap.superstructure.html @@ -1,20 +1,21 @@ -walkmap.superstructure documentation

      Project

      Topics

      Namespaces

      Public Vars

      walkmap.superstructure

      single indexing structure for walkmap objects

      find-nearest

      (find-nearest s target filter-fn radius)

      Search superstructure s for the nearest object matching filter-fn to the target vertex. Searches only with radius (slight misnomer, area actually searched is a cube). Returns one object, or nil if no matching object found.

      -

      WARNING: currently only returns objects which have a defined :centre (but most of the significant objects we have do).

      view source

      in-retrieve

      (in-retrieve x s)

      Internal guts of retrieve, q.v. x can be anything; s must be a walkmap superstructure. TODO: recursive, quite likely to blow the fragile Clojure stack. Probably better to do this with walk, but I don’t yet understand that.

      view source

      in-store-find-objects

      (in-store-find-objects o)(in-store-find-objects o s)

      Return an id -> object map of every object within o. Internal to in-store, q.v. Use at your own peril.

      view source

      in-store-replace-with-keys

      (in-store-replace-with-keys o)

      Return a copy of o in which each reified walkmap object within o has been replaced with the :walkmap.id/id of that object. Internal to in-store, q.v. Use at your own peril.

      view source

      index-vertex

      (index-vertex s o v)

      Return a superstructure like s in which object o is indexed by vertex v. It is an error (and an exception may be thrown) if

      +walkmap.superstructure documentation

      Project

      Topics

      Namespaces

      Public Vars

      walkmap.superstructure

      single indexing structure for walkmap objects

      in-retrieve

      (in-retrieve x s)

      Internal guts of retrieve, q.v. x can be anything; s must be a walkmap superstructure. TODO: recursive, quite likely to blow the fragile Clojure stack. Probably better to do this with walk, but I don’t yet understand that.

      view source

      in-store-find-objects

      (in-store-find-objects o)(in-store-find-objects o s)

      Return an id -> object map of every object within o. Internal to in-store, q.v. Use at your own peril.

      view source

      in-store-replace-with-keys

      (in-store-replace-with-keys o)

      Return a copy of o in which each reified walkmap object within o has been replaced with the :walkmap.id/id of that object. Internal to in-store, q.v. Use at your own peril.

      view source

      index-vertex

      (index-vertex s o v)

      Return a superstructure like s in which object o is indexed by vertex v. It is an error (and an exception may be thrown) if

      1. s is not a map;
      2. o is not a map;
      3. o does not have a value for the key :walkmap.id/id;
      4. v is not a vertex.
        5. -
      view source

      index-vertices

      (index-vertices s o)

      Return a superstructure like s in which object o is indexed by its vertices. It is an error (and an exception may be thrown) if

      +
      view source

      index-vertices

      (index-vertices s o)

      Return a superstructure like s in which object o is indexed by its vertices. It is an error (and an exception may be thrown) if

      1. s is not a map;
      2. o is not a map;
      3. o does not have a value for the key :walkmap.id/id.
        4. -
      view source

      retrieve

      (retrieve id s)

      Retrieve the canonical representation of the object with this id from the superstructure s.

      view source

      search-vertices

      (search-vertices s minv maxv)(search-vertices s minv maxv d2?)

      Search superstructure s for vertices within the box defined by vertices minv and maxv. Every coordinate in minv must have a lower value than the equivalent coordinate in maxv. If d2? is supplied and not false, search only in the x,y projection.

      view source

      store

      (store o)(store o s)

      Return a superstructure like s with object o added. If only one argument is supplied it will be assumed to represent o and a new superstructure will be returned.

      +
      view source

      nearest

      (nearest s target filter-fn radius)

      Search superstructure s for the nearest object matching filter-fn to the target vertex. Searches only with radius (slight misnomer, area actually searched is a cube). Returns one object, or nil if no matching object found.

      +

      WARNING: currently only returns objects which have a defined :centre (but most of the significant objects we have do).

      view source

      neighbour-ids

      (neighbour-ids target s)(neighbour-ids target filter-fn s)

      Return a sequence of the ids all those objects in superstructure s which share at least one vertex with target, and which are matched by filter-fn if supplied.

      view source

      neighbours

      (neighbours target s)(neighbours target filter-fn s)

      Return a sequence of all those objects in superstructure s which share at least one vertex with target, and which are matched by filter-fn if supplied.

      view source

      retrieve

      (retrieve id s)

      Retrieve the canonical representation of the object with this id from the superstructure s.

      view source

      search-vertices

      (search-vertices s minv maxv)(search-vertices s minv maxv d2?)

      Search superstructure s for vertices within the box defined by vertices minv and maxv. Every coordinate in minv must have a lower value than the equivalent coordinate in maxv. If d2? is supplied and not false, search only in the x,y projection.

      +

      NOTE THAT this depends on the fact that vertices do not currently have properties which will be denormalised by store, and therefore do not have to restored with retrieve. If properties are added to vertices whose values are objects, then this will have to be rewritten.

      view source

      store

      (store o)(store o s)

      Return a superstructure like s with object o added. If only one argument is supplied it will be assumed to represent o and a new superstructure will be returned.

      It is an error (and an exception may be thrown) if

      1. s is not a map;
      2. o is not a recognisable walkmap object
        3. -
      view source

      vertex-index

      TODO: write docs

      view source

      vertices

      (vertices o)

      If o is an object with vertices, return those vertices, else nil.

      view source
      \ No newline at end of file +
      view source

      touching

      (touching vertex s)(touching vertex filter-fn s)

      Return a sequence of all objects in superstructure s which are indexed as touching the vertex v.

      view source

      vertex-index

      TODO: write docs

      view source

      vertices

      (vertices o)

      If o is an object with vertices, return those vertices, else nil.

      view source
      \ No newline at end of file diff --git a/docs/codox/walkmap.utils.html b/docs/codox/walkmap.utils.html index 80f6037..257f844 100644 --- a/docs/codox/walkmap.utils.html +++ b/docs/codox/walkmap.utils.html @@ -1,5 +1,5 @@ -walkmap.utils documentation

      Project

      Topics

      Namespaces

      Public Vars

      walkmap.utils

      Miscellaneous utility functions.

      =ish

      (=ish n1 n2)(=ish n1 n2 tolerance)

      True if numbers n1, n2 are roughly equal; that is to say, equal to within tolerance (defaults to one part in one hundred thousand).

      view source

      check-kind-type

      macro

      (check-kind-type object expected)(check-kind-type object checkfn expected)

      If object is not of kind-type expected, throws an IllegalArgumentException with an appropriate message; otherwise, returns object. If checkfn is supplied, it should be a function which tests whether the object is of the expected kind-type.

      +walkmap.utils documentation

      Project

      Topics

      Namespaces

      Public Vars

      walkmap.utils

      Miscellaneous utility functions.

      =ish

      (=ish n1 n2)(=ish n1 n2 tolerance)

      True if numbers n1, n2 are roughly equal; that is to say, equal to within tolerance (defaults to one part in one hundred thousand).

      view source

      check-kind-type

      macro

      (check-kind-type object expected)(check-kind-type object checkfn expected)

      If object is not of kind-type expected, throws an IllegalArgumentException with an appropriate message; otherwise, returns object. If checkfn is supplied, it should be a function which tests whether the object is of the expected kind-type.

      Macro, so that the exception is thrown from the calling function.

      view source

      check-kind-type-seq

      macro

      (check-kind-type-seq s expected)(check-kind-type-seq s checkfn expected)

      If some item on sequence s is not of the expected kind-type, throws an IllegalArgumentException with an appropriate message; otherwise, returns object. If checkfn is supplied, it should be a function which tests whether the object is of the expected kind-type.

      -

      Macro, so that the exception is thrown from the calling function.

      view source

      deep-merge

      (deep-merge & vals)

      Recursively merges maps. If vals are not maps, the last value wins.

      view source

      kind-type

      (kind-type object)

      Identify the type of an object, e.g. for logging. If it has a :kind key, it’s one of ours, and that’s what we want. Otherwise, we want its type; but the type of nil is nil, which doesn’t get printed when assembling error ,essages, so return “nil”.

      view source

      load-edn

      (load-edn source)

      Load edn from an io/reader source (filename or io/resource).

      view source

      truncate

      (truncate s n)

      If string s is more than n characters long, return the first n characters; otherwise, return s.

      view source
      \ No newline at end of file +

      Macro, so that the exception is thrown from the calling function.

      view source

      deep-merge

      (deep-merge & vals)

      Recursively merges maps. If vals are not maps, the last value wins.

      view source

      kind-type

      (kind-type object)

      Identify the type of an object, e.g. for logging. If it has a :kind key, it’s one of ours, and that’s what we want. Otherwise, we want its type; but the type of nil is nil, which doesn’t get printed when assembling error ,essages, so return “nil”.

      view source

      load-edn

      (load-edn source)

      Load edn from an io/reader source (filename or io/resource).

      view source

      not-yet-implemented

      (not-yet-implemented message)

      TODO: write docs

      view source

      truncate

      (truncate s n)

      If string s is more than n characters long, return the first n characters; otherwise, return s.

      view source
      \ No newline at end of file diff --git a/src/walkmap/edge.clj b/src/walkmap/edge.clj index d6a042f..a583dd3 100644 --- a/src/walkmap/edge.clj +++ b/src/walkmap/edge.clj @@ -4,15 +4,15 @@ nodes." (:require [clojure.math.numeric-tower :as m] [walkmap.utils :as u] - [walkmap.vertex :refer [canonicalise ensure2d ensure3d vertex vertex= vertex?]])) + [walkmap.vertex :refer [canonicalise check-vertex ensure2d ensure3d vertex vertex= vertex?]])) (defn edge "Return an edge between vertices `v1` and `v2`." [v1 v2] - (if - (and (vertex? v1) (vertex? v2)) - {:kind :edge :walkmap.id/id (keyword (gensym "edge")) :start v1 :end v2} - (throw (IllegalArgumentException. "Must be vertices.")))) + {:kind :edge + :walkmap.id/id (keyword (gensym "edge")) + :start (check-vertex v1) + :end (check-vertex v2)}) (defn edge? "True if `o` satisfies the conditions for a edge. An edge shall be a map diff --git a/src/walkmap/microworld.clj b/src/walkmap/microworld.clj index f23380c..bea1282 100644 --- a/src/walkmap/microworld.clj +++ b/src/walkmap/microworld.clj @@ -10,7 +10,8 @@ [walkmap.polygon :as p :only [rectangle]] [walkmap.superstructure :refer [store]] [walkmap.tag :as t :only [tag]] - [walkmap.vertex :as v :only [check-vertex vertex vertex?]])) + [walkmap.vertex :as v :only [check-vertex vertex vertex?]] + [walkmap.utils :as u :only [truncate]])) (defn cell->polygon "From this MicroWorld `cell`, construct a walkmap polygon (specifically, @@ -23,7 +24,7 @@ (assoc (merge cell - (let [w (* (:x cell) (:x (check-vertex scale-vector))) + (let [w (* (:x cell) (:x (v/check-vertex scale-vector))) s (* (:y cell) (:y scale-vector)) e (+ w (:x scale-vector)) n (+ s (:y scale-vector)) diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj index 4b0d9a3..76e4e8b 100644 --- a/src/walkmap/path.clj +++ b/src/walkmap/path.clj @@ -7,7 +7,7 @@ [walkmap.polygon :refer [check-polygon polygon?]] [walkmap.tag :refer [tag tags]] [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]] - [walkmap.vertex :refer [vertex?]])) + [walkmap.vertex :refer [check-vertices vertex?]])) (defn path? "True if `o` satisfies the conditions for a path. A path shall be a map @@ -26,9 +26,8 @@ (defn path "Return a path constructed from these `vertices`." [& vertices] - (check-kind-type-seq vertices vertex? :vertex) (if - (> (count vertices) 1) + (> (count (check-vertices vertices)) 1) {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path} (throw (IllegalArgumentException. "Path must have more than one vertex.")))) diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj index 2b52167..87cb757 100644 --- a/src/walkmap/polygon.clj +++ b/src/walkmap/polygon.clj @@ -3,7 +3,10 @@ (:require [clojure.string :as s] [walkmap.edge :as e] [walkmap.tag :as t] - [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]] + [walkmap.utils :refer [check-kind-type + check-kind-type-seq + kind-type + not-yet-implemented]] [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]])) (defn polygon? @@ -72,10 +75,13 @@ (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) vse (vertex (:x vne) (:y vsw) - (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))] + (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) + height-order (sort-by :z [vsw vne])] (t/tag (assoc (polygon vsw vnw vne vse) + :gradient + (e/unit-vector (e/edge (first height-order) (last height-order))) :centre (vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2)) (+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2)) @@ -122,4 +128,28 @@ (UnsupportedOperationException. "The general case of centre for polygons is not yet implemented.")))) +(defmacro on2dtriangle? + "Is the projection of this `vertex` on the x, y plane within the + projection of this triangle on that plane?" + [vertex poly] + `(not-yet-implemented "on2d? for triangles.")) +(defn on2drectangle? + "Is the projection of this `vertex` on the x, y plane within the + projection of this rectangle on that plane?" + [vertex rectangle] + (let [xo (sort-by :x (:vertices rectangle)) + yo (sort-by :x (:vertices rectangle))] + (and + (< (:x (first xo)) (:x vertex) (:x (last xo))) + (< (:y (first yo)) (:y vertex) (:y (last yo)))))) + +(defmacro on2d? + "Is the projection of this `vertex` on the x, y plane within the + projection of this polygon `poly` on that plane?" + [vertex poly] + `(cond + (rectangle? ~poly) (on2drectangle? ~vertex ~poly) + (triangle? ~poly) (on2dtriangle? ~vertex ~poly) + :else + (not-yet-implemented "general case of on2d? for polygons."))) diff --git a/src/walkmap/read_svg.clj b/src/walkmap/read_svg.clj index ef3e420..93cf98c 100644 --- a/src/walkmap/read_svg.clj +++ b/src/walkmap/read_svg.clj @@ -95,3 +95,6 @@ (let [xml (x/parse (io/file file-name)) paths (progeny xml #(= (:tag %) :path))] (remove nil? (map path-elt->path paths))))) + +;; (read-svg "resources/iom/manual_roads.svg") + diff --git a/src/walkmap/routing.clj b/src/walkmap/routing.clj index c223844..c9f7c7c 100644 --- a/src/walkmap/routing.clj +++ b/src/walkmap/routing.clj @@ -1,6 +1,8 @@ (ns walkmap.routing "Finding optimal routes to traverse a map." - (:require [walkman.edge :as e] + (:require [clojure.math.numeric-tower :as m :only [expt]] + [clojure.set :refer [intersection]] + [walkmap.edge :as e] [walkmap.path :as p] [walkmap.polygon :as q] [walkmap.superstructure :as s] @@ -19,6 +21,20 @@ ;; ;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html +(def ^:dynamic *gradient-exponent* + "The exponent to be applied to `(inc (:z (unit-vector from to)))` + of a path segment to calculate the gradient-related part of the + cost of traversal. Dynamic, because we will want to tune this." + 2) + +(def ^:dynamic *traversals-exponent* + "The (expected to be negative) exponent to be applied to the number + of traversals of a path to compute the road bonus. Paths more travelled by + should have larger bonuses, but not dramatically so - so the increase in + bonus needs to scale significantly less than linearly with the number + of traversals. Dynamic, because we will want to tune this." + -2) + (defn traversable? "True if this object can be considered as part of the walkmap." [object] @@ -30,6 +46,107 @@ (p/path? object)) (not (t/tagged? object :no-traversal)))) +(declare traversal-cost) + +(defn vertices-traversal-cost + [vertices s] + (reduce + + + (map + #(traversal-cost %1 %2 s) + (v/check-vertices vertices) + (rest vertices)))) + +(defn path-traversal-cost + [path s] + (vertices-traversal-cost (:vertices (p/check-path path)) s)) + +(defn barriers-crossed + "Search superstructure `s` and return a sequence of barriers, if any, which + obstruct traversal from vertex `from` to vertex `to`." + [from to s] + ;; TODO: implement + '()) + +(defn crossing-penalty + "TODO: should return the cost of crossing this `barrier`, initially mainly + a watercourse, on the axis from vertex `from` to vertex `to`. in the context + of superstructure `s`. If there's a bridge, ferry or other crossing mechanism + in `s` at the intersection of the vertex and the barrier, then the penalty + should be substantially less than it would otherwise be." + [barrier from to s] + ;; TODO: implement + 0) + +(defn gradient-cost + "Compute the per-unit-distance cost of traversing this `edge`." + [edge] + (let [g (:z (e/unit-vector edge))] + (if (pos? g) + (m/expt (inc g) *gradient-exponent*) + 1))) + +;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0))) +;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 0))) +;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 1))) +;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 1))) +;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0.0001))) + +(defn best-road + "Find the best traversable path which links the vertices `from` and `to` + in this superstructure `s`, or nil if there are none." + [from to s] + (let [f (fn [v] (set (s/touching v p/path? s)))] + (first + (sort-by + ;;; I... chose the path more travelled by. + #(or (:traversals %) 0) + (filter traversable? (intersection (f from) (f to))))))) + +(defn road-bonus + "Calculate the road bonus of the edge represented by the vertices `from`, + `to`, in the context of the superstructure `s`. Obviously there only is + such a bonus if there actually is an existing thoroughfare to use. Road + bonuses scale with some fractional exponent of the number of traversals + which have been made of the road segment in question." + [from to s] + (let [best (best-road from to s)] + (when (:traversals best) + (m/expt (:traversals best) *traversals-exponent*)))) + +(defn traversal-cost + "Return the traversal cost of the edge represented by the vertices `from`, + `to`, in the context of the superstructure `s`. It is legitimate to pass + `nil` as the `to` argument, in which case the result will be zero, in order + to allow `reduce` to be used to compute total path costs." + [from to s] + (if (nil? to) + 0 + (let [edge (e/edge from to) + distance (e/length edge)] + (/ + (+ + (* distance + (gradient-cost edge)) + (reduce + + (map + #(crossing-penalty [% from to s]) + (barriers-crossed from to s)))) + (or (road-bonus from to s) 1))))) + +;; (def p '({:x 1.40625, :y 0, :kind :vertex, :walkmap.id/id :vert_1-40625_0} +;; {:x 1.40625, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_1-40625_-10-703125} +;; {:x 7.578125, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_7-578125_-10-703125} +;; {:x 7.578125, :y 0, :kind :vertex, :walkmap.id/id :vert_7-578125_0} +;; {:x 2.171875, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_2-171875_-0-765625} +;; {:x 6.8125, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_6-8125_-0-765625})) +;; (v/check-vertices p) +;; (def p' (p/path p)) + +;; (traversal-cost (first p) (nth p 1) {}) +;; (vertices-traversal-cost p {}) +;; (path-traversal-cost (p/path p)) + (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." @@ -60,7 +177,8 @@ (s/nearest s from :centre search-radius) traversable? s)) - visited nil] + visited nil + track nil] (let [here (s/retrieve (first frontier) s)] (cond (< (e/length (e/edge (:centre here)) to) search-radius) @@ -75,7 +193,9 @@ t (extend-frontier (rest frontier) - (neighbour-ids here traversable? s) + (s/neighbour-ids here traversable? s) visited) - (cons here visited))))))) + (cons here visited) + ;; this is going to be wrong, and I need to think about how to fix. + (cons here track))))))) diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj index 6d41aa7..ee7c8d2 100644 --- a/src/walkmap/superstructure.clj +++ b/src/walkmap/superstructure.clj @@ -29,10 +29,21 @@ (defn vertices "If `o` is an object with vertices, return those vertices, else nil." [o] - (cond - (v/vertex? o) (list o) - (q/polygon? o) (:vertices o) - (p/path? o) (:vertices o))) + (when (map? o) + (reduce + concat + (remove + nil? + (map + #(cond + (v/vertex? %) (list %) + (and (coll? %) (every? v/vertex? %)) %) + (vals o)))))) +;; (cond +;; (v/vertex? o) (list o) +;; (q/polygon? o) (:vertices o) +;; (p/path? o) (:vertices o)) +;; ) (defn index-vertex "Return a superstructure like `s` in which object `o` is indexed by vertex @@ -171,7 +182,12 @@ "Search superstructure `s` for vertices within the box defined by vertices `minv` and `maxv`. Every coordinate in `minv` must have a lower value than the equivalent coordinate in `maxv`. If `d2?` is supplied and not false, - search only in the x,y projection." + search only in the x,y projection. + + **NOTE THAT** this depends on the fact that vertices do not currently + have properties which will be denormalised by `store`, and therefore do not + have to restored with `retrieve`. If properties are added to vertices + whose values are objects, then this will have to be rewritten." ([s minv maxv] (search-vertices s minv maxv false)) ([s minv maxv d2?] @@ -219,6 +235,18 @@ :walkmap.id/id (search-vertices s minv maxv)))))))))))) +(defn touching + "Return a sequence of all objects in superstructure `s` which are + indexed as touching the vertex `v`." + ([vertex s] + (map + #(retrieve % s) + (set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys)))) + ([vertex filter-fn s] + (filter + filter-fn + (touching vertex s)))) + (defn neighbours "Return a sequence of all those objects in superstructure `s` which share at least one vertex with `target`, and which are matched by `filter-fn` @@ -226,8 +254,13 @@ ([target s] (neighbours identity s)) ([target filter-fn s] - ;; TODO: write it. - nil)) + (remove + #(= target %) + (reduce + concat + (remove + nil? + (map #(touching % filter-fn s) (vertices target))))))) (defn neighbour-ids "Return a sequence of the ids all those objects in superstructure `s` which diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj index 5163d24..3848526 100644 --- a/src/walkmap/utils.clj +++ b/src/walkmap/utils.clj @@ -111,3 +111,9 @@ (printf "Couldn't open '%s': %s\n" source (.getMessage e))) (catch RuntimeException e (printf "Error parsing edn file '%s': %s\n" source (.getMessage e))))) + +(defn not-yet-implemented + [message] + (throw + (UnsupportedOperationException. + (str "Not yet implemented: " message))))