In the afternoon, he implemented tagging.
And he looked on his work, and saw that it was good.
This commit is contained in:
parent
f4ca49f11b
commit
9ee365b987
18
src/walkmap/routing.clj
Normal file
18
src/walkmap/routing.clj
Normal file
|
@ -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
|
50
src/walkmap/tag.clj
Normal file
50
src/walkmap/tag.clj
Normal file
|
@ -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))))))
|
45
test/walkmap/tag_test.clj
Normal file
45
test/walkmap/tag_test.clj
Normal file
|
@ -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`.")))
|
||||||
|
|
Loading…
Reference in a new issue