simon/walkmap
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Whoops! Failed to add new file versions in last commit!

Browse source
This commit is contained in:
Simon Brooke 2020-11-15 21:12:34 +00:00
parent cf0b70e816
commit a0cf33ac57
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
25 changed files with 2684 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

124
test/cc/journeyman/walkmap/edge_test.clj Normal file
View file

@ -0,0 +1,124 @@
(ns cc.journeyman.walkmap.edge-test
(:require [clojure.math.numeric-tower :as m]
[clojure.test :refer :all]
[cc.journeyman.walkmap.edge :refer [collinear? collinear2d? edge
edge? intersection2d length
minimaxd parallel? overlaps2d?
unit-vector]]
[cc.journeyman.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 minimaxd-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)))))

53
test/cc/journeyman/walkmap/ocean_test.clj Normal file
View file

@ -0,0 +1,53 @@
(ns cc.journeyman.walkmap.ocean-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.ocean :refer [*sea-level* cull-ocean-facets ocean?]]
[cc.journeyman.walkmap.polygon :refer [polygon]]
[cc.journeyman.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)))))))))

113
test/cc/journeyman/walkmap/path_test.clj Normal file
View file

@ -0,0 +1,113 @@
(ns cc.journeyman.walkmap.path-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.edge :refer [edge?]]
[cc.journeyman.walkmap.path :refer [check-path check-paths
length path path? path->edges
polygon->path]]
[cc.journeyman.walkmap.polygon :refer [polygon]]
[cc.journeyman.walkmap.utils :refer [kind-type]]
[cc.journeyman.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."))))

85
test/cc/journeyman/walkmap/polygon_test.clj Normal file
View file

@ -0,0 +1,85 @@
(ns cc.journeyman.walkmap.polygon-test
(:require [clojure.test :refer :all]
;; [clojure.algo.generic.math-functions :as m]
;; [cc.journeyman.walkmap.edge :refer [edge?]]
;; [cc.journeyman.walkmap.path :refer :all]
[cc.journeyman.walkmap.polygon :refer [centre check-polygon
check-polygons
check-triangle gradient
polygon polygon?
triangle?]]
[cc.journeyman.walkmap.utils :refer [kind-type]]
[cc.journeyman.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."))))

96
test/cc/journeyman/walkmap/stl_test.clj Normal file
View file

@ -0,0 +1,96 @@
(ns cc.journeyman.walkmap.stl-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.stl :refer [canonicalise stl?]]
[cc.journeyman.walkmap.polygon :refer [polygon?]]
[cc.journeyman.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`."))))

135
test/cc/journeyman/walkmap/superstructure_test.clj Normal file
View file

@ -0,0 +1,135 @@
(ns cc.journeyman.walkmap.superstructure-test
(:require [clojure.set :refer [subset?]]
[clojure.test :refer :all]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.superstructure :refer [retrieve store vertex-index]]
[cc.journeyman.walkmap.tag :as t]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.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'`."))))

54
test/cc/journeyman/walkmap/tag_test.clj Normal file
View file

@ -0,0 +1,54 @@
(ns cc.journeyman.walkmap.tag-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.tag :refer [tag tagged? tags untag]]))
(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`."))))

100
test/cc/journeyman/walkmap/utils_test.clj Normal file
View file

@ -0,0 +1,100 @@
(ns cc.journeyman.walkmap.utils-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.utils :refer [=ish check-kind-type check-kind-type-seq kind-type truncate]]
[cc.journeyman.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."))))

148
test/cc/journeyman/walkmap/vertex_test.clj Normal file
View file

@ -0,0 +1,148 @@
(ns cc.journeyman.walkmap.vertex-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.utils :refer [=ish kind-type]]
[cc.journeyman.walkmap.vertex :refer [canonicalise ensure3d vertex
vertex= vertex* vertex?
within-box?]]))
(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`.")))