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

Line intersection looking good.

Browse source
This commit is contained in:
Simon Brooke 2020-05-27 18:54:36 +01:00
parent 79174af2c1
commit 1ab35dbe7d
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
29 changed files with 1725 additions and 853 deletions
Download patch file Download diff file Expand all files Collapse all files

129
src/walkmap/edge.clj
View file

@ -4,7 +4,7 @@
nodes."
(:require [clojure.math.numeric-tower :as m]
[walkmap.polygon :refer [polygon?]]
[walkmap.vertex :refer [ensure3d vertex?]]))
[walkmap.vertex :refer [ensure2d ensure3d vertex vertex= vertex?]]))
(defn edge
"Return an edge between vertices `v1` and `v2`."
@ -36,6 +36,16 @@
#(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."
@ -52,12 +62,10 @@
(defn parallel?
"True if all `edges` passed are parallel with one another."
;; TODO: this bears being wary about, dealing with floating point arithmetic.
;; Keep an eye out for spurious errors.
[& edges]
(let [uvs (map unit-vector edges)]
(every?
#(= % (first uvs))
#(vertex= % (first uvs))
(rest uvs))))
(defn collinear?
@ -66,5 +74,116 @@
(parallel?
e1
e2
{:start (:start e1) :end (:start 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."
[e1 e2]
(when (and (edge? e1) (edge? e2))
(and
(> (minimaxd e1 :x max) (minimaxd e2 :x min))
(< (minimaxd e1 :x min) (minimaxd e2 :x max))
(> (minimaxd e1 :y max) (minimaxd e2 :y min))
(< (minimaxd e1 :y min) (minimaxd e2 :y max)))))
;; Don't think I need this.
;; (defn orientation
;; "Determine whether the ordered sequence of vertices `p`, `q` and `r` run
;; clockwise, collinear or anticlockwise in the x,y plane."
;; [p q r]
;; (let [v (- (* (- (:y q) (:y p)) (- (:x r) (:x q)))
;; (* (- (:x q) (:x p)) (- (:y r) (:y q))))]
;; (cond
;; (zero? v) :collinear
;; (pos? v) :clockwise
;; :else
;; :anticlockwise)))
(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]
(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 (:x (:start e1))
x2 (:x (:end e1))
x3 (:x (:start e2))
x4 (:x (:end e2))
y1 (:y (:start e1))
y2 (:y (:end e1))
y3 (:y (:start e2))
y4 (:y (: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]))))))

35
src/walkmap/geometry.clj
View file

@ -1,24 +1,17 @@
(ns walkmap.geometry
(:require [clojure.math.combinatorics :as combo]
[clojure.math.numeric-tower :as m]
[walkmap.edge :as e]
[walkmap.path :refer [path? polygon->path]]
[walkmap.polygon :refer [polygon?]]
[walkmap.vertex :as v]))
(defn on?
"True if the vertex `v` is on the edge `e`."
[e v]
(let [p (v/ensure3d (:start e))
q (v/ensure3d v)
r (v/ensure3d (:end e))]
(and
(e/collinear? p 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))))))
[clojure.math.numeric-tower :as m]))
(defn =ish
"True if numbers `n1`, `n2` are roughly equal; that is to say, equal to
within `tolerance` (defaults to one part in a million)."
([n1 n2]
(if (and (number? n1) (number? n2))
(let [m (m/abs (min n1 n2))
t (if (zero? m) 0.000001 (* 0.000001 m))]
(=ish n1 n2 t))
(= n1 n2)))
([n1 n2 tolerance]
(if (and (number? n1) (number? n2))
(< (m/abs (- n1 n2)) tolerance)
(= n1 n2))))

10
src/walkmap/path.clj
View file

