luciano/reitit
1
0
Fork 0
mirror of https://github.com/metosin/reitit.git synced 2025-12-17 16:31:11 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Re-implement using reified protocols

Browse source 
* tree can be optimzied on the fly!
This commit is contained in:
Tommi Reiman 2017-11-07 20:30:26 +02:00
parent 07861f43f9
commit eeea39ca83
1 changed files with 80 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

159
perf-test/clj/reitit/trie.cljc
View file

@ -10,6 +10,8 @@
;; Prefix-tree-router ;; Prefix-tree-router
;; ;;
(declare insert)
(defn- char-key (defn- char-key
"Return the single character child key for the string started at "Return the single character child key for the string started at
index i." index i."
@ -17,42 +19,79 @@
(if (< i (count s)) (if (< i (count s))
(subs s i (inc i)))) (subs s i (inc i))))
(defprotocol Lookup (defn- maybe-wild-node [children]
(lookup [this path params])) (get children ":"))
(extend-protocol Lookup (defn- maybe-catch-all-node [children]
(get children "*"))
(defprotocol Node
(lookup [this path params])
(get-segment [this])
(update-segment [this subs lcs])
(add-child [this key child])
(insert-child [this key path-spec o]))
(extend-protocol Node
nil nil
(lookup [_ _ _])) (lookup [_ _ _])
(get-segment [this]))
(defrecord WildNode [segment children param wild catch] (defn wild-node [segment param children]
Lookup (let [?wild (maybe-wild-node children)
(lookup [this path params] ?catch (maybe-catch-all-node children)
#_(println "w=>" segment "..." path) children' (impl/fast-map children)]
(let [i (.indexOf ^String path "/")] (reify
(if (pos? i) Node
(let [value (subs path 0 i)] (lookup [this path params]
(let [childs [(impl/fast-get children (char-key path (inc i))) wild catch] #_(println "w=>" segment "..." path)
path' (subs path (inc i)) (let [i (.indexOf ^String path "/")]
params (assoc params param value)] (if (pos? i)
(some #(lookup % path' params) childs))) (let [value (subs path 0 i)]
(assoc params param path))))) (let [childs [(impl/fast-get children' (char-key path (inc i))) ?wild ?catch]
path' (subs path (inc i))
params (assoc params param value)]
(some #(lookup % path' params) childs)))
(assoc params param path))))
(get-segment [this]
segment)
(add-child [this key child]
(wild-node segment param (assoc children key child)))
(insert-child [this key path-spec o]
(wild-node segment param (update children key insert path-spec o))))))
(defrecord CatchAllNode [segment children param] (defn catch-all-node [segment children param]
Lookup (reify
(lookup [this path params] Node
(assoc params param path))) (lookup [this path params]
(assoc params param path))
(get-segment [this]
segment)))
(defrecord StaticNode [^String segment ^Integer size children wild catch] (defn static-node [^String segment children]
Lookup (let [size (count segment)
(lookup [this path params] ?wild (maybe-wild-node children)
#_(println "s=>" segment "..." path) ?catch (maybe-catch-all-node children)
(if (.equals segment path) children' (impl/fast-map children)]
params (reify
(let [p (if (>= (count path) size) (subs path 0 size))] Node
(if (.equals segment p) (lookup [this path params]
(let [childs [(impl/fast-get children (char-key path size)) wild catch] #_(println "s=>" segment "..." path)
path (subs path size)] (if (.equals segment path)
(some #(lookup % path params) childs))))))) params
(let [p (if (>= (count path) size) (subs path 0 size))]
(if (.equals segment p)
(let [childs [(impl/fast-get children' (char-key path size)) ?wild ?catch]
path (subs path size)]
(some #(lookup % path params) childs))))))
(get-segment [this]
segment)
(update-segment [this subs lcs]
(static-node (subs segment lcs) children))
(add-child [this key child]
(static-node segment (assoc children key child)))
(insert-child [this key path-spec o]
(static-node segment (update children key insert path-spec o))))))
(defn- wild? [s] (defn- wild? [s]
(contains? #{\: \*} (first s))) (contains? #{\: \*} (first s)))
@ -98,33 +137,13 @@
[segment o] [segment o]
(cond (cond
(wild-param? segment) (wild-param? segment)
(map->WildNode (wild-node segment (keyword (subs segment 1)) nil)
{:segment segment
:param (keyword (subs segment 1))})
(catch-all-param? segment) (catch-all-param? segment)
(map->CatchAllNode (catch-all-node segment (keyword (subs segment 1)) nil)
{:segment segment
:param (keyword (subs segment 1))})
:else :else
(map->StaticNode (static-node segment nil)))
{:segment segment})))
(defn- add-child
"Given a tree node, a single char string key and a child node,
return a new tree where this node has this child."
[node key child]
(assoc-in node [:children key] child))
(declare insert)
(defn- insert-child
"Given a tree node, a single char string key, a path-spec string and
a payload object, return a tree where this object has been instered
at path-spec under this node."
[node key path-spec o]
(update-in node [:children key] insert path-spec o))
(defn- new-node (defn- new-node
"Given a path-spec and a payload object, return a new tree node. If "Given a path-spec and a payload object, return a new tree node. If
@ -138,7 +157,7 @@
(throw (ex-info "catch-all may only appear at the end of a path spec" (throw (ex-info "catch-all may only appear at the end of a path spec"
{:patch-spec path-spec}))) {:patch-spec path-spec})))
(-> (make-node segment nil) (-> (make-node segment nil)
(add-child (subs (:segment child) 0 1) child))) (add-child (subs (get-segment child) 0 1) child)))
(let [segment (last parts)] (let [segment (last parts)]
(make-node segment o)) (make-node segment o))
(reverse (butlast parts)))) (reverse (butlast parts))))
@ -166,23 +185,21 @@
lcs is the index of the longest common string in path-spec and the lcs is the index of the longest common string in path-spec and the
segment of node." segment of node."
[node path-spec o lcs] [node path-spec o lcs]
(let [segment (:segment node) (let [segment (get-segment node)
common (subs path-spec 0 lcs) common (subs path-spec 0 lcs)
parent (new-node common nil)] parent (new-node common nil)]
(if (= common path-spec) (if (= common path-spec)
(-> parent (-> parent
(add-child (char-key segment lcs) (add-child (char-key segment lcs) (update-segment node subs lcs)))
(update-in node [:segment] subs lcs)))
(-> parent (-> parent
(add-child (char-key segment lcs) (add-child (char-key segment lcs) (update-segment node subs lcs))
(update-in node [:segment] subs lcs))
(insert-child (char-key path-spec lcs) (subs path-spec lcs) o))))) (insert-child (char-key path-spec lcs) (subs path-spec lcs) o)))))
(defn insert (defn insert
"Given a tree node, a path-spec and a payload object, return a new "Given a tree node, a path-spec and a payload object, return a new
tree with payload inserted." tree with payload inserted."
[node path-spec o] [node path-spec o]
(let [segment (:segment node)] (let [segment (get-segment node)]
(cond (nil? node) (cond (nil? node)
(new-node path-spec o) (new-node path-spec o)
@ -217,23 +234,6 @@
:else :else
(split node path-spec o lcs)))))) (split node path-spec o lcs))))))
(defn optimize [tree]
(walk/postwalk
(fn [x]
(if (or (instance? StaticNode x)
(instance? WildNode x))
(let [wild-child (get-in x [:children ":"])
catch-all-child (get-in x [:children "*"])]
(cond-> x
wild-child (-> (assoc :wild wild-child)
(update :children dissoc ":"))
catch-all-child (-> (assoc :catch catch-all-child)
(update :children dissoc "*"))
(:segment x) (assoc :size (-> x :segment count))
true (update :children impl/fast-map)))
x))
tree))
;; ;;
;; testing ;; testing
;; ;;
@ -301,7 +301,7 @@
(cc/quick-bench (dotimes [_ 1000] (p/lookup tree-old "/v1/orgs/1/topics")))) (cc/quick-bench (dotimes [_ 1000] (p/lookup tree-old "/v1/orgs/1/topics"))))
(comment (comment
(def tree-new (optimize (reduce (fn [acc [p d]] (insert acc p d)) nil routes))) (def tree-new (reduce (fn [acc [p d]] (insert acc p d)) nil routes))
;; 3.1ms ;; 3.1ms
;; 2.5ms (string equals) ;; 2.5ms (string equals)
@ -314,4 +314,5 @@
;; 1.4ms (precalculate segment-size) ;; 1.4ms (precalculate segment-size)
;; 1.3ms (fast-map) ;; 1.3ms (fast-map)
;; 1.3ms (dissoc wild & catch-all from children) ;; 1.3ms (dissoc wild & catch-all from children)
;; 1.3ms (reified protocols)
(cc/quick-bench (dotimes [_ 1000] (lookup tree-new "/v1/orgs/1/topics" {})))) (cc/quick-bench (dotimes [_ 1000] (lookup tree-new "/v1/orgs/1/topics" {}))))