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

Massive code clean-up, all tests still pass.

Browse source 
...but I'm still struggling to understand how it works and how I use it. Memo to self: document your code better.
This commit is contained in:
Simon Brooke 2024-04-08 22:36:10 +01:00
parent 156775fc79
commit cb5041e684
11 changed files with 235 additions and 250 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/cc/journeyman/walkmap/edge.clj
View file

@ -3,7 +3,6 @@
An edge is a line segment having just a start and an end, with no intervening
nodes."
(:require [clojure.math.numeric-tower :as m]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :refer [canonicalise check-vertex ensure2d ensure3d vertex vertex= vertex?]]))
(defn edge
@ -149,7 +148,7 @@
not an edge."
([e1 e2]
(intersection2d e1 e2 :x :y :z))
([e1 e2 c1 c2 c3]
([e1 e2 c1 c2 _c3]
(if (and (edge? e1) (edge? e2))
(when
(overlaps2d? e1 e2) ;; relatively cheap check

52
src/cc/journeyman/walkmap/microworld.clj
View file

@ -2,36 +2,36 @@
"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]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.polygon :as p :only [rectangle]]
(:require [cc.journeyman.walkmap.polygon :refer [rectangle]]
[cc.journeyman.walkmap.superstructure :refer [store]]
[cc.journeyman.walkmap.tag :as t :only [tag]]
[cc.journeyman.walkmap.vertex :as v :only [check-vertex vertex vertex?]]
[cc.journeyman.walkmap.utils :as u :only [truncate]]))
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.vertex :refer [check-vertex vertex]]
[cc.journeyman.walkmap.utils :refer [truncate]]
[clojure.edn :as edn :only [read]]
[clojure.java.io :refer [reader]]
[taoensso.timbre :refer [error]])
(:import [clojure.lang Keyword Map]
[java.io PushbackReader]))
(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
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->polygon cell (vertex 1 1 1)))
([cell scale-vector]
(t/tag
(tag
(assoc
(merge
cell
(let [w (* (:x cell) (:x (v/check-vertex scale-vector)))
(let [w (* (:x cell) (:x (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))))
(rectangle
(vertex s w z)
(vertex n e z))))
:walkmap.id/id
(keyword (gensym "mw-cell")))
(:state cell))))
@ -42,23 +42,23 @@
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]
([^String filename]
(load-microworld-edn filename :mw))
([filename map-kind]
([^String filename ^Keyword map-kind]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(u/truncate
(str "Must be a keyword: " (or map-kind "nil")) 80))))
(truncate
(format "Must be a keyword: %s." (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]
([^String filename ^Keyword mapkind ^Map superstucture]
(load-microworld-edn filename mapkind superstucture (vertex 1 1 1)))
([^String filename ^Keyword _map-kind ^Map superstructure ^Map _scale-vertex]
(let [mw (try
(with-open [r (io/reader filename)]
(edn/read (java.io.PushbackReader. r)))
(with-open [r (reader filename)]
(edn/read (PushbackReader. r)))
(catch RuntimeException e
(l/error "Error parsing edn file '%s': %s\n"
(error "Error parsing edn file '%s': %s\n"
filename (.getMessage e))))
polys (reduce
concat

8
src/cc/journeyman/walkmap/path.clj
View file

@ -2,11 +2,9 @@
"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]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.polygon :refer [check-polygon polygon?]]
[cc.journeyman.walkmap.tag :refer [tag tags]]
[cc.journeyman.walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
(:require [cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.polygon :refer [polygon?]]
[cc.journeyman.walkmap.utils :refer [check-kind-type check-kind-type-seq]]
[cc.journeyman.walkmap.vertex :refer [check-vertices vertex?]]))
(defn path?

2
src/cc/journeyman/walkmap/polygon.clj
View file

@ -139,7 +139,7 @@
projection of this rectangle on that plane?"
[vertex rectangle]
(let [xo (sort-by :x (:vertices rectangle))
yo (sort-by :x (:vertices rectangle))]
yo (sort-by :y (:vertices rectangle))]
(and
(< (:x (first xo)) (:x vertex) (:x (last xo)))
(< (:y (first yo)) (:y vertex) (:y (last yo))))))

9
src/cc/journeyman/walkmap/read_svg.clj
View file

@ -1,16 +1,11 @@
(ns cc.journeyman.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]
(:require [clojure.java.io :as io]
[clojure.string :as s]
[clojure.xml :as x]
[clojure.zip :as z]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.path :refer [path]]
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.utils :refer [kind-type truncate]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex?]]))
(defn upper-case?
@ -91,7 +86,7 @@
;; quite small XML files. So I've implemented my own solution.
([file-name]
(read-svg file-name nil))
([file-name map-kind]
([file-name _map-kind]
(let [xml (x/parse (io/file file-name))
paths (progeny xml #(= (:tag %) :path))]
(remove nil? (map path-elt->path paths)))))

81
src/cc/journeyman/walkmap/routing.clj
View file

@ -1,16 +1,15 @@
(ns cc.journeyman.walkmap.routing
"Finding optimal routes to traverse a map."
(:require [clojure.math.numeric-tower :as m :only [expt]]
(:require [clojure.math.numeric-tower :refer [expt]]
[clojure.set :refer [intersection]]
[clojure.string :as cs :only [join]]
[search.core :refer [a*]]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.superstructure :as s]
[cc.journeyman.walkmap.tag :as t]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v]))
[cc.journeyman.walkmap.tag :refer [tags]]
[cc.journeyman.walkmap.vertex :as v]
[search.core :refer [a*]]
[taoensso.timbre :refer [debug]]))
;; 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.
@ -37,25 +36,30 @@
of traversals. Dynamic, because we will want to tune this."
-2)
(def ^:dynamic *untraversable*
"The set of all tags which may indicate that a polygon should not be
traversed."
#{:no-traversal})
(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))))
(q/polygon? object)
(:centre object)
(empty? (intersection (tags object) *untraversable*))))
(declare traversal-cost)
(defn vertices-traversal-cost
[vertices s]
(reduce
+
(map
#(traversal-cost %1 %2 s)
(v/check-vertices vertices)
(rest vertices))))
+
(map
#(traversal-cost %1 %2 s)
(v/check-vertices vertices)
(rest vertices))))
(defn path-traversal-cost
[path s]
@ -64,7 +68,8 @@
(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]
[from to _s]
(debug (format "barriers-crossed called with vertices\n\tfrom: %s\n\tto: %s" from to))
;; TODO: implement
'())
@ -74,7 +79,8 @@
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]
[barrier from to _s]
(debug (format "crossing-penalty called with arguments\n\tbarrier: %s\n\tfrom: %s\n\tto: %s" barrier from to))
;; TODO: implement
0)
@ -83,7 +89,7 @@
[edge]
(let [g (:z (e/unit-vector edge))]
(if (pos? g)
(m/expt (inc g) *gradient-exponent*)
(expt (inc g) *gradient-exponent*)
1)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0)))
@ -98,10 +104,10 @@
[from to s]
(let [f (fn [v] (set (s/touching v p/path? s)))]
(first
(sort-by
(sort-by
;;; I... chose the path more travelled by.
#(or (:traversals %) 0)
(filter traversable? (intersection (f from) (f to)))))))
#(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`,
@ -112,7 +118,7 @@
[from to s]
(let [best (best-road from to s)]
(when (:traversals best)
(m/expt (:traversals best) *traversals-exponent*))))
(expt (:traversals best) *traversals-exponent*))))
(defn traversal-cost
"Return the traversal cost of the edge represented by the vertices `from`,
@ -125,14 +131,14 @@
(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)))))
(+
(* 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}
@ -154,11 +160,11 @@
([frontier candidates]
(extend-frontier frontier candidates nil))
([frontier candidates rejects]
(if
(if
(empty? frontier)
candidates
(let [fs (set (concat frontier rejects))]
(concat frontier (remove fs candidates))))))
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))
@ -176,11 +182,10 @@
[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]))))
(Exception.
(format "Unable to find walkable facet within %s of %s"
search-radius
target))))
r))
(defn route

57
src/cc/journeyman/walkmap/stl.clj
View file

@ -1,19 +1,18 @@
(ns cc.journeyman.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]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.ocean :as o]
[cc.journeyman.walkmap.polygon :refer [centre gradient polygon?]]
[cc.journeyman.walkmap.superstructure :refer [store]]
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v])
(:import org.clojars.smee.binary.core.BinaryIO
java.io.DataInput))
(:require
[cc.journeyman.walkmap.ocean :refer [ocean?]]
[cc.journeyman.walkmap.polygon :refer [centre gradient polygon?]]
[cc.journeyman.walkmap.superstructure :refer [store]]
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.utils :refer [truncate]]
[cc.journeyman.walkmap.vertex :as v]
[clojure.lang.io :refer [input-stream]]
[clojure.string :as s]
[me.raynes.fs :refer [base-name split-ext]]
[org.clojars.smee.binary.core :as b]
[taoensso.timbre :refer [debug]])
(:import [clojure.lang Keyword]))
(defn stl?
"True if `o` is recogniseable as an STL structure. An STL structure must
@ -64,13 +63,13 @@
(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]
([o ^Keyword map-kind]
(canonicalise o map-kind (v/vertex 1 1 1)))
([o map-kind scale-vertex]
([o ^Keyword map-kind scale-vertex]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
(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?`
@ -92,13 +91,13 @@
(:vertices o)
map-kind))
:facet map-kind)))]
(if (o/ocean? f)
(if (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
(if (v/vertex? scale-vertex)
(v/vertex* c scale-vertex)
c))
;; shouldn't happen
@ -122,18 +121,14 @@
**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]
([^String 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))))
([^String filename ^Keyword map-kind]
(decode-binary-stl filename map-kind nil))
([filename mapkind superstucture]
([^String filename ^Keyword 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)
([^String filename ^Keyword map-kind superstructure scale-vertex]
(let [in (input-stream filename)
stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
(if
(map? superstructure)
@ -175,12 +170,12 @@
"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)]
(let [b (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)
(debug "Solid name is " solidname)
(spit
filename
(stl->ascii stl solidname))))
@ -190,7 +185,7 @@
`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)]
(let [[_ ext] (split-ext in-filename)]
(binary-stl-to-ascii
in-filename
(str

167
src/cc/journeyman/walkmap/superstructure.clj
View file

@ -3,15 +3,16 @@
(:require [clojure.walk :refer [postwalk]]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.edge :refer [edge length]]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
;; [cc.journeyman.walkmap.path :as p]
;; [cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v]))
[cc.journeyman.walkmap.vertex :as v])
(:import [clojure.lang IFn Map]))
;; 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,
;; 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.
@ -31,14 +32,14 @@
[o]
(when (map? o)
(reduce
concat
(remove
nil?
(map
#(cond
(v/vertex? %) (list %)
(and (coll? %) (every? v/vertex? %)) %)
(vals o))))))
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)
@ -53,7 +54,7 @@
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]
[^Map s ^Map o ^Map v]
(if-not (v/vertex? o)
(if (:walkmap.id/id o)
(if (v/vertex? v)
@ -77,14 +78,14 @@
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)))}))
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
@ -99,17 +100,17 @@
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)))
(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
: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)
@ -132,9 +133,9 @@
(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)
(: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)))
@ -145,9 +146,9 @@
`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)))
(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)))
@ -161,22 +162,22 @@
1. `s` is not a map;
2. `o` is not a recognisable walkmap object"
([o]
([^Map o]
(store o {}))
([o s]
([^Map o ^Map s]
(when-not (:walkmap.id/id o)
(throw
(IllegalArgumentException.
(str "Not a walkmap object: no value for `:walkmap.id/id`: "
(u/kind-type o)))))
(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)))))
(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))))
(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
@ -188,14 +189,14 @@
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]
([^Map s ^Map minv ^Map 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))))))
#(v/within-box? % minv' maxv')
(filter #(= (:kind %) :vertex) (vals s))))))
(defn nearest
"Search superstructure `s` for the nearest object matching `filter-fn` to
@ -205,68 +206,72 @@
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
([^Map s ^Map target ^Number radius]
(nearest s target :centre radius))
([^Map s ^Map target ^IFn filter-fn ^Number radius]
(let [minv (v/vertex
(- (:x (v/check-vertex target)) radius)
(- (:y target) radius) (- (or (:z target) 0) radius))
maxv (v/vertex
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
(first
(sort-by
#(length (edge target (:centre %)))
#(length (edge target (:centre %)))
(filter
filter-fn
(filter
:centre
(map #(retrieve % s)
: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)
(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))))))))))))
(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 vertex ^Map s]
(map
#(retrieve % s)
(set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys))))
([vertex filter-fn s]
#(retrieve % s)
(set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys))))
([^Map vertex ^IFn filter-fn ^Map s]
(filter
filter-fn
(touching vertex s))))
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]
([^Map target ^Map s]
(neighbours target identity s))
([^Map target ^IFn filter-fn ^Map s]
(remove
#(= target %)
(reduce
concat
(remove
nil?
(map #(touching % filter-fn s) (vertices target)))))))
#(= 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]
([^Map target ^Map s]
(neighbour-ids target identity s))
([target filter-fn s]
([^Map target ^IFn filter-fn ^Map s]
(map :walkmap.id/id (neighbours target filter-fn s))))

14
src/cc/journeyman/walkmap/svg.clj
View file

@ -2,16 +2,12 @@
"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]
(:require [clojure.string :as s]
[dali.io :as neatly-folded-clock]
[hiccup.core :refer [html]]
[taoensso.timbre :as l :refer [info error spy]]
[taoensso.timbre :refer [info]]
[cc.journeyman.walkmap.ocean :refer [cull-ocean-facets]]
[cc.journeyman.walkmap.polygon :refer [polygon?]]
[cc.journeyman.walkmap.stl :refer [decode-binary-stl]]
[cc.journeyman.walkmap.vertex :refer [vertex?]]))
[cc.journeyman.walkmap.stl :refer [decode-binary-stl]]))
(def ^:dynamic *preferred-svg-render*
"Mainly for debugging dali; switch SVG renderer to use. Expected values:
@ -88,7 +84,7 @@
(map
#(reduce max (map :y (:vertices %)))
(:facets stl)))]
(l/info "Generating SVG for " *preferred-svg-render* " renderer")
(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)
@ -102,7 +98,7 @@
(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")
(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))

18
src/cc/journeyman/walkmap/tag.clj
View file

@ -4,7 +4,8 @@
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]
[cc.journeyman.walkmap.utils :refer [kind-type]]))
[cc.journeyman.walkmap.utils :refer [kind-type]])
(:import [clojure.lang Map]))
(defn tagged?
"True if this `object` is tagged with each of these `tags`. It is an error
@ -12,10 +13,7 @@
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)))))
[^Map object & tags]
(let [tags' (flatten tags)]
(when-not (every? keyword? tags')
(throw (IllegalArgumentException.
@ -35,11 +33,8 @@
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]
[^Map 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.
@ -57,10 +52,7 @@
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)))))
[^Map object & tags]
(let [tags' (flatten tags)]
(when-not (every? keyword? tags')
(throw (IllegalArgumentException.

72
src/cc/journeyman/walkmap/utils.clj
View file

@ -3,16 +3,16 @@
(:require [clojure.edn :as edn :only [read]]
[clojure.java.io :as io]
[clojure.math.numeric-tower :as m]
[clojure.set :refer [union]]
[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)
(let [tags (apply union (map :cc.journeyman.walkmap.tag/tags vals))]
(assoc (apply merge-with deep-merge vals) :cc.journeyman.walkmap.tag/tags tags))
(last vals)))
(defn truncate
@ -27,20 +27,20 @@
"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\"."
messages, 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]
([^Number n1 ^Number 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]
([^Number n1 ^Number n2 ^Number tolerance]
(if (and (number? n1) (number? n2))
(< (m/abs (- n1 n2)) tolerance)
(= n1 n2))))
@ -55,18 +55,18 @@
([object expected]
`(if-not (= (kind-type ~object) ~expected)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected" ~expected "but found" (kind-type ~object)])))
(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)])))
(IllegalArgumentException.
(s/join
" "
["Expected" ~expected "but found" (kind-type ~object)])))
~object)))
(defmacro check-kind-type-seq
@ -77,29 +77,29 @@
Macro, so that the exception is thrown from the calling function."
([s expected]
`(if-not (every? #(= (kind-type %) ~expected) ~s)
(throw
`(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/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
`(if-not (every? #(~checkfn %) ~s)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected sequence of"
~expected
"but found ("
(s/join ", " (remove #(= ~expected %) (map kind-type ~s)))
")"])))
~s)))
(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)."
@ -115,5 +115,5 @@
(defn not-yet-implemented
[message]
(throw
(UnsupportedOperationException.
(str "Not yet implemented: " message))))
(UnsupportedOperationException.
(str "Not yet implemented: " message))))