@ -8,11 +8,11 @@
(defn path?
"True if `o` satisfies the conditions for a path. A path shall be a map
having the key `:nodes`, whose value shall be a sequence of vertices as
having the key `:vertices`, whose value shall be a sequence of vertices as
defined in `walkmap.vertex`."
[o]
(let
[v (:nodes o)]
[v (:vertices o)]
(and
(seq? v)
(> (count v) 2)
@ -25,7 +25,7 @@
[& vertices]
(if
(every? vertex? vertices)
{:nodes vertices :id (keyword (gensym "path")) :kind :path}
{:vertices vertices :id (keyword (gensym "path")) :kind :path}
(throw (IllegalArgumentException. "Each item on path must be a vertex."))))
(defn polygon->path
@ -38,7 +38,7 @@
[o]
(if
(polygon? o)
(assoc (dissoc o :vertices) :kind :path :nodes (concat (:vertices o) (list (first (:vertices o)))))
(assoc (dissoc o :vertices) :kind :path :vertices (concat (:vertices o) (list (first (:vertices o)))))
(throw (IllegalArgumentException. "Not a polygon!"))))
(defn path->edges
@ -60,7 +60,7 @@
(e/edge (first o) (rest o))
(path->edges (rest o))))
(path? o)
(path->edges (:nodes o))
(path->edges (:vertices o))
:else
(throw (IllegalArgumentException.
"Not a path or sequence of vertices!"))))

1
src/walkmap/polygon.clj
View file

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

87
src/walkmap/stl.clj
View file

