#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] [v1 v2]
(if (if
(and (vertex? v1) (vertex? v2)) (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.")))) (throw (IllegalArgumentException. "Must be vertices."))))
(defn edge? (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) (seq? v)
(> (count v) 2) (> (count v) 2)
(every? vertex? v) (every? vertex? v)
(:id o) (:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :path))))) (or (nil? (:kind o)) (= (:kind o) :path)))))
(defn path (defn path
@ -27,7 +27,7 @@
[& vertices] [& vertices]
(if (if
(every? vertex? vertices) (every? vertex? vertices)
{:vertices vertices :id (keyword (gensym "path")) :kind :path} {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path}
(throw (IllegalArgumentException. (throw (IllegalArgumentException.
(str (str
"Each item on path must be a vertex: " "Each item on path must be a vertex: "

View file

@ -13,7 +13,7 @@
(coll? v) (coll? v)
(> (count v) 2) (> (count v) 2)
(every? vertex? v) (every? vertex? v)
(:id o) (:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :polygon))))) (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?` ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
(:facets o) (assoc o (:facets o) (assoc o
:kind :stl :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)) :facets (canonicalise (:facets o) map-kind))
;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?` ;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
(:vertices o) (centre (:vertices o) (centre
(tag (tag
(assoc o (assoc o
:id (or (:id o) (keyword (gensym "poly"))) :walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "poly")))
:kind :polygon :kind :polygon
:vertices (canonicalise (:vertices o) map-kind)) :vertices (canonicalise (:vertices o) map-kind))
:facet map-kind)) :facet map-kind))

View file

@ -1,6 +1,8 @@
(ns walkmap.superstructure (ns walkmap.superstructure
"single indexing structure for walkmap objects" "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.polygon :as q]
[walkmap.stl :as s] [walkmap.stl :as s]
[walkmap.utils :as u] [walkmap.utils :as u]
@ -22,25 +24,33 @@
;; superstructure - unless we replace the superstructure altogether with a ;; superstructure - unless we replace the superstructure altogether with a
;; database, which may be the Right Thing To Do. ;; 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 (defn index-vertex
"Return a superstructure like `s` in which object `o` is indexed by 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 `v`. It is an error (and an exception may be thrown) if
1. `s` is not a map; 1. `s` is not a map;
2. `o` 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." 4. `v` is not a vertex."
[s o v] [s o v]
(if-not (v/vertex? o) (if-not (v/vertex? o)
(if (:id o) (if (:walkmap.id/id o)
(if (v/vertex? v) (if (v/vertex? v)
(let [vi (or (:vertex-index s) {}) (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 ;; deep-merge doesn't merge sets, only maps; so at this
;; stage we need to build a map. ;; 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. "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 ;; 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. ;; also isn't useful to do so, so I'd be inclined to ignore it.
(:vertex-index s))) (:vertex-index s)))
@ -51,7 +61,7 @@
1. `s` is not a map; 1. `s` is not a map;
2. `o` 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] [s o]
(assoc (assoc
s s
@ -60,26 +70,88 @@
u/deep-merge u/deep-merge
(map (map
#(index-vertex s o %) #(index-vertex s o %)
(u/vertices o))))) (vertices o)))))
(defn add-to-superstructure (defn in-retrieve
"Return a superstructure like `s` with object `o` added. If `o` is a collection, "Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a
return a superstructure like `s` with each element of `o` added. If only one 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 argument is supplied it will be assumed to represent `o` and a new
superstructure will be returned. superstructure will be returned.
It is an error (and an exception may be thrown) if It is an error (and an exception may be thrown) if
1. `s` is not a map; 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] ([o]
(add-to-superstructure {} o)) (store {} o))
([s o] ([o s]
(cond ;; (when-not (:walkmap.id/id o)
(map? o) (let [o' (if (:id o) o (assoc o :id (keyword (gensym "obj"))))] ;; (throw
(index-vertices (assoc s (:id o') o') o')) ;; (IllegalArgumentException.
(coll? o) (reduce u/deep-merge (map #(add-to-superstructure s %) o)) ;; (str "Not a walkmap object: no value for `:walkmap.id/id`: "
(nil? o) o ;; (u/kind-type o)))))
:else ;; (when-not (map? s)
(throw (IllegalArgumentException. (str "Don't know how to index " (or (type o) "nil"))))))) ;; (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 It's legal to include sequences of keywords in `tags`, so that users can do
useful things like `(tag obj (map keyword some-strings))`." useful things like `(tag obj (map keyword some-strings))`."
[object & tags] [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)] (let [tags' (flatten tags)]
(if (if
(map? object) (map? object)

View file

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

View file

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

View file

@ -8,32 +8,32 @@
(testing "identification of edges." (testing "identification of edges."
(is (edge? {:start (vertex 0.0 0.0 0.0) (is (edge? {:start (vertex 0.0 0.0 0.0)
:end (vertex 3 4 0.0)}) "It is.") :end (vertex 3 4 0.0)}) "It is.")
(is (not (edge? {:start {:y 0.0 :z 0.0 :id 'foo} (is (not (edge? {:start {:y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Start lacks :x key") :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Start lacks :x key")
(is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :id 'foo} (is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Start lacks :x value") :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Start lacks :x value")
(is (not (edge? {:begin {:x nil :y 0.0 :z 0.0 :id 'foo} (is (not (edge? {:begin {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Lacks start key") :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Lacks start key")
(is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :id 'foo} (is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:finish {:x 3 :y 4 :z 0.0 :id 'bar}})) "Lacks end key") :finish {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Lacks end key")
(is (not (edge? {:start {:x "zero" :y 0.0 :z 0.0 :id 'foo} (is (not (edge? {:start {:x "zero" :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Value of x in start is not a number") :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Value of x in start is not a number")
(is (false? (edge? "I am not an edge")) "Edge mustbe a map."))) (is (false? (edge? "I am not an edge")) "Edge mustbe a map.")))
(deftest collinear-test (deftest collinear-test
(testing "collinearity" (testing "collinearity"
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :id 'bar}} (is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 3.0 :y 4.0 :z 0.0 :id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :id 'bar}}) {:start {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Should be") "Should be")
(is (not (is (not
(collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3 :y 4 :z 0.0 :id 'bar}} (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :id 'bar}})) {:start {:x 1.0 :y 2.0 :z 3.5 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}}))
"Should not be!") "Should not be!")
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :id 'bar}} (is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :id 'bar}}) {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Edge case: same start location") "Edge case: same start location")
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :id 'bar}} (is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 3.0 :y 4.0 :z 0.0 :id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :id 'bar}}) {:start {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Edge case: same end location") "Edge case: same end location")
)) ))
@ -89,7 +89,7 @@
(deftest length-test (deftest length-test
(testing "length of an edge" (testing "length of an edge"
(is (= (length {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :id 'bar}}) 5.0)))) (is (= (length {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}) 5.0))))
(deftest minimad-test (deftest minimad-test
(testing "finding minimum and maximum coordinates of edges." (testing "finding minimum and maximum coordinates of edges."
@ -98,12 +98,12 @@
(deftest parallel-test (deftest parallel-test
(testing "parallelism" (testing "parallelism"
(is (parallel? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3 :y 4 :z 0.0 :id 'bar}} (is (parallel? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :id 'bar}}) {:start {:x 1.0 :y 2.0 :z 3.5 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}})
"Should be") "Should be")
(is (not (is (not
(parallel? {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3 :y 4 :z 0.0 :id 'bar}} (parallel? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.49 :id 'bar}})) {:start {:x 1.0 :y 2.0 :z 3.5 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.49 :walkmap.id/id 'bar}}))
"Should not be!"))) "Should not be!")))
(deftest overlaps2d-test (deftest overlaps2d-test
@ -114,8 +114,8 @@
(deftest unit-vector-test (deftest unit-vector-test
(testing "deriving the unit vector" (testing "deriving the unit vector"
(is (= (is (=
(unit-vector {:start {:x 0.0 :y 0.0 :z 0.0 :id 'foo} :end {:x 3 :y 4 :z 0.0 :id 'bar}}) (unit-vector {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})
{:x 0.6, :y 0.8, :z 0.0})) {:x 0.6, :y 0.8, :z 0.0}))
(is (= (is (=
(unit-vector {:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :id 'bar}}) (unit-vector {:start {:x 1.0 :y 2.0 :z 3.5 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}})
{:x 0.6, :y 0.8, :z 0.0})))) {:x 0.6, :y 0.8, :z 0.0}))))

View file

@ -11,4 +11,4 @@
(is (=ish 0 0.0) "Tricky conrer case!") (is (=ish 0 0.0) "Tricky conrer case!")
(is (=ish :foo :foo) "Fails over to plain old equals for non-numbers.") (is (=ish :foo :foo) "Fails over to plain old equals for non-numbers.")
(is (=ish 6 5 10000) "If tolerance is wide enough, anything can be equal.") (is (=ish 6 5 10000) "If tolerance is wide enough, anything can be equal.")
(is (=ish "hello" "goodbye" 10000) "Well, except non-numbers, of course."))) (is (not (=ish "hello" "goodbye" 10000)) "Well, except non-numbers, of course.")))

View file

@ -7,7 +7,7 @@
(deftest canonicalise-test (deftest canonicalise-test
(testing "Canonicalisation of objects read from STL: vertices." (testing "Canonicalisation of objects read from STL: vertices."
(is (vertex? (canonicalise {:x 3.0, :y 1.0, :z 1.0})) (is (vertex? (canonicalise {:x 3.0, :y 1.0, :z 1.0}))
"Vertex: should have an `:id` and `:kind` = `:vertex`.") "Vertex: should have an `:walkmap.id/id` and `:kind` = `:vertex`.")
(is (= (:x (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 3.0) (is (= (:x (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 3.0)
"`:x` value should be unchanged.") "`:x` value should be unchanged.")
(is (= (:y (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0) (is (= (:y (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0)
@ -28,7 +28,7 @@
:abc 0} :abc 0}
p' (canonicalise p)] p' (canonicalise p)]
(is (polygon? p') (is (polygon? p')
"Polygon: should have an `:id` and `:kind` = `:polygon`.") "Polygon: should have an `:walkmap.id/id` and `:kind` = `:polygon`.")
(is (= (count (:vertices p)) (count (:vertices p'))) (is (= (count (:vertices p)) (count (:vertices p')))
"Number of vertices should not change") "Number of vertices should not change")
(map (map
@ -93,4 +93,4 @@
{:x 51.0, :y 20.0, :z 1.0}], {:x 51.0, :y 20.0, :z 1.0}],
:abc 0}]} :abc 0}]}
stl' (canonicalise stl)] stl' (canonicalise stl)]
(is (stl? stl') "Stl: should have an `:id` and `:kind` = `:stl`.")))) (is (stl? stl') "Stl: should have an `:walkmap.id/id` and `:kind` = `:stl`."))))

View file

@ -4,32 +4,32 @@
(deftest tag-tests (deftest tag-tests
(testing "Tagging" (testing "Tagging"
(is (set? (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz))) (is (set? (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz)))
"The value of `:walkmap.tag/tags` should be a set.") "The value of `:walkmap.tag/tags` should be a set.")
(is (= (count (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz))) 4) (is (= (count (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz))) 4)
"All the tags passed should be added.") "All the tags passed should be added.")
(is (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz) :ban) (is (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz) :ban)
"`:ban` should be present in the set, and, as it is a set, it "`:ban` should be present in the set, and, as it is a set, it
should be valid to apply it to a keyword.") should be valid to apply it to a keyword.")
(is (not ((:walkmap.tag/tags (tag {} :foo :bar :ban :froboz)) :cornflakes)) (is (not ((:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz)) :cornflakes))
"`:cornflakes should not be present.") "`:cornflakes should not be present.")
(is (true? (tagged? (tag {} :foo :bar :ban :froboz) :bar)) (is (true? (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar))
"`tagged?` should return an explicit `true`, not any other value.") "`tagged?` should return an explicit `true`, not any other value.")
(is (tagged? (tag {} :foo :bar :ban :froboz) :bar :froboz) (is (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar :froboz)
"We should be able to test for the presence of more than one tag") "We should be able to test for the presence of more than one tag")
(is (false? (tagged? {} :foo)) (is (false? (tagged? {:kind :test-obj} :foo))
"A missing `:walkmap.tag/tags` should not cause an error.") "A missing `:walkmap.tag/tags` should not cause an error.")
(is (= (tagged? (tag {} :foo :bar :ban :froboz) :bar :cornflakes) false) (is (= (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar :cornflakes) false)
"If any of the queried tags is missing, false should be returned") "If any of the queried tags is missing, false should be returned")
(is (tagged? (tag (tag {} :foo) :bar) :foo :bar) (is (tagged? (tag (tag {:kind :test-obj} :foo) :bar) :foo :bar)
"We should be able to add tags to an already tagged object") "We should be able to add tags to an already tagged object")
(is (false? (tagged? (tag {} :foo :bar) :cornflakes)) (is (false? (tagged? (tag {:kind :test-obj} :foo :bar) :cornflakes))
"`tagged?` should return an explicit `false` if a queried tag is missing.") "`tagged?` should return an explicit `false` if a queried tag is missing.")
(is (= (tags (tag {} :foo)) #{:foo}) (is (= (tags (tag {:kind :test-obj} :foo)) #{:foo})
"`tags` should return the tags on the object, if any.") "`tags` should return the tags on the object, if any.")
(is (every? nil? (map #(tags %) [1 :one "one" [:one] {:one 1}])) (is (every? nil? (map #(tags %) [1 :one "one" [:one] {:one 1}]))
"Things which don't have tags don't have tags, and that's not a problem.") "Things which don't have tags don't have tags, and that's not a problem.")
(let [object (tag {} :foo :bar :ban :froboz)] (let [object (tag {:kind :test-obj} :foo :bar :ban :froboz)]
(is (= (untag object :cornflakes) object) (is (= (untag object :cornflakes) object)
"Removing a missing tag should have no effect.") "Removing a missing tag should have no effect.")
(is (tagged? (untag object :foo) :bar :ban :froboz) (is (tagged? (untag object :foo) :bar :ban :froboz)
@ -42,13 +42,13 @@
"An exception should be thrown if `object` is not a map: `tagged?`.") "An exception should be thrown if `object` is not a map: `tagged?`.")
(is (thrown? IllegalArgumentException (untag [] :foo)) (is (thrown? IllegalArgumentException (untag [] :foo))
"An exception should be thrown if `object` is not a map: `untag`.") "An exception should be thrown if `object` is not a map: `untag`.")
(is (thrown? IllegalArgumentException (tag {} :foo "bar" :ban)) (is (thrown? IllegalArgumentException (tag {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keyword: `tag`.") "An exception should be thrown if any of `tags` is not a keyword: `tag`.")
(is (thrown? IllegalArgumentException (tagged? {} :foo "bar" :ban)) (is (thrown? IllegalArgumentException (tagged? {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keyword: `tagged?`.") "An exception should be thrown if any of `tags` is not a keyword: `tagged?`.")
(is (thrown? IllegalArgumentException (untag {} :foo "bar" :ban)) (is (thrown? IllegalArgumentException (untag {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keywordp: `untag`.") "An exception should be thrown if any of `tags` is not a keywordp: `untag`.")
(let [o (tag {} :foo '(:bar :ban) :froboz)] (let [o (tag {:kind :test-obj} :foo '(:bar :ban) :froboz)]
(is (tagged? o :ban :bar :foo :froboz) (is (tagged? o :ban :bar :foo :froboz)
"It's now allowed to include lists of tags in the arg list for `tag`.")))) "It's now allowed to include lists of tags in the arg list for `tag`."))))