#3: Very close to working, but not quite!

This commit is contained in:
Simon Brooke 2020-05-30 09:14:28 +01:00
parent f2c39f9017
commit 7442673cbf
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
13 changed files with 160 additions and 88 deletions

View file

@ -11,7 +11,7 @@
[v1 v2]
(if
(and (vertex? v1) (vertex? v2))
{:kind :edge :id (keyword (gensym "edge")) :start v1 :end v2}
{:kind :edge :walkmap.id/id (keyword (gensym "edge")) :start v1 :end v2}
(throw (IllegalArgumentException. "Must be vertices."))))
(defn edge?

8
src/walkmap/id.clj Normal file
View file

@ -0,0 +1,8 @@
(ns walkmap.id
"The namespace within which the privileged keyword `:walkmap.id/id` is defined.")
(def ^:const id
"The magic id key walkmap uses, to distinguish it from all other uses of
the unprotected keyword."
::id)

View file

@ -19,7 +19,7 @@
(seq? v)
(> (count v) 2)
(every? vertex? v)
(:id o)
(:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :path)))))
(defn path
@ -27,7 +27,7 @@
[& vertices]
(if
(every? vertex? vertices)
{:vertices vertices :id (keyword (gensym "path")) :kind :path}
{:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path}
(throw (IllegalArgumentException.
(str
"Each item on path must be a vertex: "

View file

@ -13,7 +13,7 @@
(coll? v)
(> (count v) 2)
(every? vertex? v)
(:id o)
(:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :polygon)))))

View file

@ -91,13 +91,13 @@
;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
(:facets o) (assoc o
:kind :stl
:id (or (:id o) (keyword (gensym "stl")))
:walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "stl")))
:facets (canonicalise (:facets o) map-kind))
;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
(:vertices o) (centre
(tag
(assoc o
:id (or (:id o) (keyword (gensym "poly")))
:walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "poly")))
:kind :polygon
:vertices (canonicalise (:vertices o) map-kind))
:facet map-kind))

View file