@ -5,7 +5,9 @@
[me.raynes.fs :as fs]
[org.clojars.smee.binary.core :as b]
[taoensso.timbre :as l :refer [info error spy]]
[walkmap.edge :as e]
[walkmap.polygon :refer [polygon?]]
[walkmap.tag :refer [tag]]
[walkmap.vertex :as v])
(:import org.clojars.smee.binary.core.BinaryIO
java.io.DataInput))
@ -51,35 +53,76 @@
:count :uint-le
:facets (b/repeated facet)))
(defn 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 facet)
v1 (first vs)
opposite (e/edge (nth vs 1) (nth vs 2))
oc (e/centre opposite)]
(assoc
facet
:centre
(v/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 canonicalise
"Objects read in from STL won't have all the keys/values we need them to have."
[o]
(cond
(and (coll? o) (not (map? o))) (map canonicalise o)
;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
(:facets o) (assoc o
:kind :stl
:id (or (:id o) (keyword (gensym "stl")))
:facets (canonicalise (:facets o)))
;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
(:vertices o) (assoc o
:id (or (:id o) (keyword (gensym "poly")))
:kind :polygon
:vertices (canonicalise (:vertices o)))
;; if it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?`
(:x o) (v/canonicalise o)
;; shouldn't happen
:else o))
"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]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
(cond
(and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
(:facets o) (assoc o
:kind :stl
:id (or (:id o) (keyword (gensym "stl")))
:facets (canonicalise (:facets o) map-kind))
;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
(:vertices o) (centre
(tag
(assoc o
:id (or (:id o) (keyword (gensym "poly")))
:kind :polygon
:vertices (canonicalise (:vertices o) map-kind))
:facet map-kind))
;; if it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?`
(:x o) (v/canonicalise o)
;; 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.
representing its contents. `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.
**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]
(let [in (io/input-stream filename)]
(canonicalise (b/decode binary-stl in))))
([filename]
(decode-binary-stl filename :height))
([filename map-kind]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
(let [in (io/input-stream filename)]
(canonicalise (b/decode binary-stl in) map-kind))))
(defn- vect->str [prefix v]
(str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))

21
src/walkmap/superstructure.clj
View file

@ -6,6 +6,22 @@
[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.
(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
@ -14,11 +30,6 @@
2. `o` is not a map;
3. `o` does not have a value for the key `:id`;
4. `v` is not a vertex."
;; two copies of the same vertex are not identical enough to one another
;; to be used as keys in a map. So our vertices need to have ids, and we need
;; to key the vertex-index by vertex ids.
;; TODO: BUT WE CANNOT USE GENSYMED ids, because two vertices with the same
;; vertices must have the same id!
[s o v]
(if-not (v/vertex? o)
(if (:id o)

2
src/walkmap/tag.clj
View file

@ -26,7 +26,7 @@
(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
if they are not already present. It is an error (and an exception will be
thrown) if
1. `object` is not a map;

11
src/walkmap/utils.clj
View file

@ -1,6 +1,7 @@
(ns walkmap.utils
"Miscellaneous utility functions."
(:require [walkmap.path :as p]
(:require [clojure.math.numeric-tower :as m]
[walkmap.path :as p]
[walkmap.polygon :as q]
[walkmap.vertex :as v]))
@ -14,13 +15,9 @@
(defn vertices
"If `o` is an object with vertices, return those vertices, else nil."
;; TODO: it's possibly a design mistake that I'm currently distinguishing
;; between polygons and paths on the basis that one has `:vertices` and
;; the other has `:nodes`. Possibly it would be better to have a key
;; `:closed` which was `true` for polygons, `false` (or missing) for
;; paths.
[o]
(cond
(v/vertex? o) (list o)
(q/polygon? o) (:vertices o)
(p/path? o) (:nodes o)))
(p/path? o) (:vertices o)))

52
src/walkmap/vertex.clj
View file

@ -2,17 +2,32 @@
"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`.")
two vertices, create an edge from them and use `walkmap.edge/length`."
(:require [clojure.math.numeric-tower :as m]
[clojure.string :as s]
[walkmap.geometry :refer [=ish]]))
(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`."
`: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]
(cond
(and (:x o) (:y o) (:z o)) (keyword (str "vert{" (:x o) "|" (:y o) "|" (:z o) "}"))
(and (:x o) (:y o)) (keyword (str "vert{" (:x o) "|" (:y o) "}"))
:else (throw (IllegalArgumentException. "Not a vertex."))))
(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.
(subs (str "Not a vertex: " (or o "nil")) 0 80))))
"."
"-")))
(defn vertex?
"True if `o` satisfies the conditions for a vertex. That is, essentially,
@ -32,6 +47,13 @@
(or (nil? (:z o)) (number? (:z o)))
(or (nil? (:kind o)) (= (:kind o) :vertex))))
(defn vertex=
"True if vertices `v1`, `v2` represent the same vertex."
[v1 v2]
(every?
#(=ish (% v1) (% v2))
[:x :y :z]))
(defn vertex
"Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map
with those values, plus a unique `:id` value, and `:kind` set to `:vertex`.
@ -41,7 +63,8 @@
(let [v {:x x :y y :kind :vertex}]
(assoc v :id (vertex-key v))))
([x y z]
(assoc (vertex x y) :z z)))
(let [v (assoc (vertex x y) :z z)]
(assoc v :id (vertex-key v)))))
(defn canonicalise
"If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`,
@ -54,7 +77,12 @@
(number? (:y o))
(or (nil? (:z o)) (number? (:z o))))
(assoc o :kind :vertex :id (vertex-key o))
(throw (IllegalArgumentException. "Not a proto-vertex: must have numeric `:x` and `:y`."))))
(throw
(IllegalArgumentException.
(subs
(str "Not a proto-vertex: must have numeric `:x` and `:y`: "
(or o "nil"))
0 80)))))
(def ensure3d
"Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise
@ -68,7 +96,9 @@
(ensure3d o 0.0))
([o dflt]
(cond
(not (vertex? o)) (throw (IllegalArgumentException. "Not a vertex!"))
(not (vertex? o)) (throw
(IllegalArgumentException.
(subs (str "Not a vertex: " (or o "nil")) 0 80)))
(:z o) o
:else (assoc o :z dflt))))))
@ -79,4 +109,6 @@
(if
(vertex? o)
(assoc o :z 0.0)
(throw (IllegalArgumentException. "Not a vertex!"))))))
(throw
(IllegalArgumentException.
(subs (str "Not a vertex: " (or o "nil")) 0 80)))))))