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 (when (map? o)
033 (reduce
034 concat
035 (remove
036 nil?
037 (map
038 #(cond
039 (v/vertex? %) (list %)
040 (and (coll? %) (every? v/vertex? %)) %)
041 (vals o))))))
042 ;; (cond
043 ;; (v/vertex? o) (list o)
044 ;; (q/polygon? o) (:vertices o)
045 ;; (p/path? o) (:vertices o))
046 ;; )
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))))