From cf0b70e81665574b38e199e17515268849dffedc Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 15 Nov 2020 19:06:28 +0000 Subject: [PATCH] Changes all namespaces by prefixing with 'cc.journeyman.'. Not all tests pass. --- project.clj | 2 +- src/walkmap/edge.clj | 186 ------------------ src/walkmap/id.clj | 8 - src/walkmap/microworld.clj | 75 -------- src/walkmap/ocean.clj | 25 --- src/walkmap/path.clj | 93 --------- src/walkmap/polygon.clj | 155 --------------- src/walkmap/read_svg.clj | 100 ---------- src/walkmap/routing.clj | 205 -------------------- src/walkmap/stl.clj | 206 -------------------- src/walkmap/superstructure.clj | 272 --------------------------- src/walkmap/svg.clj | 110 ----------- src/walkmap/tag.clj | 68 ------- src/walkmap/utils.clj | 119 ------------ src/walkmap/vertex.clj | 151 --------------- test/walkmap/edge_test.clj | 121 ------------ test/walkmap/ocean_test.clj | 53 ------ test/walkmap/path_test.clj | 111 ----------- test/walkmap/polygon_test.clj | 81 -------- test/walkmap/stl_test.clj | 96 ---------- test/walkmap/superstructure_test.clj | 135 ------------- test/walkmap/tag_test.clj | 54 ------ test/walkmap/utils_test.clj | 100 ---------- test/walkmap/vertex_test.clj | 146 -------------- 24 files changed, 1 insertion(+), 2671 deletions(-) delete mode 100644 src/walkmap/edge.clj delete mode 100644 src/walkmap/id.clj delete mode 100644 src/walkmap/microworld.clj delete mode 100644 src/walkmap/ocean.clj delete mode 100644 src/walkmap/path.clj delete mode 100644 src/walkmap/polygon.clj delete mode 100644 src/walkmap/read_svg.clj delete mode 100644 src/walkmap/routing.clj delete mode 100644 src/walkmap/stl.clj delete mode 100644 src/walkmap/superstructure.clj delete mode 100644 src/walkmap/svg.clj delete mode 100644 src/walkmap/tag.clj delete mode 100644 src/walkmap/utils.clj delete mode 100644 src/walkmap/vertex.clj delete mode 100644 test/walkmap/edge_test.clj delete mode 100644 test/walkmap/ocean_test.clj delete mode 100644 test/walkmap/path_test.clj delete mode 100644 test/walkmap/polygon_test.clj delete mode 100644 test/walkmap/stl_test.clj delete mode 100644 test/walkmap/superstructure_test.clj delete mode 100644 test/walkmap/tag_test.clj delete mode 100644 test/walkmap/utils_test.clj delete mode 100644 test/walkmap/vertex_test.clj diff --git a/project.clj b/project.clj index 7a61a63..6ba87d7 100644 --- a/project.clj +++ b/project.clj @@ -34,5 +34,5 @@ ["uberjar"] ["change" "version" "leiningen.release/bump-version"] ["vcs" "commit"]] - :repl-options {:init-ns walkmap.superstructure} + :repl-options {:init-ns cc.journeyman.walkmap.superstructure} :url "https://simon-brooke.github.io/walkmap/") diff --git a/src/walkmap/edge.clj b/src/walkmap/edge.clj deleted file mode 100644 index efefabc..0000000 --- a/src/walkmap/edge.clj +++ /dev/null @@ -1,186 +0,0 @@ -(ns walkmap.edge - "Essentially the specification for things we shall consider to be an edge. - An edge is a line segment having just a start and an end, with no intervening - nodes." - (:require [clojure.math.numeric-tower :as m] - [walkmap.utils :as u] - [walkmap.vertex :refer [canonicalise check-vertex ensure2d ensure3d vertex vertex= vertex?]])) - -(defn edge - "Return an edge between vertices `v1` and `v2`." - [v1 v2] - {:kind :edge - :walkmap.id/id (keyword (gensym "edge")) - :start (check-vertex v1) - :end (check-vertex v2)}) - -(defn edge? - "True if `o` satisfies the conditions for a edge. An edge shall be a map - having the keys `:start` and `:end`, such that the values of each of those - keys shall be a vertex." - [o] - (and - (map? o) - (vertex? (:start o)) - (vertex? (:end o)))) - -(defn length - "Return the length of the edge `e`." - [e] - (let [start (ensure3d (:start e)) - end (ensure3d (:end e))] - (m/sqrt - (reduce - + - (map - #(m/expt (- (% end) (% start)) 2) - [:x :y :z]))))) - -(defn centre - "Return the vertex that represents the centre of this `edge`." - [edge] - (let [s (ensure3d (:start edge)) - e (ensure3d (:end edge))] - (vertex - (+ (:x s) (/ (- (:x e) (:x s)) 2)) - (+ (:y s) (/ (- (:y e) (:y s)) 2)) - (+ (:z s) (/ (- (:z e) (:z s)) 2))))) - -(defn unit-vector - "Return an vertex parallel to `e` starting from the coordinate origin. Two - edges which are parallel will have the same unit vector." - [e] - (let [e' {:start (ensure3d (:start e)) :end (ensure3d (:end e))} - l (length e')] - (canonicalise - (reduce - merge - {} - (map - (fn [k] - {k (/ (- (k (:end e')) (k (:start e'))) l)}) - [:x :y :z]))))) - -(defn parallel? - "True if all `edges` passed are parallel with one another." - [& edges] - (let [uvs (map unit-vector edges)] - (every? - #(vertex= % (first uvs)) - (rest uvs)))) - -(defn collinear? - "True if edges `e1` and `e2` are collinear with one another." - [e1 e2] - (parallel? - e1 - e2 - (if (vertex= (:start e1) (:start e2)) - {:start (:start e1) :end (:end e2)} - {:start (:start e1) :end (:start e2)}))) - -(defn collinear2d? - "True if the projections of edges `e1`, `e2` onto the x, y plane are - collinear." - [e1 e2] - (collinear? {:start (ensure2d (:start e1)) :end (ensure2d (:end e1))} - {:start (ensure2d (:start e2)) :end (ensure2d (:end e2))})) - -(defn minimaxd - "Apply function `f` to `coord` of the vertices at start and end of `edge` - and return the result. Intended use case is `f` = `min` or `max`, `coord` - is `:x`, `:y` or `:z`. No checks are made for sane arguments." - [edge coord f] - (apply f (list (coord (:start edge)) (coord (:end edge))))) - -(defn on? - "True if the vertex `v` is on the edge `e`." - [e v] - (let [p (ensure3d (:start e)) - q (ensure3d v) - r (ensure3d (:end e))] - (and - (collinear? (edge p q) (edge q r)) - (<= (:x q) (max (:x p) (:x r))) - (>= (:x q) (min (:x p) (:x r))) - (<= (:y q) (max (:y p) (:y r))) - (>= (:y q) (min (:y p) (:y r))) - (<= (:z q) (max (:z p) (:z r))) - (>= (:z q) (min (:z p) (:z r)))))) - -(defn on2d? - "True if vertex `v` is on edge `e` when projected onto the x, y plane." - [e v] - (on? (edge (ensure2d (:start e)) (ensure2d (:end e))) v)) - -(defn overlaps2d? - "True if the recangle in the x,y plane bisected by edge `e1` overlaps that - bisected by edge `e2`. It is an error if either `e1` or `e2` is not an edge. - - If `c1` is passed it should be the first coordinate of the plane of - projection on which the overlap is sought (default: `:x`); similarly `c2` - should be the second such coordinate (default: `:y`)." - ([e1 e2] - (overlaps2d? e1 e2 :x :y)) - ([e1 e2 c1 c2] - (when (and (edge? e1) (edge? e2)) - (and - (> (minimaxd e1 c1 max) (minimaxd e2 c1 min)) - (< (minimaxd e1 c1 min) (minimaxd e2 c1 max)) - (> (minimaxd e1 c2 max) (minimaxd e2 c2 min)) - (< (minimaxd e1 c2 min) (minimaxd e2 c2 max)))))) - - -(defn intersection2d - "The probability of two lines intersecting in 3d space is low, and actually - that is mostly not something we're interested in. We're interested in - intersection in the `x,y` plane. This function returns a vertex representing - a point vertically over the intersection of edges `e1`, `e2` in the `x,y` - plane, whose `z` coordinate is - - * 0 if both edges are 2d (i.e. have missing or zero `z` coordinates); - * if one edge is 2d, then the point on the other edge over the intersection; - * otherwise, the average of the z coordinates of the points on the two - edges over the intersection. - - If no such intersection exists, `nil` is returned. - - It is an error, and an exception will be thrown, if either `e1` or `e2` is - not an edge." - ([e1 e2] - (intersection2d e1 e2 :x :y :z)) - ([e1 e2 c1 c2 c3] - (if (and (edge? e1) (edge? e2)) - (when - (overlaps2d? e1 e2) ;; relatively cheap check - (if - (collinear2d? e1 e2) - ;; any point within the overlap will do, but we'll pick the end of e1 - ;; which is on e2 - (if (on2d? e2 (:start e1)) (:start e1) (:end e1)) - ;; blatantly stolen from - ;; https://gist.github.com/cassiel/3e725b49670356a9b936 - (let [x1 (c1 (:start e1)) - x2 (c1 (:end e1)) - x3 (c1 (:start e2)) - x4 (c1 (:end e2)) - y1 (c2 (:start e1)) - y2 (c2 (:end e1)) - y3 (c2 (:start e2)) - y4 (c2 (:end e2)) - denom (- (* (- x1 x2) (- y3 y4)) - (* (- y1 y2) (- x3 x4))) - x1y2-y1x2 (- (* x1 y2) (* y1 x2)) - x3y4-y3x4 (- (* x3 y4) (* y3 x4)) - px-num (- (* x1y2-y1x2 (- x3 x4)) - (* (- x1 x2) x3y4-y3x4)) - py-num (- (* x1y2-y1x2 (- y3 y4)) - (* (- y1 y2) x3y4-y3x4)) - result (when-not (zero? denom) - (vertex (/ px-num denom) (/ py-num denom)))] - (when (and result (on2d? e1 result) (on2d? e2 result)) result)))) - (throw (IllegalArgumentException. - (str - "Both `e1` and `e2` must be edges." - (map #(or (:kind %) (type %)) [e1 e2]))))))) - diff --git a/src/walkmap/id.clj b/src/walkmap/id.clj deleted file mode 100644 index 3dfc71b..0000000 --- a/src/walkmap/id.clj +++ /dev/null @@ -1,8 +0,0 @@ -(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/microworld.clj b/src/walkmap/microworld.clj deleted file mode 100644 index bea1282..0000000 --- a/src/walkmap/microworld.clj +++ /dev/null @@ -1,75 +0,0 @@ -(ns walkmap.microworld - "An interface between walkmap and microworld, to allow use of microworld - functionality to model things like rainfall, soil fertility, settlement - and so on." - (:require [clojure.edn :as edn :only [read]] - [clojure.java.io :as io] - [clojure.string :as s] - [taoensso.timbre :as l] - [walkmap.edge :as e] - [walkmap.polygon :as p :only [rectangle]] - [walkmap.superstructure :refer [store]] - [walkmap.tag :as t :only [tag]] - [walkmap.vertex :as v :only [check-vertex vertex vertex?]] - [walkmap.utils :as u :only [truncate]])) - -(defn cell->polygon - "From this MicroWorld `cell`, construct a walkmap polygon (specifically, - a rectangle. If `scale-vector` passed and is a vertex, scale all the vertices - in the cell by that vector." - ([cell] - (cell->polygon cell (v/vertex 1 1 1))) - ([cell scale-vector] - (t/tag - (assoc - (merge - cell - (let [w (* (:x cell) (:x (v/check-vertex scale-vector))) - s (* (:y cell) (:y scale-vector)) - e (+ w (:x scale-vector)) - n (+ s (:y scale-vector)) - z (* (:altitude cell) (:z scale-vector))] - (p/rectangle - (v/vertex s w z) - (v/vertex n e z)))) - :walkmap.id/id - (keyword (gensym "mw-cell"))) - (:state cell)))) - -(defn load-microworld-edn - "While it would be possible to call MicroWorld functions directly from - Walkmap, the fact is that running MicroWorld is so phenomenally - compute-heavy that it's much more sensible to do it in batch mode. So the - better plan is to be able to pull the output from MicroWorld - as an EDN - structure - into a walkmap superstructure." - ([filename] - (load-microworld-edn filename :mw)) - ([filename map-kind] - (when-not - (keyword? map-kind) - (throw (IllegalArgumentException. - (u/truncate - (str "Must be a keyword: " (or map-kind "nil")) 80)))) - (load-microworld-edn filename map-kind nil)) - ([filename mapkind superstucture] - (load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1))) - ([filename map-kind superstructure scale-vertex] - (let [mw (try - (with-open [r (io/reader filename)] - (edn/read (java.io.PushbackReader. r))) - (catch RuntimeException e - (l/error "Error parsing edn file '%s': %s\n" - filename (.getMessage e)))) - polys (reduce - concat - (map (fn [row] (map cell->polygon row)) mw))] - (if (map? superstructure) - (reduce - #(store %2 %1) - superstructure - polys) - polys)))) - - - - diff --git a/src/walkmap/ocean.clj b/src/walkmap/ocean.clj deleted file mode 100644 index 99004ca..0000000 --- a/src/walkmap/ocean.clj +++ /dev/null @@ -1,25 +0,0 @@ -(ns walkmap.ocean - "Deal with (specifically, at this stage, cull) ocean areas" - (:require [walkmap.utils :refer [=ish]])) - -(def ^:dynamic *sea-level* - "The sea level on heightmaps we're currently handling. If characters are to - be able to swin in the sea, we must model the sea bottom, so we need - heightmaps which cover at least the continental shelf. However, the sea - bottom is not walkable territory and can be culled from walkmaps. - - **Note** must be a floating point number. `(= 0 0.0)` returns `false`!" - 0.0) - -(defn ocean? - "Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?" - [facet] - (every? - #(=ish % *sea-level*) - (map :z (:vertices facet)))) - -(defn cull-ocean-facets - "Ye cannae walk on water. Remove all facets from this `stl` structure which - are at sea level." - [stl] - (assoc stl :facets (remove ocean? (:facets stl)))) diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj deleted file mode 100644 index 76e4e8b..0000000 --- a/src/walkmap/path.clj +++ /dev/null @@ -1,93 +0,0 @@ -(ns walkmap.path - "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 [clojure.string :as s] - [walkmap.edge :as e] - [walkmap.polygon :refer [check-polygon polygon?]] - [walkmap.tag :refer [tag tags]] - [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]] - [walkmap.vertex :refer [check-vertices vertex?]])) - -(defn path? - "True if `o` satisfies the conditions for a path. A path shall be a map - having the key `:vertices`, whose value shall be a sequence of vertices as - defined in `walkmap.vertex`." - [o] - (let - [v (:vertices o)] - (and - (seq? v) - (> (count v) 1) - (every? vertex? v) - (:walkmap.id/id o) - (or (nil? (:kind o)) (= (:kind o) :path))))) - -(defn path - "Return a path constructed from these `vertices`." - [& vertices] - (if - (> (count (check-vertices vertices)) 1) - {:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path} - (throw (IllegalArgumentException. "Path must have more than one vertex.")))) - -(defmacro check-path - "If `o` is not a path, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type ~o path? :path)) - -(defmacro check-paths - "If `o` is not a sequence of paths, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type-seq ~o path? :path)) - -(defn polygon->path - "If `o` is a polygon, return an equivalent path. What's different about - a path is that in polygons there is an implicit edge between the first - vertex and the last. In paths, there isn't, so we need to add that - edge explicitly. - - If `o` is not a polygon, will throw an exception." - [o] -;; this is breaking, but I have NO IDEA why! -;; (check-polygon o polygon? :polygon) - (assoc (dissoc o :vertices) - :kind :path - ;; `concat` rather than `conj` because order matters. - :vertices (concat (:vertices o) (list (first (:vertices o)))))) - -(defn path->edges - "if `o` is a path, a polygon, or a sequence of vertices, return a sequence of - edges representing that path, polygon or sequence. - - Throws `IllegalArgumentException` if `o` is not a path, a polygon, or - sequence of vertices." - [o] - (cond - (seq? o) (when - (and - (vertex? (first o)) - (vertex? (first (rest o)))) - (cons - ;; TODO: think about: when constructing an edge from a path, should the - ;; constructed edge be tagged with the tags of the path? - (e/edge (first o) (first (rest o))) - (path->edges (rest o)))) - (path? o) (path->edges (:vertices o)) - (polygon? o) (path->edges (polygon->path o)) - :else - (throw (IllegalArgumentException. - "Not a path or sequence of vertices!")))) - -(defn length - "Return the length of this path, in metres. **Note that** - 1. This is not the same as the distance from the start to the end of the - path, which, except for absolutely straight paths, will be shorter; - 2. It is not even quite the same as the length of the path *as rendered*, - since paths will generally be rendered as spline curves." - [path] - (reduce + (map e/length (path->edges (check-path path))))) diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj deleted file mode 100644 index 87cb757..0000000 --- a/src/walkmap/polygon.clj +++ /dev/null @@ -1,155 +0,0 @@ -(ns walkmap.polygon - "Essentially the specification for things we shall consider to be polygons." - (:require [clojure.string :as s] - [walkmap.edge :as e] - [walkmap.tag :as t] - [walkmap.utils :refer [check-kind-type - check-kind-type-seq - kind-type - not-yet-implemented]] - [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]])) - -(defn polygon? - "True if `o` satisfies the conditions for a polygon. A polygon shall be a - map which has a value for the key `:vertices`, where that value is a sequence - of vertices." - [o] - (let - [v (:vertices o)] - (and - (coll? v) - (> (count v) 2) - (every? vertex? v) - (:walkmap.id/id o) - (or (nil? (:kind o)) (= (:kind o) :polygon))))) - -(defmacro check-polygon - "If `o` is not a polygon, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type ~o polygon? :polygon)) - -(defmacro check-polygons - "If `o` is not a sequence of polygons, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type-seq ~o polygon? :polygon)) - -(defn triangle? - "True if `o` satisfies the conditions for a triangle. A triangle shall be a - polygon with exactly three vertices." - [o] - (and - (coll? o) - (= (count (:vertices o)) 3))) - -(defmacro check-triangle - "If `o` is not a triangle, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type ~o triangle? :triangle)) - -(defn polygon - "Return a polygon constructed from these `vertices`." - [& vertices] - (if - (> (count vertices) 2) - {:vertices (check-vertices vertices) - :walkmap.id/id (keyword (gensym "poly")) - :kind :polygon} - (throw (IllegalArgumentException. - "A polygon must have at least 3 vertices.")))) - -(defn rectangle - "Return a rectangle, with edges aligned east-west and north-south, whose - south-west corner is the vertex `vsw` and whose north-east corner is the - vertex `vne`." - [vsw vne] - ;; we can actually create any rectangle in the xy plane based on two opposite - ;; corners, but the maths are a bit to advanced for me today. TODO: do it! - (let [vnw (vertex (:x (check-vertex vsw)) - (:y (check-vertex vne)) - (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) - vse (vertex (:x vne) - (:y vsw) - (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) - height-order (sort-by :z [vsw vne])] - (t/tag - (assoc - (polygon vsw vnw vne vse) - :gradient - (e/unit-vector (e/edge (first height-order) (last height-order))) - :centre - (vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2)) - (+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2)) - (:z vse))) - :rectangle))) - -;; (rectangle (vertex 1 2 3) (vertex 7 9 4)) - -(defn gradient - "Return a polygon like `triangle` but with a key `:gradient` whose value is a - unit vector representing the gradient across `triangle`." - [triangle] - (let [order (sort #(max (:z %1) (:z %2)) - (:vertices (check-triangle triangle))) - highest (first order) - lowest (last order)] - (assoc triangle :gradient (e/unit-vector (e/edge lowest highest))))) - -(defn triangle-centre - "Return a canonicalised `facet` (i.e. a triangular polygon) with an added - key `:centre` whose value represents the centre of this facet in 3 - dimensions. This only works for triangles, so is here not in - `walkmap.polygon`. It is an error (although no exception is currently - thrown) if the object past is not a triangular polygon." - [facet] - (let [vs (:vertices (check-triangle facet)) - v1 (first vs) - opposite (e/edge (nth vs 1) (nth vs 2)) - oc (e/centre opposite)] - (assoc - facet - :centre - (vertex - (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3)) - (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3)) - (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3)))))) - -(defn centre - [poly] - (case (count (:vertices (check-polygon poly))) - 3 (triangle-centre poly) - ;; else - (throw - (UnsupportedOperationException. - "The general case of centre for polygons is not yet implemented.")))) - -(defmacro on2dtriangle? - "Is the projection of this `vertex` on the x, y plane within the - projection of this triangle on that plane?" - [vertex poly] - `(not-yet-implemented "on2d? for triangles.")) - -(defn on2drectangle? - "Is the projection of this `vertex` on the x, y plane within the - projection of this rectangle on that plane?" - [vertex rectangle] - (let [xo (sort-by :x (:vertices rectangle)) - yo (sort-by :x (:vertices rectangle))] - (and - (< (:x (first xo)) (:x vertex) (:x (last xo))) - (< (:y (first yo)) (:y vertex) (:y (last yo)))))) - -(defmacro on2d? - "Is the projection of this `vertex` on the x, y plane within the - projection of this polygon `poly` on that plane?" - [vertex poly] - `(cond - (rectangle? ~poly) (on2drectangle? ~vertex ~poly) - (triangle? ~poly) (on2dtriangle? ~vertex ~poly) - :else - (not-yet-implemented "general case of on2d? for polygons."))) diff --git a/src/walkmap/read_svg.clj b/src/walkmap/read_svg.clj deleted file mode 100644 index 93cf98c..0000000 --- a/src/walkmap/read_svg.clj +++ /dev/null @@ -1,100 +0,0 @@ -(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.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 (= (:tag elt) :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))))) - -;; (read-svg "resources/iom/manual_roads.svg") - diff --git a/src/walkmap/routing.clj b/src/walkmap/routing.clj deleted file mode 100644 index 4d3c4d6..0000000 --- a/src/walkmap/routing.clj +++ /dev/null @@ -1,205 +0,0 @@ -(ns walkmap.routing - "Finding optimal routes to traverse a map." - (:require [clojure.math.numeric-tower :as m :only [expt]] - [clojure.set :refer [intersection]] - [clojure.string :as cs :only [join]] - [search.core :refer [a*]] - [walkmap.edge :as e] - [walkmap.path :as p] - [walkmap.polygon :as q] - [walkmap.superstructure :as s] - [walkmap.tag :as t] - [walkmap.utils :as u] - [walkmap.vertex :as v])) - -;; Breadth first search is a good algorithm for terrain in which all steps have -;; equal, but in our world (like the real world), they don't. - -;; Reading list: -;; -;; https://en.wikipedia.org/wiki/A*_search_algorithm -;; https://www.redblobgames.com/pathfinding/a-star/introduction.html -;; https://faculty.nps.edu/ncrowe/opmpaper2.htm -;; -;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html - -(def ^:dynamic *gradient-exponent* - "The exponent to be applied to `(inc (:z (unit-vector from to)))` - of a path segment to calculate the gradient-related part of the - cost of traversal. Dynamic, because we will want to tune this." - 2) - -(def ^:dynamic *traversals-exponent* - "The (expected to be negative) exponent to be applied to the number - of traversals of a path to compute the road bonus. Paths more travelled by - should have larger bonuses, but not dramatically so - so the increase in - bonus needs to scale significantly less than linearly with the number - of traversals. Dynamic, because we will want to tune this." - -2) - -(defn traversable? - "True if this `object` is a polygon which can be considered as part of - the walkmap." - [object] - (and - (q/polygon? object) - (:centre object) - (not (t/tagged? object :no-traversal)))) - -(declare traversal-cost) - -(defn vertices-traversal-cost - [vertices s] - (reduce - + - (map - #(traversal-cost %1 %2 s) - (v/check-vertices vertices) - (rest vertices)))) - -(defn path-traversal-cost - [path s] - (vertices-traversal-cost (:vertices (p/check-path path)) s)) - -(defn barriers-crossed - "Search superstructure `s` and return a sequence of barriers, if any, which - obstruct traversal from vertex `from` to vertex `to`." - [from to s] - ;; TODO: implement - '()) - -(defn crossing-penalty - "TODO: should return the cost of crossing this `barrier`, initially mainly - a watercourse, on the axis from vertex `from` to vertex `to`. in the context - of superstructure `s`. If there's a bridge, ferry or other crossing mechanism - in `s` at the intersection of the vertex and the barrier, then the penalty - should be substantially less than it would otherwise be." - [barrier from to s] - ;; TODO: implement - 0) - -(defn gradient-cost - "Compute the per-unit-distance cost of traversing this `edge`." - [edge] - (let [g (:z (e/unit-vector edge))] - (if (pos? g) - (m/expt (inc g) *gradient-exponent*) - 1))) - -;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0))) -;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 0))) -;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 1))) -;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 1))) -;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0.0001))) - -(defn best-road - "Find the best traversable path which links the vertices `from` and `to` - in this superstructure `s`, or nil if there are none." - [from to s] - (let [f (fn [v] (set (s/touching v p/path? s)))] - (first - (sort-by - ;;; I... chose the path more travelled by. - #(or (:traversals %) 0) - (filter traversable? (intersection (f from) (f to))))))) - -(defn road-bonus - "Calculate the road bonus of the edge represented by the vertices `from`, - `to`, in the context of the superstructure `s`. Obviously there only is - such a bonus if there actually is an existing thoroughfare to use. Road - bonuses scale with some fractional exponent of the number of traversals - which have been made of the road segment in question." - [from to s] - (let [best (best-road from to s)] - (when (:traversals best) - (m/expt (:traversals best) *traversals-exponent*)))) - -(defn traversal-cost - "Return the traversal cost of the edge represented by the vertices `from`, - `to`, in the context of the superstructure `s`. It is legitimate to pass - `nil` as the `to` argument, in which case the result will be zero, in order - to allow `reduce` to be used to compute total path costs." - [from to s] - (if (nil? to) - 0 - (let [edge (e/edge from to) - distance (e/length edge)] - (/ - (+ - (* distance - (gradient-cost edge)) - (reduce + - (map - #(crossing-penalty [% from to s]) - (barriers-crossed from to s)))) - (or (road-bonus from to s) 1))))) - -;; (def p '({:x 1.40625, :y 0, :kind :vertex, :walkmap.id/id :vert_1-40625_0} -;; {:x 1.40625, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_1-40625_-10-703125} -;; {:x 7.578125, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_7-578125_-10-703125} -;; {:x 7.578125, :y 0, :kind :vertex, :walkmap.id/id :vert_7-578125_0} -;; {:x 2.171875, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_2-171875_-0-765625} -;; {:x 6.8125, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_6-8125_-0-765625})) -;; (v/check-vertices p) -;; (def p' (p/path p)) - -;; (traversal-cost (first p) (nth p 1) {}) -;; (vertices-traversal-cost p {}) -;; (path-traversal-cost (p/path p)) - -(defn extend-frontier - "Return a sequence like `frontier` with all of these `candidates` which are - not already members either of `frontier` or of `rejects` appended. Assumes - candidates are traversable." - ([frontier candidates] - (extend-frontier frontier candidates nil)) - ([frontier candidates rejects] - (if - (empty? frontier) - candidates - (let [fs (set (concat frontier rejects))] - (concat frontier (remove fs candidates)))))) - -;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8) '(6 8)) -;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8)) -;; (extend-frontier '(1 2 3 4 5) '()) -;; (extend-frontier '(1 2 3 4 5) nil) -;; (extend-frontier nil '(1 2 3 4 5)) - -(def ^:dynamic *route-goal* - "The goal of the route currently sought." - nil) - -(defn find-traversable-facet - "Return the nearest traversable walkmap facet within `search-radius` of - `target`, or throw an exception if none is found." - [target search-radius s] - (let [r (s/nearest s target traversable? search-radius)] - (when-not r (throw - (Exception. - (cs/join " " ["Unable to find walkable facet within" - search-radius - "of" - target])))) - r)) - -(defn route - ;; architectural problem: needs to return not the route, but a modified - ;; superstructure with the new route stored in it. - ([from to s] - (route from to s traversal-cost 5)) - ([from to s cost-fn search-radius] - (let [from' (find-traversable-facet from search-radius s) - to' (find-traversable-facet to search-radius s)] - (a* from' - #(v/vertex= % (:centre to')) ;; goal?-fn - 'have we got there yet?' - #(cost-fn %1 %2 s) ;; distance-fn - what is the distance/cost - ;; between these vertices? - #(e/length (e/edge (:centre %) to)) - ;; heuristic: how far to the end goal - #(s/neighbours % traversable? s) - ;; neighbours-fn - return the traversable - ;; neighbours of the current facet - (int (* search-radius (e/length (e/edge from to)))) - ;; how long a path we'll accept - )))) diff --git a/src/walkmap/stl.clj b/src/walkmap/stl.clj deleted file mode 100644 index 892d17f..0000000 --- a/src/walkmap/stl.clj +++ /dev/null @@ -1,206 +0,0 @@ -(ns walkmap.stl - "Utility functions dealing with stereolithography (STL) files. Not a stable API yet!" - (:require [clojure.java.io :as io :refer [file output-stream input-stream]] - [clojure.string :as s] - [me.raynes.fs :as fs] - [org.clojars.smee.binary.core :as b] - [taoensso.timbre :as l] - [walkmap.edge :as e] - [walkmap.ocean :as o] - [walkmap.polygon :refer [centre gradient polygon?]] - [walkmap.superstructure :refer [store]] - [walkmap.tag :refer [tag]] - [walkmap.utils :as u] - [walkmap.vertex :as v]) - (:import org.clojars.smee.binary.core.BinaryIO - java.io.DataInput)) - -(defn stl? - "True if `o` is recogniseable as an STL structure. An STL structure must - have a key `:facets`, whose value must be a sequence of polygons; and - may have a key `:header` whose value should be a string, and/or a key - `:count`, whose value should be a positive integer. - - If `verify-count?` is passed and is not `false`, verify that the value of - the `:count` header is equal to the number of facets." - ([o] - (stl? o false)) - ([o verify-count?] - (and - (map? o) - (:facets o) - (every? polygon? (:facets o)) - (if (:header o) (string? (:header o)) true) - (if (:count o) (integer? (:count o)) true) - (or (nil? (:kind o)) (= (:kind o) :stl)) - (if verify-count? (= (:count o) (count (:facets o))) true)))) - -(def vect - "A codec for vectors within a binary STL file." - (b/ordered-map - :x :float-le - :y :float-le - :z :float-le)) - -(def facet - "A codec for a facet (triangle) within a binary STL file." - (b/ordered-map - :normal vect - :vertices [vect vect vect] - :abc :ushort-le)) - -(def binary-stl - "A codec for binary STL files" - (b/ordered-map - :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this. - :count :uint-le - :facets (b/repeated facet))) - -(defn canonicalise - "Objects read in from STL won't have all the keys/values we need them to have. - `o` may be a map (representing a facet or a vertex), or a sequence of such maps; - if it isn't recognised it is at present just returned unchanged. `map-kind`, if - passed, must be a keyword indicating the value represented by the `z` axis - (defaults to `:height`). It is an error, and an exception will be thrown, if - `map-kind` is not a keyword." - ([o] (canonicalise o :height)) - ([o map-kind] - (canonicalise o map-kind (v/vertex 1 1 1))) - ([o map-kind scale-vertex] - (when-not - (keyword? map-kind) - (throw (IllegalArgumentException. - (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 - :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 may not yet conform to - ;; `polygon?` - (:vertices o) (let [f (gradient - (centre - (tag - (assoc o - :walkmap.id/id (or - (:walkmap.id/id o) - (keyword (gensym "poly"))) - :kind :polygon - :vertices (canonicalise - (:vertices o) - map-kind)) - :facet map-kind)))] - (if (o/ocean? f) - (tag f :ocean :no-traversal) - f)) - ;; if it has a value for :x it's a vertex, but it may not yet conform - ;; to `vertex?`; it should also be scaled using the scale-vertex, if any. - (:x o) (let [c (v/canonicalise o)] - (if scale-vertex - (v/vertex* c scale-vertex) - c)) - ;; shouldn't happen - :else o))) - -(defn decode-binary-stl - "Parse a binary STL file from this `filename` and return an STL structure - representing its contents. `map-kind`, if passed, must be a keyword - or sequence of keywords indicating the semantic value represented by the `z` - axis (defaults to `:height`). - - If `superstructure` is supplied and is a map, the generated STL structure - will be stored in that superstructure, which will be returned. - - If `scale-vertex` is supplied, it must be a three dimensional vertex (i.e. - the `:z` key must have a numeric value) representing the amount by which - each of the vertices read from the STL will be scaled. - - It is an error, and an exception will be thrown, if `map-kind` is not a - keyword or sequence of keywords. - - **NOTE** that we've no way of verifying that the input file is binary STL - data, if it is not this will run but will return garbage." - ([filename] - (decode-binary-stl filename :height)) - ([filename map-kind] - (when-not - (keyword? map-kind) - (throw (IllegalArgumentException. - (u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80)))) - (decode-binary-stl filename map-kind nil)) - ([filename mapkind superstucture] - (decode-binary-stl filename mapkind superstucture (v/vertex 1 1 1))) - ([filename map-kind superstructure scale-vertex] - (let [in (io/input-stream filename) - stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)] - (if - (map? superstructure) - (store stl superstructure) - stl)))) - -(defn- vect->str [prefix v] - (str prefix " " (:x v) " " (:y v) " " (:z v) "\n")) - -(defn- facet2str [tri] - (str - (vect->str "facet normal" (:normal tri)) - "outer loop\n" - (s/join - (map - #(vect->str "vertex" %) - (:vertices tri))) - "endloop\nendfacet\n")) - -(defn stl->ascii - "Return as a string an ASCII rendering of the `stl` structure." - ([stl] - (stl->ascii stl "unknown")) - ([stl solidname] - (str - "solid " - solidname - (s/trim (:header stl)) - "\n" - (s/join - (map - facet2str - (:facets stl))) - "endsolid " - solidname - "\n"))) - -(defn write-ascii-stl - "Write an `stl` structure as read by `decode-binary-stl` to this - `filename` as ASCII encoded STL." - ([filename stl] - (let [b (fs/base-name filename true)] - (write-ascii-stl - filename stl - (subs b 0 (or (s/index-of b ".") (count b)))))) - ([filename stl solidname] - (l/debug "Solid name is " solidname) - (spit - filename - (stl->ascii stl solidname)))) - -(defn binary-stl-to-ascii - "Convert the binary STL file indicated by `in-filename`, and write it to - `out-filename`, if specified; otherwise, to a file with the same basename - as `in-filename` but the extension `.ascii.stl`." - ([in-filename] - (let [[_ ext] (fs/split-ext in-filename)] - (binary-stl-to-ascii - in-filename - (str - (subs - in-filename - 0 - (or - (s/last-index-of in-filename ".") - (count in-filename))) - ".ascii" - ext)))) - ([in-filename out-filename] - (write-ascii-stl out-filename (decode-binary-stl in-filename)))) diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj deleted file mode 100644 index ee7c8d2..0000000 --- a/src/walkmap/superstructure.clj +++ /dev/null @@ -1,272 +0,0 @@ -(ns walkmap.superstructure - "single indexing structure for walkmap objects" - (:require [clojure.walk :refer [postwalk]] - [taoensso.timbre :as l] - [walkmap.edge :refer [edge length]] - [walkmap.path :as p] - [walkmap.polygon :as q] - [walkmap.utils :as u] - [walkmap.vertex :as v])) - -;; TODO: Think about reification/dereification. How can we cull a polygon, if -;; some vertices still index it? I *think* that what's needed is that when -;; we store something in the superstructure, we replace all its vertices (and -;; other dependent structures, if any with their ids - as well as, obviously, -;; adding/merging those vertices/dependent structures into the superstructure -;; as first class objects in themselves. That means, for each identified thing, -;; the superstructure only contains one copy of it. -;; -;; The question then is, when we want to do things with those objects, do we -;; exteract a copy with its dependent structures fixed back up (reification), -;; or do we indirect through the superstructure every time we want to access -;; them? In a sense, the copy in the superstructure is the 'one true copy', -;; but it may become very difficult then to have one true copy of the -;; 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] - (when (map? o) - (reduce - concat - (remove - nil? - (map - #(cond - (v/vertex? %) (list %) - (and (coll? %) (every? v/vertex? %)) %) - (vals 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 `:walkmap.id/id`; - 4. `v` is not a vertex." - [s o v] - (if-not (v/vertex? o) - (if (:walkmap.id/id o) - (if (v/vertex? 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 (: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 `: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))) - -(defn index-vertices - "Return a superstructure like `s` in which object `o` is indexed by its - vertices. 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 `:walkmap.id/id`." - [s o] - (u/deep-merge - s - {::vertex-index - (reduce - u/deep-merge - {} - (map - #(index-vertex s o %) - (:vertices o)))})) - -(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 recognisable walkmap object" - ([o] - (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)))) - -(defn search-vertices - "Search superstructure `s` for vertices within the box defined by vertices - `minv` and `maxv`. Every coordinate in `minv` must have a lower value than - the equivalent coordinate in `maxv`. If `d2?` is supplied and not false, - search only in the x,y projection. - - **NOTE THAT** this depends on the fact that vertices do not currently - have properties which will be denormalised by `store`, and therefore do not - have to restored with `retrieve`. If properties are added to vertices - whose values are objects, then this will have to be rewritten." - ([s minv maxv] - (search-vertices s minv maxv false)) - ([s minv maxv d2?] - (let [minv' (if d2? (assoc minv :z Double/NEGATIVE_INFINITY) minv) - maxv' (if d2? (assoc maxv :z Double/POSITIVE_INFINITY) maxv)] - (filter - #(v/within-box? % minv maxv) - (filter #(= (:kind %) :vertex) (vals s)))))) - -(defn nearest - "Search superstructure `s` for the nearest object matching `filter-fn` to - the `target` vertex. Searches only with `radius` (slight misnomer, area - actually searched is a cube). Returns one object, or `nil` if no matching - object found. - - WARNING: currently only returns objects which have a defined `:centre` - (but most of the significant objects we have do)." - [s target filter-fn radius] - (let [minv (v/vertex - (- (:x (v/check-vertex target)) radius) - (- (:y target) radius) (- (or (:z target) 0) radius)) - maxv (v/vertex - (+ (:x target) 0.5) (+ (:y target) 0.5) - (+ (or (:z target) 0) 0.5))] - ;; filter those objects with the filter function, then sort that list - ;; by the edge distance from the target to the `:centre` of the object - ;; and take the first - (first - (sort-by - #(length (edge target (:centre %))) - (filter - :centre - (map #(retrieve % s) - ;; for each vertex id in vids, get the objects associated with that id - ;; in the vertex index as a single flat list - (reduce - concat - (remove - nil? - (map - #(-> s ::vertex-index % keys) - ;; get all the vertex ids within radius of the target - (set - (map - :walkmap.id/id - (search-vertices s minv maxv)))))))))))) - -(defn touching - "Return a sequence of all objects in superstructure `s` which are - indexed as touching the vertex `v`." - ([vertex s] - (map - #(retrieve % s) - (set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys)))) - ([vertex filter-fn s] - (filter - filter-fn - (touching vertex s)))) - -(defn neighbours - "Return a sequence of all those objects in superstructure `s` which share - at least one vertex with `target`, and which are matched by `filter-fn` - if supplied." - ([target s] - (neighbours identity s)) - ([target filter-fn s] - (remove - #(= target %) - (reduce - concat - (remove - nil? - (map #(touching % filter-fn s) (vertices target))))))) - -(defn neighbour-ids - "Return a sequence of the ids all those objects in superstructure `s` which - share at least one vertex with `target`, and which are matched by - `filter-fn` if supplied." - ([target s] - (neighbour-ids target identity s)) - ([target filter-fn s] - (map :walkmap.id/id (neighbours target filter-fn s)))) diff --git a/src/walkmap/svg.clj b/src/walkmap/svg.clj deleted file mode 100644 index 5f14232..0000000 --- a/src/walkmap/svg.clj +++ /dev/null @@ -1,110 +0,0 @@ -(ns walkmap.svg - "Utility functions for writing stereolithography (STL) files (and possibly, - later, other geometry files of interest to us) as scalable vector graphics - (SVG)." - (: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]] - [walkmap.ocean :refer [cull-ocean-facets]] - [walkmap.polygon :refer [polygon?]] - [walkmap.stl :refer [decode-binary-stl]] - [walkmap.vertex :refer [vertex?]])) - -(def ^:dynamic *preferred-svg-render* - "Mainly for debugging dali; switch SVG renderer to use. Expected values: - `:dali`, `:hiccup`." - :dali) - -(defn- facet->svg-poly - [facet] - [:polygon - {:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}]) - -(defn- dali-facet->svg-poly - [facet] - (vec - (cons - :polygon - (map #(vec (list (:x %) (:y %))) (:vertices facet))))) - -(defn dali-stl->svg - "Format this `stl` as SVG for the `dali` renderer on a page with these - bounds." - [stl minx maxx miny maxy] - [:dali/page - {:xmlns "http://www.w3.org/2000/svg" - :version "1.2" - :width (- maxx minx) - :height (- maxy miny) - :viewBox (s/join " " (map str [minx miny maxx maxy]))} - (vec - (cons - :g - (map - dali-facet->svg-poly - (:facets stl))))]) - -(defn hiccup-stl->svg - "Format this `stl` as SVG for the `hiccup` renderer on a page with these - bounds." - [stl minx maxx miny maxy] - [:svg - {:xmlns "http://www.w3.org/2000/svg" - :version "1.2" - :width (- maxx minx) - :height (- maxy miny) - :viewBox (s/join " " (map str [minx miny maxx maxy]))} - (vec - (cons - :g - (map - facet->svg-poly - (:facets stl))))]) - -(defn stl->svg - "Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into - an in-memory hiccup representation of SVG structure, and return it." - [stl] - (let [minx (reduce - min - (map - #(reduce min (map :x (:vertices %))) - (:facets stl))) - maxx (reduce - max - (map - #(reduce max (map :x (:vertices %))) - (:facets stl))) - miny (reduce - min - (map - #(reduce min (map :y (:vertices %))) - (:facets stl))) - maxy (reduce - max - (map - #(reduce max (map :y (:vertices %))) - (:facets stl)))] - (l/info "Generating SVG for " *preferred-svg-render* " renderer") - (case *preferred-svg-render* - :hiccup (hiccup-stl->svg stl minx maxx miny maxy) - :dali (dali-stl->svg stl minx maxx miny maxy) - (throw (Exception. "Unexpected renderer value: " *preferred-svg-render*))))) - -(defn binary-stl-file->svg - "Given only an `in-filename`, parse the indicated file, expected to be - binary STL, and return an equivalent SVG structure. Given both `in-filename` - and `out-filename`, as side-effect write the SVG to the indicated output file." - ([in-filename] - (stl->svg (cull-ocean-facets (decode-binary-stl in-filename)))) - ([in-filename out-filename] - (let [s (binary-stl-file->svg in-filename)] - (l/info "Emitting SVG with " *preferred-svg-render* " renderer") - (case *preferred-svg-render* - :dali (neatly-folded-clock/render-svg s out-filename) - :hiccup (spit out-filename (html s)) - (throw (Exception. "Unexpected renderer value: " *preferred-svg-render*))) - s))) diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj deleted file mode 100644 index 39c0dca..0000000 --- a/src/walkmap/tag.clj +++ /dev/null @@ -1,68 +0,0 @@ -(ns walkmap.tag - "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]] - [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 - (and an exception will be thrown) if - - 1. `object` is not a map; - 2. any of `tags` is not a keyword." - [object & tags] - (when-not (map? object) - (throw (IllegalArgumentException. - (str "Must be a map: " (kind-type object))))) - (let [tags' (flatten tags)] - (when-not (every? keyword? tags') - (throw (IllegalArgumentException. - (str "Must be keywords: " (map kind-type tags'))))) - (let [ot (::tags object)] - (and - (set? ot) - (every? ot tags'))))) - -(defn tag - "Return an object like this `object` but with these `tags` added to its tags, - if they are not already present. It is an error (and an exception will be - thrown) if - - 1. `object` is not a map; - 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] - (l/debug "Tagging" (kind-type object) "with" tags) - (when-not (map? object) - (throw (IllegalArgumentException. - (str "Must be a map: " (kind-type object))))) - (let [tags' (flatten tags)] - (when-not (every? keyword? tags') - (throw (IllegalArgumentException. - (str "Must be keywords: " (map kind-type tags'))))) - (assoc object ::tags (union (set tags') (::tags object))))) - -(defmacro tags - "Return the tags of this object, if any." - [object] - `(::tags ~object)) - -(defn untag - "Return an object like this `object` but with these `tags` removed from its - tags, if present. It is an error (and an exception will be thrown) if - - 1. `object` is not a map; - 2. any of `tags` is not a keyword or sequence of keywords." - [object & tags] - (when-not (map? object) - (throw (IllegalArgumentException. - (str "Must be a map: " (kind-type object))))) - (let [tags' (flatten tags)] - (when-not (every? keyword? tags') - (throw (IllegalArgumentException. - (str "Must be keywords: " (map kind-type tags'))))) - (update-in object [:walkmap.tag/tags] difference (set tags')))) diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj deleted file mode 100644 index 3848526..0000000 --- a/src/walkmap/utils.clj +++ /dev/null @@ -1,119 +0,0 @@ -(ns walkmap.utils - "Miscellaneous utility functions." - (:require [clojure.edn :as edn :only [read]] - [clojure.java.io :as io] - [clojure.math.numeric-tower :as m] - [clojure.string :as s])) - -(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 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")) - -(defn =ish - "True if numbers `n1`, `n2` are roughly equal; that is to say, equal to - within `tolerance` (defaults to one part in one hundred thousand)." - ([n1 n2] - (if (and (number? n1) (number? n2)) - (let [m (m/abs (min n1 n2)) - t (if (zero? m) 0.00001 (* 0.00001 m))] - (=ish n1 n2 t)) - (= n1 n2))) - ([n1 n2 tolerance] - (if (and (number? n1) (number? n2)) - (< (m/abs (- n1 n2)) tolerance) - (= n1 n2)))) - -(defmacro check-kind-type - "If `object` is not of kind-type `expected`, throws an - IllegalArgumentException with an appropriate message; otherwise, returns - `object`. If `checkfn` is supplied, it should be a function which tests - whether the object is of the expected kind-type. - - Macro, so that the exception is thrown from the calling function." - ([object expected] - `(if-not (= (kind-type ~object) ~expected) - (throw - (IllegalArgumentException. - (s/join - " " - ["Expected" ~expected "but found" (kind-type ~object)]))) - ~object)) - ([object checkfn expected] - `(if-not (~checkfn ~object) - (throw - (IllegalArgumentException. - (s/join - " " - ["Expected" ~expected "but found" (kind-type ~object)]))) - ~object))) - -(defmacro check-kind-type-seq - "If some item on sequence `s` is not of the `expected` kind-type, throws an - IllegalArgumentException with an appropriate message; otherwise, returns - `object`. If `checkfn` is supplied, it should be a function which tests - whether the object is of the expected kind-type. - - Macro, so that the exception is thrown from the calling function." - ([s expected] - `(if-not (every? #(= (kind-type %) ~expected) ~s) - (throw - (IllegalArgumentException. - (s/join - " " - ["Expected sequence of" - ~expected - "but found (" - (s/join ", " (remove #(= ~expected %) (map kind-type ~s))) - ")"]))) - ~s)) - ([s checkfn expected] - `(if-not (every? #(~checkfn %) ~s) - (throw - (IllegalArgumentException. - (s/join - " " - ["Expected sequence of" - ~expected - "but found (" - (s/join ", " (remove #(= ~expected %) (map kind-type ~s))) - ")"]))) - ~s))) - -(defn load-edn - "Load edn from an io/reader source (filename or io/resource)." - [source] - (try - (with-open [r (io/reader source)] - (edn/read (java.io.PushbackReader. r))) - (catch java.io.IOException e - (printf "Couldn't open '%s': %s\n" source (.getMessage e))) - (catch RuntimeException e - (printf "Error parsing edn file '%s': %s\n" source (.getMessage e))))) - -(defn not-yet-implemented - [message] - (throw - (UnsupportedOperationException. - (str "Not yet implemented: " message)))) diff --git a/src/walkmap/vertex.clj b/src/walkmap/vertex.clj deleted file mode 100644 index 19a016a..0000000 --- a/src/walkmap/vertex.clj +++ /dev/null @@ -1,151 +0,0 @@ -(ns walkmap.vertex - "Essentially the specification for things we shall consider to be vertices. - - Note that there's no `distance` function here; to find the distance between - two vertices, create an edge from them and use `walkmap.edge/length`." - (:require [clojure.math.numeric-tower :as m] - [clojure.string :as s] - [taoensso.timbre :as l] - [walkmap.utils :refer [=ish check-kind-type check-kind-type-seq kind-type truncate]])) - -(defn vertex-key - "Making sure we get the same key everytime we key a vertex with the same - coordinates. `o` must have numeric values for `:x`, `:y`, and optionally - `:z`; it is an error and an exception will be thrown if `o` does not - conform to this specification. - - **Note:** these keys can be quite long. No apology is made: it is required - that the same key can *never* refer to two different locations in space." - [o] - (keyword - (s/replace - (cond - (and (:x o) (:y o) (:z o)) - (str "vert_" (:x o) "_" (:y o) "_" (:z o)) - (and (:x o) (:y o)) - (str "vert_" (:x o) "_" (:y o)) - :else - (throw (IllegalArgumentException. - (truncate (str "Not a vertex: " (or o "nil")) 80)))) - "." - "-"))) - -(defn vertex? - "True if `o` satisfies the conditions for a vertex. That is, essentially, - that it must rerpresent a two- or three- dimensional vector. A vertex is - shall be a map having at least the keys `:x` and `:y`, where the value of - those keys is a number. If the key `:z` is also present, its value must also - be a number. - - The name `vector?` was not used as that would clash with a function of that - name in `clojure.core` whose semantics are entirely different." - [o] - (and - (map? o) - (:walkmap.id/id o) - (number? (:x o)) - (number? (:y o)) - (or (nil? (:z o)) (number? (:z o))) - (or (nil? (:kind o)) (= (:kind o) :vertex)))) - -(defmacro check-vertex - "If `o` is not a vertex, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type ~o vertex? :vertex)) - -(defmacro check-vertices - "If `o` is not a sequence of vertices, throw an `IllegalArgumentException` with an - appropriate message; otherwise, returns `o`. Macro, so exception is thrown - from the calling function." - [o] - `(check-kind-type-seq ~o vertex? :vertex)) - -(defn vertex= - "True if vertices `v1`, `v2` represent the same vertex." - [v1 v2] - (check-vertex v1) - (check-vertex v2) - (every? - #(=ish (% v1) (% v2)) - [:x :y :z])) - -(defn vertex* - "Return a vertex like `v1`, but with each of its coordinates multiplied - by the equivalent vertex in `v2`. It is an error, and an exception will - be thrown, if either `v1` or `v2` is not a vertex." - [v1 v2] - (let [f (fn [v1 v2 coord] - (* (or (coord v1) 0) - ;; one here is deliberate! - (or (coord v2) 1)))] - (assoc v1 :x (f (check-vertex v1) (check-vertex v2) :x) - :y (f v1 v2 :y) - :z (f v1 v2 :z)))) - -(defn vertex - "Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map - 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 :walkmap.id/id (vertex-key v)))) - ([x y z] - (let [v {:x x :y y :z z :kind :vertex}] - (assoc v :walkmap.id/id (vertex-key v))))) - -(defn canonicalise - "If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`, - upgrade it to something we will recognise as a vertex." - [o] - (if - (and - (map? o) - (number? (:x o)) - (number? (:y o)) - (or (nil? (:z o)) (number? (:z o)))) - (assoc o :kind :vertex :walkmap.id/id (vertex-key o)) - (throw - (IllegalArgumentException. - (truncate - (str "Not a proto-vertex: must have numeric `:x` and `:y`: " - (or o "nil")) - 80))))) - -(def ensure3d - "Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise - return a vertex like `o` but having this `dflt` value as the value of its - `:z` key, or zero as the value of its `:z` key if `dflt` is not specified. - - If `o` is not a vertex, throws an exception." - (memoize - (fn - ([o] - (ensure3d o 0.0)) - ([o dflt] - (if (:z (check-vertex o)) - o - (assoc o :z dflt)))))) - -(def ensure2d - "If `o` is a vertex, set its `:z` value to zero; else throw an exception." - (memoize - (fn [o] - (assoc (check-vertex o) :z 0.0)))) - -(defn within-box? - "True if `target` is within the box defined by `minv` and `maxv`. All - arguments must be vertices; additionally, both `minv` and `maxv` must - have `:z` coordinates." - [target minv maxv] - (do - (check-vertices [target minv maxv]) - (every? - true? - (map - #(if (% target) - (<= (% minv) (% target) (% maxv)) - true) - [:x :y :z])))) diff --git a/test/walkmap/edge_test.clj b/test/walkmap/edge_test.clj deleted file mode 100644 index 697f43e..0000000 --- a/test/walkmap/edge_test.clj +++ /dev/null @@ -1,121 +0,0 @@ -(ns walkmap.edge-test - (:require [clojure.math.numeric-tower :as m] - [clojure.test :refer :all] - [walkmap.edge :refer :all] - [walkmap.vertex :refer [vertex vertex=]])) - -(deftest edge-test - (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 :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 :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 :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 :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 :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") - )) - -(deftest collinear2d-test - (testing "Collinearity when projected onto the x,y plane." - (is (collinear2d? (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - (edge (vertex 4.0 4.0) (vertex 6.0 6.0))) - "Collinear, overlapping.") - (is (collinear2d? (edge (vertex 1.0 1.0 0.0) (vertex 5.0 5.0 5.0)) - (edge (vertex 4.0 4.0 79.3) (vertex 6.0 6.0 0.2))) - "Separated in the z axis, but collinear in x, y."))) - -(deftest construction-test - (testing "Construction of edges." - (is (edge? (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0))) - "If both arguments are vertices, we should get an edge") - (is (thrown? IllegalArgumentException (edge "Not a vertex" (vertex 1 2))) - "If first argument is not a vertex, we should get an exception.") - (is (thrown? IllegalArgumentException (edge (vertex 1 2) "Not a vertex")) - "If second argument is not a vertex, we should get an exception."))) - -(deftest intersection2d-test - (testing "intersection of two edges projected onto the x,y plane." - (is (thrown? IllegalArgumentException - (intersection2d - (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - "This is not an edge")) - "Not an edge (second arg) -> exception.") - (is (thrown? IllegalArgumentException - (intersection2d - "This is not an edge" - (edge (vertex 1.0 1.0) (vertex 5.0 5.0)))) - "Not an edge (first arg) -> exception.") - (is (nil? (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - (edge (vertex 1.0 2.0) (vertex 5.0 6.0)))) - "Parallel but not intersecting.") - (is (:x (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - (edge (vertex 4.0 4.0) (vertex 6.0 6.0))) - 5.0) - "Collinear, overlapping, should choose the overlapping end of the first edge.") - (is (= (:x (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - (edge (vertex 1.0 5.0) (vertex 5.0 1.0)))) - 3.0) - "Crossing, should intersect at 3.0, 3.0: x coord.") - (is (= (:y (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0)) - (edge (vertex 1.0 5.0) (vertex 5.0 1.0)))) - 3.0) - "Crossing, should intersect at 3.0, 3.0: y coord.") - (is (= (:y (intersection2d (edge (vertex 1.0 1.0 0.0) (vertex 5.0 5.0 0.0)) - (edge (vertex 1.0 5.0 999) (vertex 5.0 1.0 379)))) - 3.0) - "Crossing, presence of z coordinate should make no difference"))) - -(deftest length-test - (testing "length of an edge" - (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." - (is (= (minimaxd (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0)) :x min) 1.0)) - (is (= (minimaxd (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0)) :y max) 8.0)))) - -(deftest parallel-test - (testing "parallelism" - (is (parallel? (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0)) - (edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.5))) - "Should be") - (is (not - (parallel? (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0)) - (edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.49)))) - "Should not be!"))) - -(deftest overlaps2d-test - (testing "whether two edges are in the same area of the x,y plane." - (is (false? (overlaps2d? (edge (vertex 1 1) (vertex 4 4)) (edge (vertex 5 5) (vertex 8 8))))) - (is (overlaps2d? (edge (vertex 1 1) (vertex 4 4)) (edge (vertex 4 4) (vertex 1 1)))))) - -(deftest unit-vector-test - (testing "deriving the unit vector" - (is (vertex= - (unit-vector (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0))) - (vertex 0.6 0.8 0.0))) - (is (vertex= - (unit-vector (edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.5))) - (vertex 0.6 0.8 0.0))))) diff --git a/test/walkmap/ocean_test.clj b/test/walkmap/ocean_test.clj deleted file mode 100644 index 843aa4d..0000000 --- a/test/walkmap/ocean_test.clj +++ /dev/null @@ -1,53 +0,0 @@ -(ns walkmap.ocean-test - (:require [clojure.test :refer :all] - [walkmap.ocean :refer :all] - [walkmap.polygon :refer [polygon]] - [walkmap.vertex :refer [vertex vertex=]])) - -(deftest ocean-tests - (testing "Identification of polygons at sea level" - (is (ocean? (polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0))) - "All `:z` coordinates are zero, and default binding for `*sea-level*` - => ocean.") - (is (false? (ocean? (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0)))) - "Not all `:z` coordinates are zero, and default binding for `*sea-level*` - => not ocean.") - (is (false? (ocean? (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5)))) - "Not all `:z` coordinates are five, and default binding for `*sea-level*` - => not ocean.") - (binding [*sea-level* 5] - (is (false? (ocean? (polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0)))) - "All `:z` coordinates are zero, and `*sea-level*` rebound to five - => not ocean.") - (is (false? (ocean? (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0)))) - "Not all `:z` coordinates are zero, and `*sea-level*` rebound to five - => not ocean.") - (is (ocean? (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))) - "Not all `:z` coordinates are five, and `*sea-level*` rebound to five - => ocean.")))) - -(deftest cull-ocean-facets-tests - (testing "Culling of ocean facets (not currently used)." - (let [stl {:facets [(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]} - expected {:facets - [(polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]} - actual (cull-ocean-facets stl)] - (map - #(is (vertex= (nth (:facets expected) %) (nth (:facets actual) %)) - (str "Facet " % " did not match.")) - (range (max (count (:facets expected)) (count (:facets actual)))))) - (binding [*sea-level* 5] - (let [stl {:facets [(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]} - expected {:facets - [(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0)) - (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))]} - actual (cull-ocean-facets stl)] - (map - #(is (vertex= (nth (:facets expected) %) (nth (:facets actual) %)) - (str "Facet " % " did not match.")) - (range (max (count (:facets expected)) (count (:facets actual))))))))) diff --git a/test/walkmap/path_test.clj b/test/walkmap/path_test.clj deleted file mode 100644 index 31523a2..0000000 --- a/test/walkmap/path_test.clj +++ /dev/null @@ -1,111 +0,0 @@ -(ns walkmap.path-test - (:require [clojure.test :refer :all] - [walkmap.edge :refer [edge?]] - [walkmap.path :refer :all] - [walkmap.polygon :refer [polygon]] - [walkmap.utils :refer [kind-type]] - [walkmap.vertex :refer [vertex vertex=]])) - -(deftest path-tests - (testing "Path instantiation" - (is (= (kind-type (path (vertex 0 0 0) (vertex 1 1 1))) :path) - "Paths should be identified as paths.") - (is (path? (path (vertex 0 0 0) (vertex 1 1 1))) - "Paths should test as paths.") - (is (check-path (path (vertex 0 0 0) (vertex 1 1 1))) - "No exception should be thrown when checking a valid path.") - (is (thrown? - IllegalArgumentException - (check-path - (update-in - (path (vertex 0 0 0) (vertex 1 1 1)) - [:vertices] - conj - "Not a vertex"))) - "Checking an invalid path should throw an exception.") - (is (thrown? - IllegalArgumentException - (path (vertex 0 0 0))) - "Too short.") - (is (thrown? - IllegalArgumentException - (path (vertex 0 0 0) (vertex 1 1 1) "Not a vertex")) - "Non-vertex included.") - (is (thrown? - IllegalArgumentException - (path (vertex 0 0 0) (vertex 1 1 1) "Not a vertex.")) - "Passing something which is not a vertex when constructing a path whould - cause an exception to be thrown."))) - -(deftest conversion-tests - (testing "Converting polygons to paths" - (let [poly (polygon (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0)) - p (polygon->path poly)] - (is (path? p) "Should be a path.") - (is (vertex= (first (:vertices p)) (last (:vertices p))) - "First and last vertices of the generated path should be equal to - one another.") - (is (= (count (:vertices p)) (inc (count (:vertices poly)))) - "The generated path should have one more vertex than the polygon.") - (map - #(is (vertex= (nth (:vertices poly) %) (nth (:vertices p) %)) - (str "Vertex " % " from each set of vertices should be the same.")) - (range (count (:vertices poly)))))) - (testing "Converting polygons and paths to edges." - (let [poly (polygon (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0)) - edges (path->edges poly)] - (is (every? edge? edges) - "Every returned edge should be an edge.") - (is (= (count (:vertices poly)) (count edges)) - "There should be the same number of edges as the vertices of the polygon") - (doall - (map - #(is - (vertex= (nth (:vertices poly) %) (:start (nth edges %))) - (str - "Each edge should start from the same place as the corresponding - vertex: " %)) - (range (count (:vertices poly))))) - (doall - (map - #(is - (vertex= (nth (:vertices poly) (mod (inc %) (count (:vertices poly)))) - (:end (nth edges %))) - (str - "Each edge should end at the same place as the subsequent - vertex: " %)) - (range (count (:vertices poly)))))) - (is (thrown? IllegalArgumentException - (path->edges "Not a legal argument."))))) - -(deftest check-paths-tests - (testing "Checking multiple paths." - (is (thrown? IllegalArgumentException - (check-paths [(path (vertex 0 0 0) - (vertex 1 0 0) - (vertex 1 1 0) - (vertex 0 1 0) - (vertex 0 0 0)) - (path (vertex 0 0 1) - (vertex 1 0 1) - (vertex 1 1 1) - (vertex 0 1 1) - (vertex 0 0 1)) - (vertex 0 0 0)])) - "Not all elements are paths") - (is (check-paths [(path (vertex 0 0 0) - (vertex 1 0 0) - (vertex 1 1 0) - (vertex 0 1 0) - (vertex 0 0 0)) - (path (vertex 0 0 1) - (vertex 1 0 1) - (vertex 1 1 1) - (vertex 0 1 1) - (vertex 0 0 1))]) - "All elements are paths"))) - -(deftest length-tests - (testing "length of paths" - (let [p (path (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0) (vertex 0 0 0))] - (is (= (length p) 4) "By inspection.")))) diff --git a/test/walkmap/polygon_test.clj b/test/walkmap/polygon_test.clj deleted file mode 100644 index 7f378b8..0000000 --- a/test/walkmap/polygon_test.clj +++ /dev/null @@ -1,81 +0,0 @@ -(ns walkmap.polygon-test - (:require [clojure.test :refer :all] -;; [clojure.algo.generic.math-functions :as m] -;; [walkmap.edge :refer [edge?]] -;; [walkmap.path :refer :all] - [walkmap.polygon :refer :all] - [walkmap.utils :refer [kind-type]] - [walkmap.vertex :refer [vertex vertex? vertex=]]) - ) - -(deftest polygon-tests - (testing "Constructing polygons" - (let [square (polygon (vertex 0 0 0) (vertex 1 0 0) - (vertex 1 1 0) (vertex 0 1 0)) - triangle (polygon (vertex 0 0 0) (vertex 0 3 0) - (vertex 4 0 0))] - (is (= (kind-type square) :polygon) - "Square should have `:kind` = `:polygon`.") - (is (= (kind-type triangle) :polygon) - "Triangle should have `:kind` = `:polygon`.") - (is (polygon? square) "Square should be a polygon.") - (is (polygon? triangle) "Triangle should be a polygon.") - (is (false? (triangle? square)) "Square is not a triangle.") - (is (triangle? triangle) "Triangle is a triangle.") - (is (check-polygon square) "No exception should be thrown.") - (is (check-polygon triangle) "No exception should be thrown.") - (is (check-triangle triangle) "No exception should be thrown.") - (is (check-polygons [square triangle]) - "No exception should be thrown.") - (is (thrown? - IllegalArgumentException - (check-polygon "Not a polygon")) "Not a polygon") - (is (thrown? - IllegalArgumentException - (check-polygons [square triangle "Not a polygon"])) - "One value is not a polygon.") - (is (thrown? - IllegalArgumentException (check-triangle square)) - "Not a triangle.") - (is (thrown? - IllegalArgumentException (polygon (vertex 0 0 0) (vertex 1 0 0))) - "Too few vertices.") - (is (thrown? - IllegalArgumentException (polygon (vertex 0 0 0) (vertex 1 0 0) - (vertex 1 1 0) "Not a vertex" - (vertex 0 1 0))) - "Non-vertex included.") - ) - )) - -(deftest gradient-tests - (testing "Finding the gradient across a triangle." - (let [tri (polygon (vertex 0 0 1) (vertex 1 0 0) (vertex 1 1 0.5)) - gra (gradient tri)] - (is (nil? (:gradient tri)) "Basic trangle should not have a gradient.") - (is (vertex? (:gradient gra)) - "After passing through gradient function, it should have a gradient.") - ;; TODO: I need to check that the gradient is being computed correclt, - ;; but my brain isn't up to the trigonometry just now. - ))) - -(deftest centre-tests - (testing "Finding the centres of polygons." - (let [square (polygon (vertex 0 0 0) (vertex 1 0 0) - (vertex 1 1 0) (vertex 0 1 0)) - triangle (polygon (vertex 0 0 0) (vertex 0 3 0) - (vertex 4 0 0)) - centred (centre triangle)] - (is (vertex= (:centre centred) (vertex 1.3333333 1.0 0.0)) - "By inspection (check this maths!).") - (is (thrown? - UnsupportedOperationException - (centre square)) - "We can't yet find the centre of a quadrilateral, but we should be - able to do so, so it isn't an illegal argument, it just doesn't - work.") - (is (thrown? - IllegalArgumentException - (centre "Not a polygon")) - "Anything else that isn't a polygon, though, is an illegal argument.")))) - diff --git a/test/walkmap/stl_test.clj b/test/walkmap/stl_test.clj deleted file mode 100644 index 1665890..0000000 --- a/test/walkmap/stl_test.clj +++ /dev/null @@ -1,96 +0,0 @@ -(ns walkmap.stl-test - (:require [clojure.test :refer :all] - [walkmap.stl :refer :all] - [walkmap.polygon :refer [polygon?]] - [walkmap.vertex :refer [vertex?]])) - -(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 `: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) - "`:y` value should be unchanged.") - (is (= (:z (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0) - "`:z` value should be unchanged.") - (is (every? - vertex? - (canonicalise [{:x 3.0, :y 1.0, :z 1.0} - {:x 2.0, :y 3.0, :z 1.0} - {:x 0.0, :y 0.0, :z 1.0}])) - "Vertices: should recurse.")) - (testing "Canonicalisation of objects read from STL: facets/polygons." - (let [p {:normal {:x -0.0, :y 0.0, :z 1.0}, - :vertices [{:x 3.0, :y 1.0, :z 1.0} - {:x 2.0, :y 3.0, :z 1.0} - {:x 0.0, :y 0.0, :z 1.0}], - :abc 0} - p' (canonicalise p)] - (is (polygon? p') - "Polygon: should have an `:walkmap.id/id` and `:kind` = `:polygon`.") - (is (= (count (:vertices p)) (count (:vertices p'))) - "Number of vertices should not change") - (map - #(is (= (map % (:vertices p))(map % (:vertices p'))) - (str "Order of vertices should not change: " %)) - [:x :y :z])) - (is (every? - polygon? - (canonicalise - [{:normal {:x -0.0, :y 0.0, :z 1.0}, - :vertices [{:x 3.0, :y 1.0, :z 1.0} - {:x 2.0, :y 3.0, :z 1.0} - {:x 0.0, :y 0.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 10.0, :y 4.0, :z 1.0} - {:x 22.0, :y 3.0, :z 1.0} - {:x 13.0, :y 5.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 26.0, :y 46.0, :z 1.0} - {:x 29.0, :y 49.0, :z 1.0} - {:x 31.0, :y 61.0, :z 1.0}], - :abc 0} - {:normal {:x -0.0, :y 0.0, :z 1.0}, - :vertices [{:x 16.0, :y 33.0, :z 1.0} - {:x 15.0, :y 35.0, :z 1.0} - {:x 13.0, :y 32.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 81.0, :y 0.0, :z 1.0} - {:x 54.0, :y 27.0, :z 1.0} - {:x 51.0, :y 20.0, :z 1.0}], - :abc 0}])) - "Facets/polygons: should recurse.")) - (testing "Canonicalisation of entire STL structure." - (let [stl {:header "Dummy test STL", - :count 5, - :facets [{:normal {:x -0.0, :y 0.0, :z 1.0}, - :vertices [{:x 3.0, :y 1.0, :z 1.0} - {:x 2.0, :y 3.0, :z 1.0} - {:x 0.0, :y 0.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 10.0, :y 4.0, :z 1.0} - {:x 22.0, :y 3.0, :z 1.0} - {:x 13.0, :y 5.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 26.0, :y 46.0, :z 1.0} - {:x 29.0, :y 49.0, :z 1.0} - {:x 31.0, :y 61.0, :z 1.0}], - :abc 0} - {:normal {:x -0.0, :y 0.0, :z 1.0}, - :vertices [{:x 16.0, :y 33.0, :z 1.0} - {:x 15.0, :y 35.0, :z 1.0} - {:x 13.0, :y 32.0, :z 1.0}], - :abc 0} - {:normal {:x 0.0, :y 0.0, :z 1.0}, - :vertices [{:x 81.0, :y 0.0, :z 1.0} - {:x 54.0, :y 27.0, :z 1.0} - {:x 51.0, :y 20.0, :z 1.0}], - :abc 0}]} - stl' (canonicalise 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 deleted file mode 100644 index 9904a2e..0000000 --- a/test/walkmap/superstructure_test.clj +++ /dev/null @@ -1,135 +0,0 @@ -(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 deleted file mode 100644 index 1de4382..0000000 --- a/test/walkmap/tag_test.clj +++ /dev/null @@ -1,54 +0,0 @@ -(ns walkmap.tag-test - (:require [clojure.test :refer :all] - [walkmap.tag :refer :all])) - -(deftest tag-tests - (testing "Tagging" - (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 {:kind :test-obj} :foo :bar :ban :froboz))) 4) - "All the tags passed should be added.") - (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 {:kind :test-obj} :foo :bar :ban :froboz)) :cornflakes)) - "`:cornflakes should not be present.") - (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 {: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? {:kind :test-obj} :foo)) - "A missing `:walkmap.tag/tags` should not cause an error.") - (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 {:kind :test-obj} :foo) :bar) :foo :bar) - "We should be able to add tags to an already tagged object") - (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 {: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 {: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) - "All tags not explicitly removed should still be present.") - (is (false? (tagged? (untag object :bar) :bar)) - "But the tag which has been removed should be removed.")) - (is (thrown? IllegalArgumentException (tag [] :foo)) - "An exception should be thrown if `object` is not a map: `tag`.") - (is (thrown? IllegalArgumentException (tagged? [] :foo)) - "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 {:kind :test-obj} :foo "bar" :ban)) - "An exception should be thrown if any of `tags` is not a keyword: `tag`.") - (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 {: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`.")))) - diff --git a/test/walkmap/utils_test.clj b/test/walkmap/utils_test.clj deleted file mode 100644 index d2ce375..0000000 --- a/test/walkmap/utils_test.clj +++ /dev/null @@ -1,100 +0,0 @@ -(ns walkmap.utils-test - (:require [clojure.test :refer :all] - [walkmap.utils :refer :all] - [walkmap.vertex :refer [vertex vertex?]])) - -(deftest =ish-tests - (testing "Rough equality" - (is (=ish 5.00000001 5.00000002) "Close enough.") - (is (=ish 5 5) "Perfect.") - (is (not (=ish 5.01 5.02)) "Not close enough.") - (is (=ish 22/7 3.142857) "We hope so!") - (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 (not (=ish "hello" "goodbye" 10000)) "Well, except non-numbers, of course."))) - -(deftest truncate-tests - (testing "String truncation" - (is (= (truncate "The quick brown fox jumped over the lazy dog" 19) - "The quick brown fox") - "If it's a sting, and longer than the desired length, it should be - truncated.") - (is (= (truncate "The quick brown fox jumped over the lazy dog" 100) - "The quick brown fox jumped over the lazy dog") - "If it's a sting, and shorter than the desired length, it should not be - truncated.") - (is (= (truncate :the-quick-brown-fox 10) :the-quick-brown-fox) - "If it's not a string, it should not be truncated, regardless."))) - - -(deftest kind-type-tests - (testing "Type identification." - (is (= (kind-type {:kind :test}) :test) - "Maps with a value for `:kind` return that as their kind.") - (is (= (kind-type {:dnik :test}) clojure.lang.PersistentArrayMap) - "Maps with no value for `:kind` are just maps.") - (is (= (kind-type nil) "nil") - "As a special case, the kind of `nil` is the string \"nil\".") - (is (= (kind-type "Fred") java.lang.String) - "The kind-type of anything else is just its Java class."))) - -(deftest check-kind-type-tests - (testing "Exception thrown if kind not as expected." - (let [v {:kind :test}] - (is (= (check-kind-type v :test) v) - "If the check passes, the object is returned.")) - (let [v "test"] - (is (= (check-kind-type v java.lang.String) v) - "If the check passes, the object is returned.")) - (let [v "test"] - (is (= (check-kind-type v string? java.lang.String) v) - "If the check passes, the object is returned.")) - (let [v (vertex 1 1 1)] - (is (= (check-kind-type v :vertex) v) - "If the check passes, the object is returned.")) - (let [v (vertex 1 1 1)] - (is (= (check-kind-type v vertex? :vertex) v) - "If the check passes, the object is returned.")) - (let [v "test"] - (is (thrown? IllegalArgumentException - (check-kind-type v :test)) - "If the check doesn't pass, an exception is thrown.")) - (let [v {:kind :test}] - (is (thrown? IllegalArgumentException - (check-kind-type v vertex? :vertex)) - "If the check doesn't pass, an exception is thrown.")))) - -(deftest check-kind-type-seq-tests - (testing "Exception thrown if kind not as expected: sequence variant." - (let [v [{:kind :test} {:kind :test}]] - (is (= (check-kind-type-seq v :test) v) - "If the check passes, the object is returned.")) - (let [v (list "another" "test")] - (is (= (check-kind-type-seq v java.lang.String) v) - "If the check passes, the object is returned.")) - (let [v ["more" "test" "strings"]] - (is (= (check-kind-type-seq v string? java.lang.String) v) - "If the check passes, the object is returned.")) - (let [v (list (vertex 1 1 1) (vertex 2 2 2) (vertex 3 3 3))] - (is (= (check-kind-type-seq v :vertex) v) - "If the check passes, the object is returned.")) - (let [v (list (vertex 1 1 1))] - (is (= (check-kind-type-seq v vertex? :vertex) v) - "If the check passes, the object is returned.")) - (let [v :test] - (is (thrown? IllegalArgumentException - (check-kind-type-seq v :test)) - "If the arg isn't a sequence, an exception is thrown.")) - (let [v (list (vertex 1 1 1) "test" (vertex 3 3 3))] - (is (thrown? IllegalArgumentException - (check-kind-type-seq v :test)) - "If the check doesn't pass for any item, an exception is thrown.")) - (let [v (list (vertex 1 1 1) (vertex 2 2 2) "test")] - (is (thrown? IllegalArgumentException - (check-kind-type-seq v vertex? :vertex)) - "If the check doesn't pass, an exception is thrown.")))) - - - - diff --git a/test/walkmap/vertex_test.clj b/test/walkmap/vertex_test.clj deleted file mode 100644 index b6b26ef..0000000 --- a/test/walkmap/vertex_test.clj +++ /dev/null @@ -1,146 +0,0 @@ -(ns walkmap.vertex-test - (:require [clojure.test :refer :all] - [walkmap.utils :refer [=ish kind-type]] - [walkmap.vertex :refer :all])) - -(deftest vertex-equal-tests - (testing "Equality of vertices" - (is (vertex= (vertex 0 0 0) (vertex 0 0 0)) - "should be equal") - (is (vertex= (vertex 0 0 0) (vertex 0.0000001 0 0)) - "differences less than one part in a million should be ignored") - (is (false? (vertex= (vertex 0 0 0) (vertex 0 0 1))) - "should not be equal") - (is (thrown? IllegalArgumentException - (vertex= (vertex 0 0 0) "Not a vertex")) - "Exception should be thrown: not a vertex."))) - -(deftest vertex-multiply-tests - (testing "multiplication of vertices" - (let [v (vertex (rand) (rand) (rand)) - u (vertex 1 1 1) - v' (vertex* v u)] - (is (vertex= v v') - "Multiplication by {:x 1 :y 1 :z 1} should not change the vertex")) - (let [v (vertex 0.333333 0.25 0.2) - d (vertex 3 4 5) - v' (vertex* v d) - expected (vertex 1 1 1)] - (is (vertex= expected v') - "Multiplication by values other than {:x 1 :y 1 :z 1} should change - the vertex")) - (let [v (vertex 0.3333333 0.25 0.2) - d (vertex 3 4) - v' (vertex* v d) - expected (vertex 1 1 0.2)] - (is (vertex= expected v') - "Multiplication by a 2D vertex should not change `:z`")) - (let [v (vertex 0.3333333 0.25) - d (vertex 3 4) - v' (vertex* v d) - expected (vertex 1 1 0)] - (is (=ish 0 (:z v')) - "Multiplication of a 2D vertex should result in `:z` = zero")) - (is (thrown? IllegalArgumentException - (vertex* 3 (vertex 0 0 0))) - "Exception should be thrown: not a vertex (1st arg).") - (is (thrown? IllegalArgumentException - (vertex* (vertex 0 0 0) "Not a vertex")) - "Exception should be thrown: not a vertex (2nd arg)."))) - -(deftest canonicalise-tests - (testing "Canonicalisation of vertices." - (is (thrown? IllegalArgumentException - (canonicalise {:x "3" :y 4})) - "Exception should be thrown: not a number (`:x` coord).") - (is (thrown? IllegalArgumentException - (canonicalise {:x 3 :y :Jam})) - "Exception should be thrown: not a number (`:y` coord).") - (is (thrown? IllegalArgumentException - (canonicalise {:x 3 :y :4 :z {:foo "bar"}})) - "Exception should be thrown: not a number (`:z` coord).") - (let [v (canonicalise {:x 3 :y 4})] - (is - (= (:walkmap.id/id v) - (keyword (str "vert_" (:x v) "_" (:y v)))) - "Vertex ids should match the expected pattern.") - (is (= (kind-type v) :vertex) - "A canonicalised 2d vertex should have the kind `:vertex`.") - (is (vertex? v) - "A canonicalised 2d vertex should be recognisable as a vertex.")) - (let [v (canonicalise {:x 3 :y 4 :z 5})] - (is - (= (:walkmap.id/id v) - (keyword (str "vert_" (:x v) "_" (:y v) "_" (:z v)))) - "Vertex ids should match the expected pattern.") - (is (= (kind-type v) :vertex) - "A canonicalised 3d vertex should have the kind `:vertex`.") - (is (vertex? v) - "A canonicalised 3d vertex should be recognisable as a vertex.")))) - -(deftest ensure3d-tests - (testing "Coercing vertices to three dimensions" - (let [v (vertex 2 3) - v' (ensure3d v)] - (is (zero? (:z v')) - "If not already 3d, and no `dflt` arg specified, `:z` should be zero.")) - (let [v (vertex 2 3) - v' (ensure3d v 5)] - (is (= (:z v') 5) - "If not already 3d, and `dflt` arg specified, `:z` should be - equal to `dflt`.")) - (let [v (vertex 2 3 4) - v' (ensure3d v 5)] - (is (= v v') - "If already 3d, should be unchanged.")))) - -(deftest within-box-tests - (testing "Checking whether a vertex is within a specified region: 2d." - (is (within-box? (vertex 2 2) (vertex 1 1) (vertex 3 3)) "Should be.") - (is (within-box? (vertex 1 3) (vertex 1 1) (vertex 3 3)) "Should be.") - (is (false? (within-box? (vertex 0 2) (vertex 1 1) (vertex 3 3))) - "Outside west") - (is (false? (within-box? (vertex 5 2) (vertex 1 1) (vertex 3 3))) - "Outside east") - (is (false? (within-box? (vertex 2 0) (vertex 1 1) (vertex 3 3))) - "Outside south") - (is (false? (within-box? (vertex 2 5) (vertex 1 1) (vertex 3 3))) - "Outside north") - (is (false? (within-box? (vertex 2 3.000001) (vertex 1 1) (vertex 3 3))) - "Very slightly outside north")) - (testing "Checking whether a vertex is within a specified region: 3d." - (is (within-box? - (vertex 2 2 2) (vertex 1 1 1) (vertex 3 3 3)) "Should be.") - (is (within-box? - (vertex 1 3 3) (vertex 1 1 1) (vertex 3 3 3)) "Should be.") - (is (false? - (within-box? (vertex 0 2 2) (vertex 1 1 1) (vertex 3 3 3))) - "Outside west") - (is (false? - (within-box? (vertex 5 2 2) (vertex 1 1 1) (vertex 3 3 3))) - "Outside east") - (is (false? - (within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3))) - "Outside south") - (is (false? - (within-box? (vertex 2 5 2) (vertex 1 1 1) (vertex 3 3 3))) - "Outside north") - (is (false? - (within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3))) - "Outside south") - (is (false? - (within-box? (vertex 2 2 0) (vertex 1 1 1) (vertex 3 3 3))) - "Outside down") - (is (false? - (within-box? (vertex 2 2 5) (vertex 1 1 1) (vertex 3 3 3))) - "Outside up")) - (testing "Bad arguments." - (is (thrown? IllegalArgumentException - (within-box? :fred (vertex 1 1 1) (vertex 3 3 3))) - "Not a vertex: `target`.") - (is (thrown? IllegalArgumentException - (within-box? (vertex 2 2 2) :ginny (vertex 3 3 3))) - "Not a vertex: `minv`.") - (is (thrown? IllegalArgumentException - (within-box? (vertex 2 2 2) (vertex 1 1 1) :henry)) - "Not a vertex: `maxv`.")))