# walkmap/superstructure.clj

001 (ns walkmap.superstructure
002 "single indexing structure for walkmap objects"
003 (:require [clojure.walk :refer [postwalk]]
004 [taoensso.timbre :as l]
005 [walkmap.edge :refer [edge length]]
006 [walkmap.path :as p]
007 [walkmap.polygon :as q]
008 [walkmap.utils :as u]
009 [walkmap.vertex :as v]))
010
011 ;; TODO: Think about reification/dereification. How can we cull a polygon, if
012 ;; some vertices still index it? I *think* that what's needed is that when
013 ;; we store something in the superstructure, we replace all its vertices (and
014 ;; other dependent structures, if any with their ids - as well as, obviously,
015 ;; adding/merging those vertices/dependent structures into the superstructure
016 ;; as first class objects in themselves. That means, for each identified thing,
017 ;; the superstructure only contains one copy of it.
018 ;;
019 ;; The question then is, when we want to do things with those objects, do we
020 ;; exteract a copy with its dependent structures fixed back up (reification),
021 ;; or do we indirect through the superstructure every time we want to access
022 ;; them? In a sense, the copy in the superstructure is the 'one true copy',
023 ;; but it may become very difficult then to have one true copy of the
024 ;; superstructure - unless we replace the superstructure altogether with a
025 ;; database, which may be the Right Thing To Do.
026
027 (def vertex-index ::vertex-index)
028
029 (defn vertices
030 "If `o` is an object with vertices, return those vertices, else nil."
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))
196 maxv (v/vertex
197 (+ (:x target) 0.5) (+ (:y target) 0.5)
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
203 (sort-by
204 #(length (edge target (:centre %)))
205 (filter
206 :centre
207 (map #(retrieve % s)
208 ;; for each vertex id in vids, get the objects associated with that id
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)
216 ;; get all the vertex ids within radius of the target
217 (set
218 (map
219 :walkmap.id/id
220 (search-vertices s minv maxv))))))))))))
221