diff --git a/project.clj b/project.clj
index 48b6db4..348e8ed 100644
--- a/project.clj
+++ b/project.clj
@@ -5,6 +5,7 @@
:output-path "docs/codox"
:source-uri "https://github.com/simon-brooke/walkmap/blob/master/{filepath}#L{line}"}
:dependencies [[org.clojure/clojure "1.8.0"]
+ [org.clojure/data.zip "1.0.0"]
[org.clojure/math.numeric-tower "0.0.4"]
[org.clojure/math.combinatorics "0.1.6"]
[com.taoensso/timbre "4.10.0"]
diff --git a/src/walkmap/edge.clj b/src/walkmap/edge.clj
index df83a5d..a91df9c 100644
--- a/src/walkmap/edge.clj
+++ b/src/walkmap/edge.clj
@@ -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?
diff --git a/src/walkmap/id.clj b/src/walkmap/id.clj
new file mode 100644
index 0000000..3dfc71b
--- /dev/null
+++ b/src/walkmap/id.clj
@@ -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)
+
diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj
index 5ea5a5e..b4ca67a 100644
--- a/src/walkmap/path.clj
+++ b/src/walkmap/path.clj
@@ -2,8 +2,10 @@
"Essentially the specification for things we shall consider to be path.
**Note that** for these purposes `path` means any continuous linear
feature, where such features specifically include watercourses."
- (:require [walkmap.edge :as e]
+ (:require [clojure.string :as s]
+ [walkmap.edge :as e]
[walkmap.polygon :refer [polygon?]]
+ [walkmap.utils :refer [kind-type]]
[walkmap.vertex :refer [vertex?]]))
(defn path?
@@ -17,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
@@ -25,8 +27,11 @@
[& vertices]
(if
(every? vertex? vertices)
- {:vertices vertices :id (keyword (gensym "path")) :kind :path}
- (throw (IllegalArgumentException. "Each item on path must be a vertex."))))
+ {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path}
+ (throw (IllegalArgumentException.
+ (str
+ "Each item on path must be a vertex: "
+ (s/join " " (map kind-type vertices)))))))
(defn polygon->path
"If `o` is a polygon, return an equivalent path. What's different about
diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj
index dc92c7e..36357ab 100644
--- a/src/walkmap/polygon.clj
+++ b/src/walkmap/polygon.clj
@@ -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)))))
diff --git a/src/walkmap/read_svg.clj b/src/walkmap/read_svg.clj
new file mode 100644
index 0000000..b86f205
--- /dev/null
+++ b/src/walkmap/read_svg.clj
@@ -0,0 +1,98 @@
+(ns walkmap.read-svg
+ "Utility functions for scalable vector graphics (SVG) into walkmap
+ structures."
+ (:require [clojure.data.zip :as dz]
+ [clojure.data.zip.xml :as zx]
+ [clojure.java.io :as io]
+ [clojure.string :as s]
+ [clojure.xml :as x]
+ [clojure.zip :as z]
+ [taoensso.timbre :as l]
+ [walkmap.path :refer [path]]
+;; [walkmap.polygon :refer [polygon]]
+ [walkmap.tag :refer [tag]]
+ [walkmap.utils :refer [kind-type truncate]]
+ [walkmap.vertex :refer [vertex vertex?]]))
+
+(defn upper-case?
+ [s]
+ (every? #(Character/isUpperCase %) s))
+
+(defn match->vertex
+ [match-vector x y]
+ (when-not (empty? match-vector)
+ (let [command (nth match-vector 1)
+ xcoord (read-string (nth match-vector 2))
+ ycoord (read-string (nth match-vector 3))
+ ;; upper case command letters mean the coordinates that follow are
+ ;; absolute; lower case, relative.
+ x' (if (upper-case? command) xcoord (+ x xcoord))
+ y' (if (upper-case? command) ycoord (+ y ycoord))]
+ (case (s/lower-case command)
+ ("m" "l") {:vertex (vertex x' y') :x x' :y y'}
+ nil))))
+
+(defn command-string->vertices
+ "Return the destination of each successive line (`l`, `L`) and move (`m`, `M`)
+ command in this string `s`, expected to be an SVG path command string."
+ [s]
+ (let [cmd-matcher ;; matches a 'command' in the string: a letter followed by
+ ;;spaces and numbers
+ (re-matcher #"[a-zA-Z][^a-zA-Z]*" s)
+ seg-pattern ;; matches a command which initiates a move of the current
+ ;; position.
+ #"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +"]
+ (loop [match (re-find cmd-matcher)
+ result []
+ x 0
+ y 0]
+ (if-not match
+ (filter vertex? result)
+ (let [m (match->vertex (re-find seg-pattern match) x y)]
+ (recur (re-find cmd-matcher) ;loop with 2 new arguments
+ (conj result (:vertex m))
+ (or (:x m) x)
+ (or (:y m) y)))))))
+
+(defn path-elt->path
+ "Given the SVG path element `elt`, return a walkmap path structure
+ representing the line (`l`, `L`) and move (`m`, `M`) commands in
+ that path."
+ [elt]
+ (if (= (-> elt :tag) :path)
+ (let [vs (command-string->vertices (-> elt :attrs :d))
+ p (when-not (empty? vs) (apply path vs))]
+ (if (and p (-> elt :attrs :class))
+ (tag p (map keyword (s/split (-> elt :attrs :class) #" ")))
+ p))
+ (throw (IllegalArgumentException.
+ (str "Must be an SVG `path` element: " elt)))))
+
+(defn progeny
+ "Return all the nodes in the XML structure below this `elt` which match
+ this `predicate`."
+ ;; the name `descendants` is bound in `clojure.core` for something quite
+ ;; different, and I chose not to rebind it.
+ [elt predicate]
+ (if
+ (apply predicate (list elt))
+ (list elt)
+ (reduce
+ concat
+ (remove
+ empty?
+ (map
+ #(progeny % predicate)
+ (:content elt))))))
+
+(defn read-svg
+ ;; I tried to get this working with all the clever zip stuff in
+ ;; `clojure.zip`, `clojure.data.zip`, and so on. It would probably have
+ ;; been more elegant, but it kept crashing out of heap space on even
+ ;; quite small XML files. So I've implemented my own solution.
+ ([file-name]
+ (read-svg file-name nil))
+ ([file-name map-kind]
+ (let [xml (x/parse (io/file file-name))
+ paths (progeny xml #(= (:tag %) :path))]
+ (remove nil? (map path-elt->path paths)))))
diff --git a/src/walkmap/stl.clj b/src/walkmap/stl.clj
index 89e6c9e..16aaf95 100644
--- a/src/walkmap/stl.clj
+++ b/src/walkmap/stl.clj
@@ -8,6 +8,7 @@
[walkmap.edge :as e]
[walkmap.polygon :refer [polygon?]]
[walkmap.tag :refer [tag]]
+ [walkmap.utils :as u]
[walkmap.vertex :as v])
(:import org.clojars.smee.binary.core.BinaryIO
java.io.DataInput))
@@ -84,19 +85,19 @@
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
- (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
+ (u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
(cond
(and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
;; 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))
@@ -120,7 +121,7 @@
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
- (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
+ (u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
(let [in (io/input-stream filename)]
(canonicalise (b/decode binary-stl in) map-kind))))
diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj
index abd0375..7593bcc 100644
--- a/src/walkmap/superstructure.clj
+++ b/src/walkmap/superstructure.clj
@@ -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,28 +24,38 @@
;; superstructure - unless we replace the superstructure altogether with a
;; database, which may be the Right Thing To Do.
+(def vertex-index ::vertex-index)
+
+(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)) {})]
+ (let [vi (or (::vertex-index s) {})
+ 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. (subs (str "No `:id` value: " o) 0 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)))
+ (::vertex-index s)))
(defn index-vertices
"Return a superstructure like `s` in which object `o` is indexed by its
@@ -51,35 +63,106 @@
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
+ (u/deep-merge
s
- :vertex-index
- (reduce
- u/deep-merge
- (map
- #(index-vertex s o %)
- (u/vertices o)))))
+ {::vertex-index
+ (reduce
+ u/deep-merge
+ {}
+ (map
+ #(index-vertex s 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) (let [v (reduce
+ (fn [m k]
+ (assoc m k (in-retrieve (x k) s)))
+ {}
+ (keys (dissoc x :walkmap.id/id)))
+ id (:walkmap.id/id x)]
+ ;; if it has an id, bind it to that id in the returned value.
+ (if id
+ (assoc
+ v
+ :walkmap.id/id
+ (:walkmap.id/id x))
+ v))
+ (set? x) x ;; TODO: should I search in sets for objects when storing?
+ (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
+ (set? o) s ;; TODO: should I search in sets for objects when storing?
+ (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) (index-vertices s o))
+ (:walkmap.id/id o)
+ (in-store-replace-with-keys o))))
diff --git a/src/walkmap/svg.clj b/src/walkmap/svg.clj
index 3649e55..bbb9d9f 100644
--- a/src/walkmap/svg.clj
+++ b/src/walkmap/svg.clj
@@ -2,7 +2,9 @@
"Utility functions for writing stereolithography (STL) files (and possibly,
later, other geometry files of interest to us) as scalable vector graphics
(SVG)."
- (:require [clojure.string :as s]
+ (:require [clojure.java.io :as io]
+ [clojure.string :as s]
+ [clojure.xml :as x]
[dali.io :as neatly-folded-clock]
[hiccup.core :refer [html]]
[taoensso.timbre :as l :refer [info error spy]]
@@ -106,3 +108,9 @@
:hiccup (spit out-filename (html s))
(throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))
s)))
+
+
+(defn read-svg
+ ([file-name]
+ (read-svg file-name nil))
+ ([file-name map-kind]
diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj
index 72b4977..d0a9c42 100644
--- a/src/walkmap/tag.clj
+++ b/src/walkmap/tag.clj
@@ -2,7 +2,9 @@
"Code for tagging, untagging, and finding tags on objects. Note the use of
the namespaced keyword, `:walkmap.tag/tags`, denoted in this file `::tags`.
This is in an attempt to avoid name clashes with other uses of this key."
- (:require [clojure.set :refer [difference union]]))
+ (:require [clojure.set :refer [difference union]]
+ [taoensso.timbre :as l]
+ [walkmap.utils :refer [kind-type]]))
(defn tagged?
"True if this `object` is tagged with each of these `tags`. It is an error
@@ -20,9 +22,9 @@
(set? ot)
(every? ot tags)))
(throw (IllegalArgumentException.
- (str "Must be keyword(s): " (map type tags)))))
+ (str "Must be keyword(s): " (map kind-type tags)))))
(throw (IllegalArgumentException.
- (str "Must be a map: " (type object))))))
+ (str "Must be a map: " (kind-type object))))))
(defn tag
"Return an object like this `object` but with these `tags` added to its tags,
@@ -30,17 +32,22 @@
thrown) if
1. `object` is not a map;
- 2. any of `tags` is not a keyword."
+ 2. any of `tags` is not a keyword or sequence of keywords.
+
+ 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]
- (if
- (map? object)
+ (l/debug "Tagging" (kind-type object) "with" tags)
+ (let [tags' (flatten tags)]
(if
- (every? keyword? tags)
- (assoc object ::tags (union (set tags) (::tags object)))
+ (map? object)
+ (if
+ (every? keyword? tags')
+ (assoc object ::tags (union (set tags') (::tags object)))
+ (throw (IllegalArgumentException.
+ (str "Must be keyword(s): " (map kind-type tags')))))
(throw (IllegalArgumentException.
- (str "Must be keyword(s): " (map type tags)))))
- (throw (IllegalArgumentException.
- (str "Must be a map: " (type object))))))
+ (str "Must be a map: " (kind-type object)))))))
(defmacro tags
"Return the tags of this object, if any."
@@ -60,6 +67,6 @@
(every? keyword? tags)
(assoc object ::tags (difference (::tags object) (set tags)))
(throw (IllegalArgumentException.
- (str "Must be keywords: " (map type tags)))))
+ (str "Must be keywords: " (map kind-type tags)))))
(throw (IllegalArgumentException.
- (str "Must be a map: " (type object))))))
+ (str "Must be a map: " (kind-type object))))))
diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj
index 95f26f6..8fa7197 100644
--- a/src/walkmap/utils.clj
+++ b/src/walkmap/utils.clj
@@ -1,23 +1,29 @@
(ns walkmap.utils
"Miscellaneous utility functions."
- (:require [clojure.math.numeric-tower :as m]
- [walkmap.path :as p]
- [walkmap.polygon :as q]
- [walkmap.vertex :as v]))
+ (:require [clojure.math.numeric-tower :as m]))
(defn deep-merge
"Recursively merges maps. If vals are not maps, the last value wins."
;; TODO: not my implementation, not sure I entirely trust it.
+ ;; TODO TODO: if we are to successfully merge walkmap objects, we must
+ ;; return, on each object, the union of its tags if any.
[& vals]
(if (every? map? vals)
(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`."
+ [s n]
+ (if (and (string? s) (number? n) (> (count s) n))
+ (subs s 0 n)
+ s))
+(defn kind-type
+ "Identify the type of an `object`, e.g. for logging. If it has a `:kind` key,
+ it's one of ours, and that's what we want. Otherwise, we want its type; but
+ the type of `nil` is `nil`, which doesn't get printed when assembling error
+ ,essages, so return \"nil\"."
+ [object]
+ (or (:kind object) (type object) "nil"))
diff --git a/src/walkmap/vertex.clj b/src/walkmap/vertex.clj
index 6c92f11..da0d1fa 100644
--- a/src/walkmap/vertex.clj
+++ b/src/walkmap/vertex.clj
@@ -5,7 +5,8 @@
two vertices, create an edge from them and use `walkmap.edge/length`."
(:require [clojure.math.numeric-tower :as m]
[clojure.string :as s]
- [walkmap.geometry :refer [=ish]]))
+ [walkmap.geometry :refer [=ish]]
+ [walkmap.utils :refer [truncate]]))
(defn vertex-key
"Making sure we get the same key everytime we key a vertex with the same
@@ -25,7 +26,7 @@
(str "vert_" (:x o) "_" (:y o))
:else
(throw (IllegalArgumentException.
- (subs (str "Not a vertex: " (or o "nil")) 0 80))))
+ (truncate (str "Not a vertex: " (or o "nil")) 80))))
"."
"-")))
@@ -41,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)))
@@ -56,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`,
@@ -76,13 +77,13 @@
(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.
- (subs
+ (truncate
(str "Not a proto-vertex: must have numeric `:x` and `:y`: "
(or o "nil"))
- 0 80)))))
+ 80)))))
(def ensure3d
"Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise
@@ -98,7 +99,7 @@
(cond
(not (vertex? o)) (throw
(IllegalArgumentException.
- (subs (str "Not a vertex: " (or o "nil")) 0 80)))
+ (truncate (str "Not a vertex: " (or o "nil")) 80)))
(:z o) o
:else (assoc o :z dflt))))))
@@ -111,4 +112,4 @@
(assoc o :z 0.0)
(throw
(IllegalArgumentException.
- (subs (str "Not a vertex: " (or o "nil")) 0 80)))))))
+ (truncate (str "Not a vertex: " (or o "nil")) 80)))))))
diff --git a/test/walkmap/edge_test.clj b/test/walkmap/edge_test.clj
index 22b9222..95a0cda 100644
--- a/test/walkmap/edge_test.clj
+++ b/test/walkmap/edge_test.clj
@@ -8,32 +8,32 @@
(testing "identification of edges."
(is (edge? {:start (vertex 0.0 0.0 0.0)
:end (vertex 3 4 0.0)}) "It is.")
- (is (not (edge? {:start {:y 0.0 :z 0.0 :id 'foo}
- :end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Start lacks :x key")
- (is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :id 'foo}
- :end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Start lacks :x value")
- (is (not (edge? {:begin {:x nil :y 0.0 :z 0.0 :id 'foo}
- :end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Lacks start key")
- (is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :id 'foo}
- :finish {:x 3 :y 4 :z 0.0 :id 'bar}})) "Lacks end key")
- (is (not (edge? {:start {:x "zero" :y 0.0 :z 0.0 :id 'foo}
- :end {:x 3 :y 4 :z 0.0 :id 'bar}})) "Value of x in start is not a number")
+ (is (not (edge? {:start {:y 0.0 :z 0.0 :walkmap.id/id 'foo}
+ :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 :walkmap.id/id 'foo}
+ :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 :walkmap.id/id 'foo}
+ :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 :walkmap.id/id 'foo}
+ :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 :walkmap.id/id 'foo}
+ :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.")))
(deftest collinear-test
(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}}
- {:start {:x 3.0 :y 4.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 3.0 :y 4.0 :z 0.0 :walkmap.id/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")
(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}}
- {:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :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 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}}))
"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}}
- {: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 3.0 :y 4.0 :z 0.0 :walkmap.id/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")
- (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}}
- {:start {:x 3.0 :y 4.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 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Edge case: same end location")
))
@@ -89,7 +89,7 @@
(deftest length-test
(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
(testing "finding minimum and maximum coordinates of edges."
@@ -98,12 +98,12 @@
(deftest parallel-test
(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}}
- {:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :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 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}})
"Should be")
(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}}
- {:start {:x 1.0 :y 2.0 :z 3.5 :id 'foo} :end {:x 4.0 :y 6.0 :z 3.49 :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 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.49 :walkmap.id/id 'bar}}))
"Should not be!")))
(deftest overlaps2d-test
@@ -114,8 +114,8 @@
(deftest unit-vector-test
(testing "deriving the unit vector"
(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}))
(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}))))
diff --git a/test/walkmap/geometry_test.clj b/test/walkmap/geometry_test.clj
index eb946fb..9c7bc4d 100644
--- a/test/walkmap/geometry_test.clj
+++ b/test/walkmap/geometry_test.clj
@@ -11,4 +11,4 @@
(is (=ish 0 0.0) "Tricky conrer case!")
(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 "hello" "goodbye" 10000) "Well, except non-numbers, of course.")))
+ (is (not (=ish "hello" "goodbye" 10000)) "Well, except non-numbers, of course.")))
diff --git a/test/walkmap/stl_test.clj b/test/walkmap/stl_test.clj
index 4f6a105..1665890 100644
--- a/test/walkmap/stl_test.clj
+++ b/test/walkmap/stl_test.clj
@@ -7,7 +7,7 @@
(deftest canonicalise-test
(testing "Canonicalisation of objects read from STL: vertices."
(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)
"`:x` value should be unchanged.")
(is (= (:y (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0)
@@ -28,7 +28,7 @@
:abc 0}
p' (canonicalise 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')))
"Number of vertices should not change")
(map
@@ -93,4 +93,4 @@
{:x 51.0, :y 20.0, :z 1.0}],
:abc 0}]}
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`."))))
diff --git a/test/walkmap/superstructure_test.clj b/test/walkmap/superstructure_test.clj
new file mode 100644
index 0000000..9904a2e
--- /dev/null
+++ b/test/walkmap/superstructure_test.clj
@@ -0,0 +1,135 @@
+(ns walkmap.superstructure-test
+ (:require [clojure.set :refer [subset?]]
+ [clojure.test :refer :all]
+ [walkmap.path :as p]
+ [walkmap.polygon :as q]
+ [walkmap.superstructure :refer :all]
+ [walkmap.tag :as t]
+ [walkmap.utils :as u]
+ [walkmap.vertex :as v]))
+
+(deftest store-test
+ (testing "Object storage"
+ (let [p (p/path
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand)))
+ id (:walkmap.id/id p)
+ s (store p)
+ r (id s)]
+ (is (= (:walkmap.id/id r) id)
+ "A representation should be stored in `s` keyed by `id`, and the id of that representation should be `id`.")
+ (is (= (:kind r) (:kind p))
+ "The representation should have the same value for `:kind`.")
+ (is (= (count (:vertices p)) (count (:vertices r)))
+ "The representation of `p` in `s` should have the same number of vertices as `p`.")
+ (is (every? v/vertex? (:vertices p))
+ "Every vertex of `p` should be a vertex.")
+ (is (every? keyword? (:vertices r))
+ "Every vertex of the representation of `p` in `s` should be a keyword.")
+ (is (every? v/vertex? (map #(s %) (:vertices r)))
+ "The value in `s` of every vertex of the representation of `p` in `s`
+ should be a vertex.")
+ (is (subset? (set (:vertices r)) (set (keys (vertex-index s))))
+ "All the keys which are vertices of the representation of `p` in `s`
+ should be present as keys in the vertex-index of `s`.")
+ (is (every?
+ #(s (% id))
+ (map #(set (keys (% (vertex-index s)))) (:vertices r)))
+ "The value in the vertex-index in `s` for each keyword in the
+ vertexes of the representation of `p` in `s` should include,
+ as a key, the `id` of `p`."))))
+
+(deftest retrieve-test
+ (testing "Object retrieval"
+ ;; the value of `s` here is hand-typed; think of it as a specification
+ (let [s {:path1 {:walkmap.id/id :path1
+ :kind :path
+ :vertices '(:vert_0_0_0
+ :vert_0_0_1
+ :vert_1_0_0)}
+ :vert_0_0_0 {:walkmap.id/id :vert_0_0_0
+ :kind :vertex
+ :x 0
+ :y 0
+ :z 0}
+ :vert_0_0_1 {:walkmap.id/id :vert_0_0_1
+ :kind :vertex
+ :x 0
+ :y 0
+ :z 1}
+ :vert_1_0_0 {:walkmap.id/id :vert_1_0_0
+ :kind :vertex
+ :x 1
+ :y 0
+ :z 0}
+ :walkmap.superstructure/vertex-index {:vert_0_0_0 {:path1 :vert_0_0_0}
+ :vert_0_0_1 {:path1 :vert_0_0_1}
+ :vert_1_0_0 {:path1 :vert_1_0_0}}}
+ expected {:kind :path,
+ :vertices
+ '({:kind :vertex, :x 0, :y 0, :z 0, :walkmap.id/id :vert_0_0_0}
+ {:kind :vertex, :x 0, :y 0, :z 1, :walkmap.id/id :vert_0_0_1}
+ {:kind :vertex, :x 1, :y 0, :z 0, :walkmap.id/id :vert_1_0_0}),
+ :walkmap.id/id :path1}]
+ (is (= (retrieve :path1 s) expected)
+ "The object reconstructed from the superstructure."))))
+
+(deftest round-trip-test
+ (testing "Roundtripping an object through the superstructure."
+ (let [p (p/path
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand)))
+ id (:walkmap.id/id p)
+ s (store p)
+ r (retrieve id s)]
+ (is (= p r) "As it was, so it shall be."))))
+
+(deftest multi-object-round-trip-test
+ (testing "Roundtripping two different objects through a superstructure."
+ (let [p (p/path
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand)))
+ q (p/path
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand)))
+ pid (:walkmap.id/id p)
+ qid (:walkmap.id/id q)
+ s (store q (store p))
+ rp (retrieve pid s)
+ rq (retrieve qid s)]
+ (is (= p rp) "As `p` was, so it shall be.")
+ (is (= q rq) "As `q` was, so it shall be.")
+ (is (not= pid qid)
+ "It is not possible that the ids should be equal, since they are
+ gensymmed")
+ (is (not= rp rq)
+ "It is not possible that the paths should be equal, since at
+ minimum, their ids are gensymmed."))))
+
+(deftest store-retrieve-edit-store-test
+ (testing "After editing a retrieved object and storing it again, a further
+ retrieve should return the new version."
+ (let [p (p/path
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand))
+ (v/vertex (rand) (rand) (rand)))
+ id (:walkmap.id/id p)
+ o (store p)
+ r (retrieve id o)
+ p' (t/tag
+ (assoc r :vertices
+ (conj (:vertices id) (v/vertex (rand) (rand) (rand))))
+ :edited)
+ o' (store p' o)
+ r' (retrieve id o')]
+ (is (not= r r') "The value referenced by `id` should have changed.")
+ (is (= r' p') "The value referenced by `id` in `o'` should be equal to `p'`."))))
diff --git a/test/walkmap/tag_test.clj b/test/walkmap/tag_test.clj
index 00d578a..1de4382 100644
--- a/test/walkmap/tag_test.clj
+++ b/test/walkmap/tag_test.clj
@@ -4,32 +4,32 @@
(deftest tag-tests
(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.")
- (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.")
- (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
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.")
- (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.")
- (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")
- (is (false? (tagged? {} :foo))
+ (is (false? (tagged? {:kind :test-obj} :foo))
"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")
- (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")
- (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.")
- (is (= (tags (tag {} :foo)) #{:foo})
+ (is (= (tags (tag {:kind :test-obj} :foo)) #{:foo})
"`tags` should return the tags on the object, if any.")
(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.")
- (let [object (tag {} :foo :bar :ban :froboz)]
+ (let [object (tag {:kind :test-obj} :foo :bar :ban :froboz)]
(is (= (untag object :cornflakes) object)
"Removing a missing tag should have no effect.")
(is (tagged? (untag object :foo) :bar :ban :froboz)
@@ -42,10 +42,13 @@
"An exception should be thrown if `object` is not a map: `tagged?`.")
(is (thrown? IllegalArgumentException (untag [] :foo))
"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`.")
- (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?`.")
- (is (thrown? IllegalArgumentException (untag {} :foo "bar" :ban))
- "An exception should be thrown if any of `tags` is not a keywordp: `untag`.")))
+ (is (thrown? IllegalArgumentException (untag {:kind :test-obj} :foo "bar" :ban))
+ "An exception should be thrown if any of `tags` is not a keywordp: `untag`.")
+ (let [o (tag {:kind :test-obj} :foo '(:bar :ban) :froboz)]
+ (is (tagged? o :ban :bar :foo :froboz)
+ "It's now allowed to include lists of tags in the arg list for `tag`."))))