@ -1,6 +1,8 @@
(ns walkmap.superstructure
"single indexing structure for walkmap objects"
(:require [walkmap.path :as p]
(:require [clojure.walk :refer [postwalk]]
[taoensso.timbre :as l]
[walkmap.path :as p]
[walkmap.polygon :as q]
[walkmap.stl :as s]
[walkmap.utils :as u]
@ -22,25 +24,33 @@
;; superstructure - unless we replace the superstructure altogether with a
;; database, which may be the Right Thing To Do.
(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)))
(defn index-vertex
"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 `:id`;
3. `o` does not have a value for the key `:walkmap.id/id`;
4. `v` is not a vertex."
[s o v]
(if-not (v/vertex? o)
(if (:id o)
(if (:walkmap.id/id o)
(if (v/vertex? v)
(let [vi (or (:vertex-index s) {})
current (or (vi (:id v)) {})]
current (or (vi (:walkmap.id/id v)) {})]
;; deep-merge doesn't merge sets, only maps; so at this
;; stage we need to build a map.
(assoc vi (:id v) (assoc current (:id o) (:id v))))
(assoc vi (:walkmap.id/id v) (assoc current (:walkmap.id/id o) (:walkmap.id/id v))))
(throw (IllegalArgumentException. "Not a vertex: " v)))
(throw (IllegalArgumentException. (u/truncate (str "No `:id` value: " o) 80))))
(throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80))))
;; it shouldn't actually be an error to try to index a vertex, but it
;; also isn't useful to do so, so I'd be inclined to ignore it.
(:vertex-index s)))
@ -51,7 +61,7 @@
1. `s` is not a map;
2. `o` is not a map;
3. `o` does not have a value for the key `:id`."
3. `o` does not have a value for the key `:walkmap.id/id`."
[s o]
(assoc
s
@ -60,26 +70,88 @@
u/deep-merge
(map
#(index-vertex s o %)
(u/vertices o)))))
(vertices o)))))
(defn add-to-superstructure
"Return a superstructure like `s` with object `o` added. If `o` is a collection,
return a superstructure like `s` with each element of `o` added. If only one
(defn in-retrieve
"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."
[x s]
(cond
;; if it's a keyword identifying something in s, retrieve that something.
(keyword? x) (if (s x)
(in-retrieve (s x) s)
x)
;; if it's a map, for every key which is not `:walkmap.id/id`, recurse.
(map? x) (reduce
(fn [m k]
(if (= k :walkmap.id/id)
k
(assoc m k (in-retrieve (x k) s))))
{}
(keys x))
(coll? x) (map #(in-retrieve % s) x)
:else x))
(defn retrieve
"Retrieve the canonical representation of the object with this `id` from the
superstructure `s`."
[id s]
(in-retrieve (id s) s))
(defn in-store-find-objects
"Return an id -> object map of every object within `o`. Internal to
`in-store`, q.v. Use at your own peril."
([o]
(in-store-find-objects o {}))
([o s]
(l/debug "Finding objects in:" o)
(cond
(map? o) (if (:walkmap.id/id o)
(assoc
(in-store-find-objects (vals o) s)
(:walkmap.id/id o)
o)
(in-store-find-objects (vals o) s))
(coll? o) (reduce merge s (map #(in-store-find-objects % s) o))
:else s)))
(defn in-store-replace-with-keys
"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."
[o]
(assoc
(postwalk #(or (:walkmap.id/id %) %) (dissoc o :walkmap.id/id))
:walkmap.id/id
(:walkmap.id/id o)))
;; (in-store-replace-with-keys (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3)))
;; (in-store-find-objects (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3)))
(defn store
"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 map, or a sequence of maps."
2. `o` is not a recognisable walkmap object"
([o]
(add-to-superstructure {} o))
([s o]
(cond
(map? o) (let [o' (if (:id o) o (assoc o :id (keyword (gensym "obj"))))]
(index-vertices (assoc s (:id o') o') o'))
(coll? o) (reduce u/deep-merge (map #(add-to-superstructure s %) o))
(nil? o) o
:else
(throw (IllegalArgumentException. (str "Don't know how to index " (or (type o) "nil")))))))
(store {} o))
([o s]
;; (when-not (:walkmap.id/id o)
;; (throw
;; (IllegalArgumentException.
;; (str "Not a walkmap object: no value for `:walkmap.id/id`: "
;; (u/kind-type o)))))
;; (when-not (map? s)
;; (throw
;; (IllegalArgumentException.
;; (str "Superstructure must be a map: " (u/kind-type s)))))
(assoc
(u/deep-merge s (in-store-find-objects o))
(:walkmap.id/id o)
(in-store-replace-with-keys o))))

View file

@ -37,7 +37,7 @@
It's legal to include sequences of keywords in `tags`, so that users can do
useful things like `(tag obj (map keyword some-strings))`."
[object & tags]
(l/debug "Tagging" (or (:kind object) (type object) nil) "with" tags)
(l/debug "Tagging" (kind-type object) "with" tags)
(let [tags' (flatten tags)]
(if
(map? object)

View file

@ -10,14 +10,6 @@
(apply merge-with deep-merge vals)
(last vals)))
;; (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)))
(defn truncate
"If string `s` is more than `n` characters long, return the first `n`
characters; otherwise, return `s`."

View file

@ -42,7 +42,7 @@
[o]
(and
(map? o)
(:id o)
(:walkmap.id/id o)
(number? (:x o))
(number? (:y o))
(or (nil? (:z o)) (number? (:z o)))
@ -57,15 +57,15 @@
(defn vertex
"Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map
with those values, plus a unique `:id` value, and `:kind` set to `:vertex`.
It's not necessary to use this function to create a vertex, but the `:id`
with those values, plus a unique `:walkmap.id/id` value, and `:kind` set to `:vertex`.
It's not necessary to use this function to create a vertex, but the `:walkmap.id/id`
must be present and must be unique."
([x y]
(let [v {:x x :y y :kind :vertex}]
(assoc v :id (vertex-key v))))
(assoc v :walkmap.id/id (vertex-key v))))
([x y z]
(let [v (assoc (vertex x y) :z z)]
(assoc v :id (vertex-key v)))))
(assoc v :walkmap.id/id (vertex-key v)))))
(defn canonicalise
"If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`,
@ -77,7 +77,7 @@
(number? (:x o))
(number? (:y o))
(or (nil? (:z o)) (number? (:z o))))
(assoc o :kind :vertex :id (vertex-key o))
(assoc o :kind :vertex :walkmap.id/id (vertex-key o))
(throw
(IllegalArgumentException.
(truncate