A poor man’s interval tree
Sorted collections can be put to good (ab)use, here I define interval-lt
a partial order on intervals and points — where an interval is a vector [from to]
(from
inclusive, to
exclusive; they can be nil
to denote infinity) and a point is [n n]
.
(defn interval-lt [[a b] [c d]] (boolean (and b c (if (= a b) (neg? (compare b c)) (<= (compare b c) 0)))))
Using this partial order and a sorted-map, I can build an interval tree:
(def empty-interval-map (sorted-map-by interval-lt [nil nil] #{})) (defn- isplit-at [interval-map x] (if x (let [[[a b :as k] vs] (find interval-map [x x])] (if (or (= a x) (= b x)) interval-map (-> interval-map (dissoc k) (assoc [a x] vs [x b] vs)))) interval-map)) (defn- ialter [interval-map from to f & args] (let [interval-map (-> interval-map (isplit-at from) (isplit-at to)) kvs (for [[r vs] (cond (and from to) (subseq interval-map >= [from from] < [to to]) from (subseq interval-map >= [from from]) to (subseq interval-map < [to to]) :else interval-map)] [r (apply f vs args)])] (into interval-map kvs))) (defn iassoc [interval-map from to v] (ialter interval-map from to conj v)) (defn idissoc [interval-map from to v] (ialter interval-map from to disj v)) (defn iget [interval-map x] (get interval-map [x x]))
Demo, let’s state who’s present and at which time:
(-> empty-interval-map (iassoc 9 17 "Ethel") (iassoc 7 12 "Lucy") (iassoc 11 20 "Fred")) ; {[nil 7] #{}, [7 9] #{"Lucy"}, ; [9 11] #{"Ethel" "Lucy"}, ; [11 12] #{"Ethel" "Fred" "Lucy"}, ; [12 17] #{"Ethel" "Fred"}, ; [17 20] #{"Fred"}, ; [29 nil] #{}}
And now one can query by time:
(iget *1 8) ; #{"Lucy"} (iget *2 15) ; #{"Ethel" "Fred"} (iget *3 20) ; #{}
Sure, this is not the best interval tree implementation ever, it suffers from severe fragmentation and not ideal update complexity. However if what only matters is lookup, it works nicely in O(log n) — each iassoc
adds at most two entries to the map so for n intervals you have at most 1+2n entries, lookup is O(log (2n+1)), that is O(log n).