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