diff --git a/src/walkmap/routing.clj b/src/walkmap/routing.clj new file mode 100644 index 0000000..b925341 --- /dev/null +++ b/src/walkmap/routing.clj @@ -0,0 +1,18 @@ +(ns walkmap.core + "Finding optimal routes to traverse a map." + (:require [walkmap.path :as p] + [walkmap.polygon :as q] + [walkmap.stl :as s] + [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 diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj new file mode 100644 index 0000000..aacab67 --- /dev/null +++ b/src/walkmap/tag.clj @@ -0,0 +1,50 @@ +(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]])) + +(defn tagged? + "True if this `object` is tagged with each of these `tags`." + [object & tags] + (if + (map? object) + (if + (every? keyword? tags) + (let [ot (::tags object)] + (and + (set? ot) + (every? ot tags) + true)) + (throw (IllegalArgumentException. + (str "Must be keyword(s): " (map type tags))))) + (throw (IllegalArgumentException. + (str "Must be a map: " (type object)))))) + +(defn tag + "Return an object like this `object` but with these `tags` added to its tags, + if they are not already present." + [object & tags] + (if + (map? object) + (if + (every? keyword? tags) + (assoc object ::tags (union (set tags) (::tags object))) + (throw (IllegalArgumentException. + (str "Must be keyword(s): " (map type tags))))) + (throw (IllegalArgumentException. + (str "Must be a map: " (type object)))))) + +(defn untag + "Return an object like this `object` but with these `tags` removed from its + tags, if present." + [object & tags] + (if + (map? object) + (if + (every? keyword? tags) + (assoc object ::tags (difference (::tags object) (set tags))) + (throw (IllegalArgumentException. + (str "Must be keywords: " (map type tags))))) + (throw (IllegalArgumentException. + (str "Must be a map: " (type object)))))) diff --git a/test/walkmap/tag_test.clj b/test/walkmap/tag_test.clj new file mode 100644 index 0000000..9f0a269 --- /dev/null +++ b/test/walkmap/tag_test.clj @@ -0,0 +1,45 @@ +(ns walkmap.tag-test + (:require [clojure.test :refer :all] + [walkmap.tag :refer :all])) + +(deftest tag-tests + (testing "Tagging" + (is (set? (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz))) + "The value of `:walkmap.tag/tags should be a set.") + (is (= (count (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz))) 4) + "All the tags passed should be added.") + (is (:walkmap.tag/tags (tag {} :foo :bar :ban :froboz) :ban) + "`:ban` should be present in the set, and, as it is a set, it + should be valid to apply it to a keyword.") + (is (not ((:walkmap.tag/tags (tag {} :foo :bar :ban :froboz)) :cornflakes)) + "`:cornflakes should not be present.") + (is (true? (tagged? (tag {} :foo :bar :ban :froboz) :bar)) + "`tagged?` should return an explicit `true`, not any other value.") + (is (tagged? (tag {} :foo :bar :ban :froboz) :bar :froboz) + "We should be able to test for the presence of more than one tag") + (is (= (tagged? (tag {} :foo :bar :ban :froboz) :bar :cornflakes) false) + "If any of the queried tags is missing, false should be returned") + (is (tagged? (tag (tag {} :foo) :bar) :foo :bar) + "We should be able to add tags to an already tagged object") + (is (false? (tagged? (tag {} :foo :bar) :cornflakes)) + "`tagged?` should return an explicit `false` if a queried tag is missing.") + (let [object (tag {} :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 {} :foo "bar" :ban)) + "An exception should be thrown if any of `tags` is not a keyword: `tag`.") + (is (thrown? IllegalArgumentException (tagged? {} :foo "bar" :ban)) + "An exception should be thrown if any of `tags` is not a keyword: `tagged?`.") + (is (thrown? IllegalArgumentException (untag {} :foo "bar" :ban)) + "An exception should be thrown if any of `tags` is not a keywordp: `untag`."))) +