THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.
36 | 37 |1. DEFINITIONS
38 | 39 |"Contribution" means:
40 | 41 |a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and
43 |b) in the case of each subsequent Contributor:
44 |i) changes to the Program, and
45 |ii) additions to the Program;
46 |where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.
54 | 55 |"Contributor" means any person or entity that distributes 56 | the Program.
57 | 58 |"Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.
61 | 62 |"Program" means the Contributions distributed in accordance 63 | with this Agreement.
64 | 65 |"Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.
67 | 68 |2. GRANT OF RIGHTS
69 | 70 |a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.
76 | 77 |b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.
88 | 89 |c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.
101 | 102 |d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.
105 | 106 |3. REQUIREMENTS
107 | 108 |A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:
110 | 111 |a) it complies with the terms and conditions of this 112 | Agreement; and
113 | 114 |b) its license agreement:
115 | 116 |i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;
120 | 121 |ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;
124 | 125 |iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and
128 | 129 |iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.
133 | 134 |When the Program is made available in source code form:
135 | 136 |a) it must be made available under this Agreement; and
137 | 138 |b) a copy of this Agreement must be included with each 139 | copy of the Program.
140 | 141 |Contributors may not remove or alter any copyright notices contained 142 | within the Program.
143 | 144 |Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.
147 | 148 |4. COMMERCIAL DISTRIBUTION
149 | 150 |Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.
172 | 173 |For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.
183 | 184 |5. NO WARRANTY
185 | 186 |EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.
197 | 198 |6. DISCLAIMER OF LIABILITY
199 | 200 |EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
208 | 209 |7. GENERAL
210 | 211 |If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.
216 | 217 |If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.
223 | 224 |All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.
232 | 233 |Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.
252 | 253 |This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.
258 | 259 | 260 | 261 | 262 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/avl_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.data.avl-test 2 | (:use clojure.test) 3 | (:require [clojure.data.avl :as avl])) 4 | 5 | 6 | (defmacro deftreesize [name default] 7 | `(def ~name 8 | (if-let [size# (System/getProperty 9 | ~(str "org.clojure.data.avl.test." name))] 10 | (Long/parseLong size#) 11 | ~default))) 12 | 13 | (deftreesize small-tree-size 150) 14 | (deftreesize medium-tree-size 2500) 15 | (deftreesize large-tree-size 10000) 16 | 17 | (defn validate-invariant [^clojure.data.avl.IAVLTree coll] 18 | (let [tree (.getTree coll) 19 | h (fn [^clojure.data.avl.IAVLNode node] 20 | (if node 21 | (.getHeight node) 22 | 0))] 23 | (or (nil? tree) 24 | (boolean 25 | (#{-1 0 1} (- (h (.getLeft tree)) (h (.getRight tree)))))))) 26 | 27 | (defn twice [x] 28 | [x x]) 29 | 30 | (def ks (range large-tree-size)) 31 | (def ksks (doall (interleave ks ks))) 32 | (def ks' (doall (map first (partition 2 ks)))) 33 | 34 | (def rb-map (apply sorted-map ksks)) 35 | (def avl-map (apply avl/sorted-map ksks)) 36 | 37 | (def rb-set (apply sorted-set ks)) 38 | (def avl-set (apply avl/sorted-set ks)) 39 | 40 | (def rb-map-by-> (apply sorted-map-by > ksks)) 41 | (def avl-map-by-> (apply avl/sorted-map-by > ksks)) 42 | 43 | (def rb-set-by-> (apply sorted-set-by > ks)) 44 | (def avl-set-by-> (apply avl/sorted-set-by > ks)) 45 | 46 | (def even-numbers (apply avl/sorted-set (range 0 large-tree-size 2))) 47 | 48 | (defn is-same-coll [a b] 49 | (let [msg (format "(class a)=%s (class b)=%s a=%s b=%s" 50 | (.getName (class a)) (.getName (class b)) a b) 51 | size (fn [x] 52 | (if (map? x) 53 | (.size ^java.util.Map x) 54 | (.size ^java.util.Set x)))] 55 | (is (= (count a) (count b) (size a) (size b)) msg) 56 | (is (= a b) msg) 57 | (is (= b a) msg) 58 | (is (.equals ^Object a b) msg) 59 | (is (.equals ^Object b a) msg) 60 | (is (= (hash a) (hash b)) msg) 61 | (is (= (.hashCode ^Object a) (.hashCode ^Object b)) msg))) 62 | 63 | (deftest sanity-checks 64 | (testing "AVL collections look like regular sorted collections" 65 | (is-same-coll rb-map avl-map) 66 | (is-same-coll rb-set avl-set) 67 | ;; Check empty maps are equal, and hashes equal 68 | (is-same-coll (empty rb-map) (empty avl-map)) 69 | (is-same-coll (empty rb-set) (empty avl-set))) 70 | (testing "AVL collections with custom comparators looks like regular ones" 71 | (is-same-coll rb-map-by-> avl-map-by->) 72 | (is-same-coll rb-set-by-> avl-set-by->)) 73 | (testing "AVL collection seqs look like regular sorted collection seqs" 74 | (is (= (seq rb-map) (seq avl-map))) 75 | (is (= (seq rb-set) (seq avl-set))) 76 | (is (= (subseq rb-map > 100 < 1000) (subseq avl-map > 100 < 1000))) 77 | (is (= (subseq rb-set > 100 < 1000) (subseq avl-set > 100 < 1000)))) 78 | (testing "non-transient construction works as expected" 79 | (is-same-coll avl-map (reduce-kv assoc (avl/sorted-map) rb-map))) 80 | (testing "dissoc/dissoc! work as expected" 81 | (is-same-coll (reduce dissoc rb-map ks') (reduce dissoc avl-map ks')) 82 | (is-same-coll (reduce dissoc rb-map ks') 83 | (persistent! (reduce dissoc! (transient avl-map) ks')))) 84 | (testing "disj/disj! work as expected" 85 | (is-same-coll (reduce disj rb-set ks') (reduce disj avl-set ks')) 86 | (is-same-coll (reduce disj rb-set ks') 87 | (persistent! (reduce disj! (transient avl-set) ks')))) 88 | (testing "*-by seqs look like they should" 89 | (is (= (seq rb-map-by->) (seq avl-map-by->))) 90 | (is (= (seq rb-set-by->) (seq avl-set-by->)))) 91 | (testing "reduce-kv returns correct values" 92 | (is (= (reduce-kv + 0 rb-map) (reduce-kv + 0 avl-map))) 93 | (is (= (reduce-kv + 0 rb-map-by->) (reduce-kv + 0 avl-map-by->))))) 94 | 95 | (deftest standalone-checks 96 | (testing "seq" 97 | (is (= (seq avl-map) (map twice ks))) 98 | (is (= (seq avl-set) ks))) 99 | (testing "seq on *-by" 100 | (is (= (seq (apply avl/sorted-map-by > (interleave (range 32) (range 32)))) 101 | (reverse (map (juxt identity identity) (range 32))))) 102 | (is (= (seq (apply avl/sorted-set-by > (range 32))) 103 | (reverse (range 32))))) 104 | (testing "reduce-kv short-circuits appropriately" 105 | (is (= (reduce-kv (fn [acc k v] (reduced acc)) :foo avl-map) :foo)) 106 | (is (= (reduce-kv (fn [acc k v] 107 | (if (== (quot large-tree-size 3) k) 108 | (reduced k) 109 | acc)) 110 | nil 111 | avl-map) 112 | (quot large-tree-size 3))) 113 | (is (= (let [counter (atom 0)] 114 | (reduce-kv (fn [acc k v] 115 | (if (== (quot large-tree-size 3) k) 116 | (reduced k) 117 | (swap! counter inc))) 118 | nil 119 | avl-map) 120 | @counter) 121 | (quot large-tree-size 3))))) 122 | 123 | (deftest rank-queries 124 | (testing "map rank queries work as expected" 125 | (is (every? true? (map = ks (map #(key (nth avl-map %)) ks)))) 126 | (is (every? true? 127 | (map = (reverse ks) (map #(key (nth avl-map-by-> %)) ks)))) 128 | (is (->> (map #(nth avl-map-by-> (avl/rank-of avl-map-by-> %)) ks) 129 | (map first) 130 | (map = ks) 131 | (every? true?))) 132 | (is (every? #(== % -1) (map #(avl/rank-of avl-map %) [-10 123.5 200000])))) 133 | (testing "set rank queries work as expected" 134 | (is (every? true? (map = ks (map #(nth avl-set %) ks)))) 135 | (is (every? true? (map = (reverse ks) (map #(nth avl-set-by-> %) ks)))) 136 | (is (->> (map #(nth avl-set-by-> (avl/rank-of avl-set-by-> %)) ks) 137 | (map = ks) 138 | (every? true?))) 139 | (is (every? #(== % -1) (map #(avl/rank-of avl-set %) [-10 123.5 200000])))) 140 | (testing "rank-of, nth and contains? agree on sets" 141 | (is (every? (fn [x] 142 | (or (and (not (contains? even-numbers x)) 143 | (== -1 (avl/rank-of even-numbers x))) 144 | (and (contains? even-numbers x) 145 | (== (nth even-numbers (avl/rank-of even-numbers x)) 146 | x)))) 147 | (range (dec (apply min (seq even-numbers))) 148 | (+ 2 (apply max (seq even-numbers)))))))) 149 | 150 | (def keys-for-nearest [-1 0 1 2 3 4 5 6 7 8 9]) 151 | (def set-for-nearest (avl/sorted-set 0 2 4 6 8)) 152 | (def rset-for-nearest (avl/sorted-set-by > 0 2 4 6 8)) 153 | 154 | (defn subseq-nearest [coll test x] 155 | (let [subseq* (if (#{< <=} test) rsubseq subseq)] 156 | (first (subseq* coll test x)))) 157 | 158 | (deftest nearest 159 | (testing "nearest should find the correct element or nil" 160 | (doseq [s [set-for-nearest rset-for-nearest] 161 | t [< <= >= >]] 162 | (is (= (map #(avl/nearest s t %) keys-for-nearest) 163 | (map #(subseq-nearest s t %) keys-for-nearest)))))) 164 | 165 | (def small-ks (range small-tree-size)) 166 | (def small-ksks (doall (interleave small-ks small-ks))) 167 | 168 | (def small-avl-set (apply avl/sorted-set small-ks)) 169 | (def small-avl-map (apply avl/sorted-map small-ksks)) 170 | (def small-avl-set-> (apply avl/sorted-set-by > small-ks)) 171 | (def small-avl-map-> (apply avl/sorted-map-by > small-ksks)) 172 | 173 | (defn subseq-subrange [coll low high] 174 | (into (empty coll) (subseq coll >= low <= high))) 175 | 176 | (deftest subrange 177 | (testing "subrange should return the correct result" 178 | (doseq [coll [small-avl-set small-avl-map] 179 | i (range -1 (inc small-tree-size)) 180 | j (range i (inc small-tree-size))] 181 | (is (= (avl/subrange coll >= i <= j) (subseq-subrange coll i j)))) 182 | (doseq [coll [small-avl-set-> small-avl-map->] 183 | i (range small-tree-size -2 -1) 184 | j (range i -2 -1)] 185 | (is (= (avl/subrange coll >= i <= j) (subseq-subrange coll i j))))) 186 | (testing "subrange with single small (<) / large (>) limit should be empty" 187 | (is (= #{} (avl/subrange small-avl-set <= -1))) 188 | (is (= #{} (avl/subrange small-avl-set < -1))) 189 | (is (= #{} (avl/subrange small-avl-set >= small-tree-size))) 190 | (is (= #{} (avl/subrange small-avl-set > small-tree-size))) 191 | (is (= {} (avl/subrange small-avl-map <= -1))) 192 | (is (= {} (avl/subrange small-avl-map < -1))) 193 | (is (= {} (avl/subrange small-avl-map >= small-tree-size))) 194 | (is (= {} (avl/subrange small-avl-map > small-tree-size))))) 195 | 196 | (defn subseq-split-key [x coll] 197 | (let [e (empty coll)] 198 | [(into e (subseq coll < x)) 199 | (if (contains? coll x) 200 | (if (map? coll) 201 | (find coll x) 202 | (get coll x))) 203 | (into e (subseq coll > x))])) 204 | 205 | (defn subseq-split-at [n coll] 206 | [(into (empty coll) (take n coll)) 207 | (into (empty coll) (drop n coll))]) 208 | 209 | (deftest split 210 | (testing "split-key should return the correct result" 211 | (doseq [coll [small-avl-set small-avl-map 212 | small-avl-set-> small-avl-map->] 213 | i (range -1 (inc small-tree-size))] 214 | (is (= (avl/split-key i coll) (subseq-split-key i coll))))) 215 | (testing "split-at should return the correct result" 216 | (doseq [coll [small-avl-set small-avl-map 217 | small-avl-set-> small-avl-map->] 218 | i (range 0 (inc small-tree-size))] 219 | (is (= (avl/split-at i coll) (subseq-split-at i coll)))))) 220 | 221 | (def midsize-ks (range medium-tree-size)) 222 | 223 | (deftest avl-invariant 224 | (testing "AVL invariant is maintained at all times" 225 | (let [p (atom (avl/sorted-set)) 226 | t (atom (avl/sorted-set))] 227 | (doseq [k midsize-ks] 228 | (let [s (swap! p conj k) 229 | t (swap! t (comp persistent! #(conj! % k) transient))] 230 | (is (validate-invariant s)) 231 | (is (validate-invariant t)))) 232 | (doseq [k midsize-ks] 233 | (let [[l _ r] (avl/split-key k @p) 234 | [l' r'] (avl/split-at k @p)] 235 | (is (validate-invariant l)) 236 | (is (validate-invariant r)) 237 | (is (validate-invariant l')) 238 | (is (validate-invariant r')))) 239 | (doseq [k midsize-ks] 240 | (let [s (swap! p disj k) 241 | t (swap! t (comp persistent! #(conj! % k) transient))] 242 | (is (validate-invariant s)) 243 | (is (validate-invariant t))))))) 244 | 245 | (deftest navigable-queries 246 | (testing "nearest lookups are \"rounded\"" 247 | (doseq [k (drop-last ks)] 248 | (is (= (avl/nearest even-numbers >= k) (if (odd? k) (inc k) k)))) 249 | (doseq [k (next ks)] 250 | (is (= (avl/nearest even-numbers <= k) (if (odd? k) (dec k) k))))) 251 | (testing "out of range keys return nil" 252 | (is (nil? (avl/nearest avl-map < 0))) 253 | (is (nil? (avl/nearest avl-set < 0))) 254 | (is (nil? (avl/nearest avl-map > (key (first (rseq avl-map)))))) 255 | (is (nil? (avl/nearest avl-set > (first (rseq avl-set)))))) 256 | (testing "floor and ceil returns exact match if present" 257 | (doseq [k ks] 258 | (is (= (avl/nearest avl-set >= k) k)) 259 | (is (= (avl/nearest avl-set <= k) k)) 260 | (is (= (key (avl/nearest avl-map >= k)) k)) 261 | (is (= (key (avl/nearest avl-map <= k)) k)))) 262 | (testing "lower and higher match the next item" 263 | (doseq [k (drop-last ks)] 264 | (is (= (avl/nearest avl-set > k) (inc k))) 265 | (is (= (key (avl/nearest avl-map > k)) (inc k)))) 266 | (doseq [k (next ks)] 267 | (is (= (avl/nearest avl-set < k) (dec k))) 268 | (is (= (key (avl/nearest avl-map < k)) (dec k)))))) 269 | 270 | (deftest bad-args 271 | (testing "sorted-map and sorted-map-by expect val for every key" 272 | (is (thrown? IllegalArgumentException (avl/sorted-map :a 1 :b))) 273 | (is (thrown? IllegalArgumentException (avl/sorted-map-by < :a 1 :b))))) 274 | 275 | (deftest coll-reduce 276 | (testing "No-init sorted-map reduction works as expected" 277 | (is (= (reduce (fn [] :none) (avl/sorted-map)) :none) 278 | "0-Arity of reduction fn called for empty sorted-map") 279 | (is (= (reduce (fn []) (avl/sorted-map 1 2)) [1 2]) 280 | "Reduction function not called for 1-element sorted-map, item returned") 281 | (is (= (reduce into (avl/sorted-map 1 2 3 4 5 6)) [1 2 3 4 5 6]) 282 | "Reduction is in correct order with correct contents.")) 283 | (testing "Init-ed sorted-map reduction works as expected" 284 | (is (= (reduce conj [] (avl/sorted-map)) [])) 285 | (is (= (reduce conj [] (avl/sorted-map 1 2)) [[1 2]])) 286 | (is (= (reduce conj [] (avl/sorted-map 1 2 3 4 5 6)) [[1 2] [3 4] [5 6]]))) 287 | (testing "No-init sorted-set reduction works as expected" 288 | (is (= (reduce (fn [] :none) (avl/sorted-set)) :none) 289 | "0-Arity of reduction fn called for empty sorted-set") 290 | (is (= (reduce (fn []) (avl/sorted-set 1)) 1) 291 | "Reduction function not called for 1-element sorted-set, item returned") 292 | (is (= (reduce (fn [a v] (conj (if (number? a) [a] a) v)) 293 | (avl/sorted-set 1 2 3 4 5 6)) [1 2 3 4 5 6]) 294 | "Reduction is in correct order with correct contents.")) 295 | (testing "Init-ed sorted-set reduction works as expected" 296 | (is (= (reduce conj [] (avl/sorted-set)) [])) 297 | (is (= (reduce conj [] (avl/sorted-set 1)) [1])) 298 | (is (= (reduce conj [] (avl/sorted-set 1 2 3 4 5 6)) [1 2 3 4 5 6])))) 299 | -------------------------------------------------------------------------------- /src/main/cljs/clojure/data/avl.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.avl 10 | 11 | "An implementation of persistent sorted maps and sets based on AVL 12 | trees which can be used as drop-in replacements for Clojure's 13 | built-in sorted maps and sets based on red-black trees. Apart from 14 | the standard sorted collection API, the provided map and set types 15 | support the transients API and several additional logarithmic time 16 | operations: rank queries via clojure.core/nth (select element by 17 | rank) and clojure.data.avl/rank-of (discover rank of element), 18 | \"nearest key\" lookups via clojure.data.avl/nearest, splits by key 19 | and index via clojure.data.avl/split-key and 20 | clojure.data.avl/split-at, respectively, and subsets/submaps using 21 | clojure.data.avl/subrange." 22 | 23 | {:author "Michał Marczyk"} 24 | 25 | (:refer-clojure :exclude [sorted-map sorted-map-by sorted-set sorted-set-by 26 | range split-at])) 27 | 28 | (deftype AVLNode [edit 29 | ^:mutable key 30 | ^:mutable val 31 | ^:mutable left 32 | ^:mutable right 33 | ^:mutable height 34 | ^:mutable rank] 35 | Object 36 | (getKey [this] 37 | key) 38 | 39 | (setKey [this k] 40 | (set! key k) 41 | this) 42 | 43 | (getVal [this] 44 | val) 45 | 46 | (setVal [this v] 47 | (set! val v) 48 | this) 49 | 50 | (getLeft [this] 51 | left) 52 | 53 | (setLeft [this l] 54 | (set! left l) 55 | this) 56 | 57 | (getRight [this] 58 | right) 59 | 60 | (setRight [this r] 61 | (set! right r) 62 | this) 63 | 64 | (getHeight [this] 65 | height) 66 | 67 | (setHeight [this h] 68 | (set! height h) 69 | this) 70 | 71 | (getRank [this] 72 | rank) 73 | 74 | (setRank [this r] 75 | (set! rank r) 76 | this)) 77 | 78 | (defn ^:private height [node] 79 | (if (nil? node) 80 | 0 81 | (.-height node))) 82 | 83 | (defn ^:private ensure-editable 84 | ([edit] 85 | (if-not edit 86 | (throw (ex-info "Transient used after persistent! call" {})))) 87 | ([edit node] 88 | (if (identical? edit (.-edit node)) 89 | node 90 | (AVLNode. edit 91 | (.getKey node) (.getVal node) 92 | (.getLeft node) 93 | (.getRight node) 94 | (.getHeight node) 95 | (.getRank node))))) 96 | 97 | (defn ^:private rotate-left [node] 98 | (let [l (.getLeft node) 99 | r (.getRight node) 100 | rl (.getLeft r) 101 | rr (.getRight r) 102 | lh (height l) 103 | rlh (height rl) 104 | rrh (height rr) 105 | rnk (.getRank node) 106 | rnkr (.getRank r)] 107 | (AVLNode. nil 108 | (.getKey r) (.getVal r) 109 | (AVLNode. nil 110 | (.getKey node) (.getVal node) 111 | l 112 | rl 113 | (inc (max lh rlh)) 114 | rnk) 115 | rr 116 | (max (+ lh 2) 117 | (+ rlh 2) 118 | (inc rrh)) 119 | (inc (+ rnk rnkr))))) 120 | 121 | (defn ^:private rotate-left! [edit node] 122 | (let [node (ensure-editable edit node) 123 | l (.getLeft node) 124 | r (ensure-editable edit (.getRight node)) 125 | rl (.getLeft r) 126 | rr (.getRight r) 127 | lh (height l) 128 | rlh (height rl) 129 | rrh (height rr) 130 | rnk (.getRank node) 131 | rnkr (.getRank r)] 132 | (.setLeft r node) 133 | (.setHeight r (max (+ lh 2) (+ rlh 2) (inc rrh))) 134 | (.setRank r (inc (+ rnk rnkr))) 135 | (.setRight node rl) 136 | (.setHeight node (inc (max lh rlh))) 137 | r)) 138 | 139 | (defn ^:private rotate-right [node] 140 | (let [r (.getRight node) 141 | l (.getLeft node) 142 | lr (.getRight l) 143 | ll (.getLeft l) 144 | rh (height r) 145 | lrh (height lr) 146 | llh (height ll) 147 | rnk (.getRank node) 148 | rnkl (.getRank l)] 149 | (AVLNode. nil 150 | (.getKey l) (.getVal l) 151 | ll 152 | (AVLNode. nil 153 | (.getKey node) (.getVal node) 154 | lr 155 | r 156 | (inc (max rh lrh)) 157 | (dec (- rnk rnkl))) 158 | (max (+ rh 2) 159 | (+ lrh 2) 160 | (inc llh)) 161 | rnkl))) 162 | 163 | (defn ^:private rotate-right! [edit node] 164 | (let [node (ensure-editable edit node) 165 | r (.getRight node) 166 | l (ensure-editable edit (.getLeft node)) 167 | lr (.getRight l) 168 | ll (.getLeft l) 169 | rh (height r) 170 | lrh (height lr) 171 | llh (height ll) 172 | rnk (.getRank node) 173 | rnkl (.getRank l)] 174 | (.setRight l node) 175 | (.setHeight l (max (+ rh 2) (+ lrh 2) (inc llh))) 176 | (.setLeft node lr) 177 | (.setHeight node (inc (max rh lrh))) 178 | (.setRank node (dec (- rnk rnkl))) 179 | l)) 180 | 181 | (defn ^:private lookup [comp node k] 182 | (if (nil? node) 183 | nil 184 | (let [c (comp k (.getKey node))] 185 | (cond 186 | (zero? c) node 187 | (neg? c) (recur comp (.getLeft node) k) 188 | :else (recur comp (.getRight node) k))))) 189 | 190 | (defn ^:private lookup-nearest [comp node test k] 191 | (let [below? (or (identical? < test) (identical? <= test)) 192 | equal? (or (identical? <= test) (identical? >= test)) 193 | back? (if below? neg? pos?) 194 | backward (if below? 195 | #(.getLeft %) 196 | #(.getRight %)) 197 | forward (if below? 198 | #(.getRight %) 199 | #(.getLeft %))] 200 | (loop [prev nil 201 | node node] 202 | (if (nil? node) 203 | prev 204 | (let [c (comp k (.getKey node))] 205 | (cond 206 | (zero? c) (if equal? 207 | node 208 | (recur prev (backward node))) 209 | (back? c) (recur prev (backward node)) 210 | :else (recur node (forward node)))))))) 211 | 212 | (defn ^:private select [node rank] 213 | (if (nil? node) 214 | nil 215 | (let [node-rank (.getRank node)] 216 | (cond 217 | (== node-rank rank) node 218 | (< node-rank rank) (recur (.getRight node) (dec (- rank node-rank))) 219 | :else (recur (.getLeft node) rank))))) 220 | 221 | (defn ^:private rank [comp node k] 222 | (if (nil? node) 223 | -1 224 | (let [c (comp k (.getKey node))] 225 | (cond 226 | (zero? c) (.getRank node) 227 | (neg? c) (recur comp (.getLeft node) k) 228 | :else (let [r (rank comp (.getRight node) k)] 229 | (if (== -1 r) 230 | -1 231 | (inc (+ (.getRank node) r)))))))) 232 | 233 | (defn ^:private maybe-rebalance [node] 234 | (let [l (.getLeft node) 235 | r (.getRight node) 236 | lh (height l) 237 | rh (height r) 238 | b (- lh rh)] 239 | (cond 240 | ;; right-heavy 241 | (< b -1) 242 | (let [rl (.getLeft r) 243 | rr (.getRight r) 244 | rlh (height rl) 245 | rrh (height rr)] 246 | (if (== (- rlh rrh) 1) 247 | ;; left-heavy 248 | (let [new-right (rotate-right r)] 249 | (rotate-left (AVLNode. nil 250 | (.getKey node) (.getVal node) 251 | (.getLeft node) 252 | new-right 253 | (inc (max lh (height new-right))) 254 | (.getRank node)))) 255 | (rotate-left node))) 256 | 257 | ;; left-heavy 258 | (> b 1) 259 | (let [ll (.getLeft l) 260 | lr (.getRight l) 261 | llh (height ll) 262 | lrh (height lr)] 263 | ;; right-heavy 264 | (if (== (- lrh llh) 1) 265 | (let [new-left (rotate-left l)] 266 | (rotate-right (AVLNode. nil 267 | (.getKey node) (.getVal node) 268 | new-left 269 | (.getRight node) 270 | (inc (max rh (height new-left))) 271 | (.getRank node)))) 272 | (rotate-right node))) 273 | 274 | :else 275 | node))) 276 | 277 | (defn ^:private maybe-rebalance! [edit node] 278 | (let [l (.getLeft node) 279 | r (.getRight node) 280 | lh (height l) 281 | rh (height r) 282 | b (- lh rh)] 283 | (cond 284 | ;; right-heavy 285 | (< b -1) 286 | (let [node (ensure-editable edit node) 287 | rl (.getLeft r) 288 | rr (.getRight r) 289 | rlh (height rl) 290 | rrh (height rr)] 291 | (if (== (- rlh rrh) 1) 292 | ;; left-heavy 293 | (let [new-right (rotate-right! edit r)] 294 | (.setRight node new-right) 295 | (.setHeight node (inc (max lh (height new-right)))) 296 | (rotate-left! edit node)) 297 | (rotate-left! edit node))) 298 | 299 | ;; left-heavy 300 | (> b 1) 301 | (let [node (ensure-editable edit node) 302 | ll (.getLeft l) 303 | lr (.getRight l) 304 | llh (height ll) 305 | lrh (height lr)] 306 | ;; right-heavy 307 | (if (== (- lrh llh) 1) 308 | (let [new-left (rotate-left! edit l)] 309 | (.setLeft node new-left) 310 | (.setHeight node (inc (max rh (height new-left)))) 311 | (rotate-right! edit node)) 312 | (rotate-right! edit node))) 313 | 314 | :else 315 | node))) 316 | 317 | (defn ^:private insert [comp node k v found?] 318 | (if (nil? node) 319 | (AVLNode. nil k v nil nil 1 0) 320 | (let [nk (.getKey node) 321 | c (comp k nk)] 322 | (cond 323 | (zero? c) 324 | (do 325 | (set! (.-val found?) true) 326 | (AVLNode. nil 327 | k v 328 | (.getLeft node) 329 | (.getRight node) 330 | (.getHeight node) 331 | (.getRank node))) 332 | 333 | (neg? c) 334 | (let [new-child (insert comp (.getLeft node) k v found?)] 335 | (maybe-rebalance 336 | (AVLNode. nil 337 | nk (.getVal node) 338 | new-child 339 | (.getRight node) 340 | (inc (max (.getHeight new-child) 341 | (height (.getRight node)))) 342 | (if (.-val found?) 343 | (.getRank node) 344 | (inc (.getRank node)))))) 345 | 346 | :else 347 | (let [new-child (insert comp (.getRight node) k v found?)] 348 | (maybe-rebalance 349 | (AVLNode. nil 350 | nk (.getVal node) 351 | (.getLeft node) 352 | new-child 353 | (inc (max (.getHeight new-child) 354 | (height (.getLeft node)))) 355 | (.getRank node)))))))) 356 | 357 | (defn ^:private insert! [edit comp node k v found?] 358 | (if (nil? node) 359 | (AVLNode. edit k v nil nil 1 0) 360 | (let [node (ensure-editable edit node) 361 | nk (.getKey node) 362 | c (comp k nk)] 363 | (cond 364 | (zero? c) 365 | (do 366 | (set! (.-val found?) true) 367 | (.setKey node k) 368 | (.setVal node v) 369 | node) 370 | 371 | (neg? c) 372 | (let [new-child (insert! edit comp (.getLeft node) k v found?)] 373 | (.setLeft node new-child) 374 | (.setHeight node 375 | (inc (max (.getHeight new-child) 376 | (height (.getRight node))))) 377 | (if-not (.-val found?) 378 | (.setRank node (unchecked-inc-int (.getRank node)))) 379 | (maybe-rebalance! edit node)) 380 | 381 | :else 382 | (let [new-child (insert! edit comp (.getRight node) k v found?)] 383 | (.setRight node new-child) 384 | (.setHeight node 385 | (inc (max (.getHeight new-child) 386 | (height (.getLeft node))))) 387 | (maybe-rebalance! edit node)))))) 388 | 389 | (defn ^:private get-rightmost [node] 390 | (if-let [r (.getRight node)] 391 | (recur r) 392 | node)) 393 | 394 | (defn ^:private get-leftmost [node] 395 | (if-let [l (.getLeft node)] 396 | (recur l) 397 | node)) 398 | 399 | (defn ^:private delete-rightmost [node] 400 | (if-let [r (.getRight node)] 401 | (let [l (.getLeft node) 402 | new-right (delete-rightmost r)] 403 | (maybe-rebalance 404 | (AVLNode. nil 405 | (.getKey node) (.getVal node) 406 | l 407 | new-right 408 | (inc (max (height l) (height new-right))) 409 | (.getRank node)))) 410 | (.getLeft node))) 411 | 412 | (defn ^:private delete-rightmost! [edit node] 413 | (if-not (nil? node) 414 | (let [node (ensure-editable edit node) 415 | r (.getRight node)] 416 | (cond 417 | (nil? r) 418 | (if-let [l (.getLeft node)] 419 | (ensure-editable edit l)) 420 | 421 | (nil? (.getRight r)) 422 | (do 423 | (.setRight node (.getLeft r)) 424 | (.setHeight node 425 | (inc (max (height (.getLeft node)) 426 | (height (.getLeft r))))) 427 | (maybe-rebalance! edit node)) 428 | 429 | :else 430 | (let [new-right (delete-rightmost! edit r)] 431 | (.setRight node new-right) 432 | (.setHeight node 433 | (inc (max (height (.getLeft node)) 434 | (height new-right)))) 435 | (maybe-rebalance! edit node)))))) 436 | 437 | (defn ^:private delete [comp node k found?] 438 | (if (nil? node) 439 | nil 440 | (let [nk (.getKey node) 441 | c (comp k nk)] 442 | (cond 443 | (zero? c) 444 | (let [l (.getLeft node) 445 | r (.getRight node)] 446 | (set! (.-val found?) true) 447 | (if (and l r) 448 | (let [p (get-rightmost l) 449 | l' (delete-rightmost l)] 450 | (maybe-rebalance 451 | (AVLNode. nil 452 | (.getKey p) (.getVal p) 453 | l' 454 | r 455 | (inc (max (height l') (height r))) 456 | (unchecked-dec-int (.getRank node))))) 457 | (or l r))) 458 | 459 | (neg? c) 460 | (let [new-child (delete comp (.getLeft node) k found?)] 461 | (if (identical? new-child (.getLeft node)) 462 | node 463 | (maybe-rebalance 464 | (AVLNode. nil 465 | nk (.getVal node) 466 | new-child 467 | (.getRight node) 468 | (inc (max (height new-child) 469 | (height (.getRight node)))) 470 | (if (.-val found?) 471 | (unchecked-dec-int (.getRank node)) 472 | (.getRank node)))))) 473 | 474 | :else 475 | (let [new-child (delete comp (.getRight node) k found?)] 476 | (if (identical? new-child (.getRight node)) 477 | node 478 | (maybe-rebalance 479 | (AVLNode. nil 480 | nk (.getVal node) 481 | (.getLeft node) 482 | new-child 483 | (inc (max (height new-child) 484 | (height (.getLeft node)))) 485 | (.getRank node))))))))) 486 | 487 | (defn ^:private delete! [edit comp node k found?] 488 | (if (nil? node) 489 | nil 490 | (let [nk (.getKey node) 491 | c (comp k nk)] 492 | (cond 493 | (zero? c) 494 | (let [l (.getLeft node) 495 | r (.getRight node)] 496 | (set! (.-val found?) true) 497 | (cond 498 | (and l r) 499 | (let [node (ensure-editable edit node) 500 | p (get-rightmost l) 501 | l' (delete-rightmost! edit l)] 502 | (.setKey node (.getKey p)) 503 | (.setVal node (.getVal p)) 504 | (.setLeft node l') 505 | (.setHeight node (inc (max (height l') (height r)))) 506 | (.setRank node (unchecked-dec-int (.getRank node))) 507 | (maybe-rebalance! edit node)) 508 | 509 | l l 510 | r r 511 | :else nil)) 512 | 513 | (neg? c) 514 | (let [new-child (delete! edit comp (.getLeft node) k found?)] 515 | (if (.-val found?) 516 | (let [node (ensure-editable edit node)] 517 | (.setLeft node new-child) 518 | (.setHeight node 519 | (inc (max (height new-child) 520 | (height (.getRight node))))) 521 | (.setRank node (unchecked-dec-int (.getRank node))) 522 | (maybe-rebalance! edit node)) 523 | node)) 524 | 525 | :else 526 | (let [new-child (delete! edit comp (.getRight node) k found?)] 527 | (if (.-val found?) 528 | (let [node (ensure-editable edit node)] 529 | (.setRight node new-child) 530 | (.setHeight node 531 | (inc (max (height new-child) 532 | (height (.getLeft node))))) 533 | (maybe-rebalance! edit node)) 534 | node)))))) 535 | 536 | (defn ^:private join [comp left-count left right] 537 | (cond 538 | (nil? left) right 539 | (nil? right) left 540 | :else 541 | (let [lh (.getHeight left) 542 | rh (.getHeight right)] 543 | (cond 544 | (== lh rh) 545 | (let [left-min (get-rightmost left) 546 | new-left (delete comp left (.getKey left-min) (Box. false))] 547 | (AVLNode. nil 548 | (.getKey left-min) (.getVal left-min) 549 | new-left 550 | right 551 | (inc rh) 552 | (dec left-count))) 553 | 554 | (< lh rh) 555 | (letfn [(step [current lvl] 556 | (cond 557 | (zero? lvl) 558 | (join comp left-count left current) 559 | 560 | (nil? (.getLeft current)) 561 | (AVLNode. nil 562 | (.getKey current) (.getVal current) 563 | left 564 | (.getRight current) 565 | 2 566 | left-count) 567 | 568 | :else 569 | (let [new-child (step (.getLeft current) (dec lvl)) 570 | current-r (.getRight current)] 571 | (maybe-rebalance 572 | (AVLNode. nil 573 | (.getKey current) (.getVal current) 574 | new-child 575 | current-r 576 | (inc (max (.getHeight new-child) 577 | (if current-r 578 | (.getHeight current-r) 579 | 0))) 580 | (+ left-count (.getRank current)))))))] 581 | (step right (- rh lh))) 582 | 583 | :else 584 | (letfn [(step [current cnt lvl] 585 | (cond 586 | (zero? lvl) 587 | (join comp cnt current right) 588 | 589 | (nil? (.getRight current)) 590 | (AVLNode. nil 591 | (.getKey current) (.getVal current) 592 | (.getLeft current) 593 | right 594 | 2 595 | (.getRank current)) 596 | 597 | :else 598 | (let [new-child (step (.getRight current) 599 | (dec (- cnt (.getRank current))) 600 | (dec lvl)) 601 | current-l (.getLeft current)] 602 | (maybe-rebalance 603 | (AVLNode. nil 604 | (.getKey current) (.getVal current) 605 | current-l 606 | new-child 607 | (inc (max (.getHeight new-child) 608 | (if current-l 609 | (.getHeight current-l) 610 | 0))) 611 | (.getRank current))))))] 612 | (step left left-count (- lh rh))))))) 613 | 614 | (defn ^:private split [comp node k] 615 | (letfn [(step [node] 616 | (if (nil? node) 617 | [nil nil nil] 618 | (let [c (comp k (.getKey node))] 619 | (cond 620 | (zero? c) 621 | [(.getLeft node) 622 | (MapEntry. (.getKey node) (.getVal node) nil) 623 | (.getRight node)] 624 | 625 | (neg? c) 626 | (let [[l e r] (step (.getLeft node))] 627 | [l 628 | e 629 | (join comp 630 | (- (.getRank node) 631 | (cond 632 | e 633 | (unchecked-inc-int 634 | (rank comp 635 | (.getLeft node) 636 | (key e))) 637 | r 638 | (rank comp 639 | (.getLeft node) 640 | (.getKey (get-leftmost r))) 641 | :else 642 | (.getRank node))) 643 | r 644 | (insert comp 645 | (.getRight node) 646 | (.getKey node) 647 | (.getVal node) 648 | (Box. false)))]) 649 | 650 | :else 651 | (let [[l e r] (step (.getRight node))] 652 | [(join comp 653 | (unchecked-inc-int (.getRank node)) 654 | (insert comp 655 | (.getLeft node) 656 | (.getKey node) 657 | (.getVal node) 658 | (Box. false)) 659 | l) 660 | e 661 | r])))))] 662 | (step node))) 663 | 664 | (defn ^:private range [comp node low high] 665 | (let [[_ low-e r] (split comp node low) 666 | [l high-e _] (split comp r high)] 667 | (cond-> l 668 | low-e (as-> node 669 | (insert comp node 670 | (key low-e) (val low-e) 671 | (Box. false))) 672 | high-e (as-> node 673 | (insert comp node 674 | (key high-e) (val high-e) 675 | (Box. false)))))) 676 | 677 | (defn ^:private seq-push [node stack ascending?] 678 | (loop [node node stack stack] 679 | (if (nil? node) 680 | stack 681 | (recur (if ascending? (.-left node) (.-right node)) 682 | (conj stack node))))) 683 | 684 | (declare ->AVLMapSeq) 685 | 686 | (defn ^:private create-seq [node ascending? cnt] 687 | (->AVLMapSeq nil (seq-push node nil ascending?) ascending? cnt nil)) 688 | 689 | (defn ^:private avl-map-kv-reduce [node f init] 690 | (let [init (if (nil? (.getLeft node)) 691 | init 692 | (avl-map-kv-reduce (.getLeft node) f init))] 693 | (if (reduced? init) 694 | init 695 | (let [init (f init (.getKey node) (.getVal node))] 696 | (if (reduced? init) 697 | init 698 | (if (nil? (.getRight node)) 699 | init 700 | (recur (.getRight node) f init))))))) 701 | 702 | (defn ^:private avl-map-reduce [node f init] 703 | (let [init (if (nil? (.getLeft node)) 704 | init 705 | (avl-map-reduce (.getLeft node) f init))] 706 | (if (reduced? init) 707 | init 708 | (let [init (f init (MapEntry. (.getKey node) (.getVal node) nil))] 709 | (if (reduced? init) 710 | init 711 | (if (nil? (.getRight node)) 712 | init 713 | (recur (.getRight node) f init))))))) 714 | 715 | (defn ^:private avl-map-reduce-skip [node f init skip-node] 716 | (let [init (if (nil? (.getLeft node)) 717 | init 718 | (avl-map-reduce-skip (.getLeft node) f init skip-node))] 719 | (if (reduced? init) 720 | init 721 | (if (identical? skip-node node) 722 | (if (nil? (.getRight node)) 723 | init 724 | (avl-map-reduce (.getRight node) f init)) 725 | (let [init (f init (MapEntry. (.getKey node) (.getVal node) nil))] 726 | (if (reduced? init) 727 | init 728 | (if (nil? (.getRight node)) 729 | init 730 | (recur (.getRight node) f init skip-node)))))))) 731 | 732 | (defn ^:private avl-set-reduce [node f init] 733 | (let [init (if (nil? (.getLeft node)) 734 | init 735 | (avl-set-reduce (.getLeft node) f init))] 736 | (if (reduced? init) 737 | init 738 | (let [init (f init (.getKey node))] 739 | (if (reduced? init) 740 | init 741 | (if (nil? (.getRight node)) 742 | init 743 | (recur (.getRight node) f init))))))) 744 | 745 | (defn ^:private avl-set-reduce-skip [node f init skip-node] 746 | (let [init (if (nil? (.getLeft node)) 747 | init 748 | (avl-set-reduce-skip (.getLeft node) f init skip-node))] 749 | (if (reduced? init) 750 | init 751 | (if (identical? skip-node node) 752 | (if (nil? (.getRight node)) 753 | init 754 | (avl-set-reduce (.getRight node) f init)) 755 | (let [init (f init (.getKey node))] 756 | (if (reduced? init) 757 | init 758 | (if (nil? (.getRight node)) 759 | init 760 | (avl-set-reduce (.getRight node) f init)))))))) 761 | 762 | (deftype AVLMapSeq [_meta stack ascending? cnt ^:mutable _hash] 763 | Object 764 | (toString [this] 765 | (pr-str* this)) 766 | 767 | IHash 768 | (-hash [this] 769 | (caching-hash this hash-coll _hash)) 770 | 771 | ISeqable 772 | (-seq [this] 773 | this) 774 | 775 | ISequential 776 | ISeq 777 | (-first [this] 778 | (let [node (peek stack)] 779 | (MapEntry. (.-key node) (.-val node) nil))) 780 | 781 | (-rest [this] 782 | (let [node (first stack) 783 | next-stack (seq-push (if ascending? (.-right node) (.-left node)) 784 | (next stack) 785 | ascending?)] 786 | (if (nil? next-stack) 787 | () 788 | (AVLMapSeq. nil next-stack ascending? (dec cnt) nil)))) 789 | 790 | INext 791 | (-next [this] 792 | (-seq (-rest this))) 793 | 794 | ICounted 795 | (-count [this] 796 | (if (neg? cnt) 797 | (inc (-count (-next this))) 798 | cnt)) 799 | 800 | ICollection 801 | (-conj [this x] 802 | (cons x this)) 803 | 804 | IEquiv 805 | (-equiv [this that] 806 | (equiv-sequential this that)) 807 | 808 | IEmptyableCollection 809 | (-empty [this] 810 | (with-meta () _meta)) 811 | 812 | IMeta 813 | (-meta [this] 814 | _meta) 815 | 816 | IWithMeta 817 | (-with-meta [this meta] 818 | (AVLMapSeq. meta stack ascending? cnt _hash)) 819 | 820 | IReduce 821 | (-reduce [this f] 822 | (seq-reduce f this)) 823 | 824 | (-reduce [this f start] 825 | (seq-reduce f start this))) 826 | 827 | (declare ->AVLTransientMap) 828 | 829 | (deftype AVLMap [comp tree cnt _meta ^:mutable _hash] 830 | Object 831 | (toString [this] 832 | (pr-str* this)) 833 | 834 | (getTree [this] 835 | tree) 836 | 837 | (nearest [this test k] 838 | (if-let [node (lookup-nearest comp tree test k)] 839 | (MapEntry. (.getKey node) (.getVal node) nil))) 840 | 841 | IHash 842 | (-hash [this] 843 | (caching-hash this hash-unordered-coll _hash)) 844 | 845 | IMeta 846 | (-meta [this] 847 | _meta) 848 | 849 | IWithMeta 850 | (-with-meta [this meta] 851 | (AVLMap. comp tree cnt meta _hash)) 852 | 853 | ICounted 854 | (-count [this] 855 | cnt) 856 | 857 | IIndexed 858 | (-nth [this i] 859 | (if-let [n (select tree i)] 860 | (MapEntry. (.getKey n) (.getVal n) nil) 861 | (throw (ex-info "nth index out of bounds in AVL tree" {})))) 862 | 863 | (-nth [this i not-found] 864 | (if-let [n (select tree i)] 865 | (MapEntry. (.getKey n) (.getVal n) nil) 866 | not-found)) 867 | 868 | ICollection 869 | (-conj [this entry] 870 | (if (vector? entry) 871 | (assoc this (-nth entry 0) (-nth entry 1)) 872 | (reduce -conj this entry))) 873 | 874 | IEmptyableCollection 875 | (-empty [this] 876 | (AVLMap. comp nil 0 _meta 0)) 877 | 878 | IEquiv 879 | (-equiv [this that] 880 | (equiv-map this that)) 881 | 882 | IKVReduce 883 | (-kv-reduce [this f init] 884 | (if (nil? tree) 885 | init 886 | (let [init (avl-map-kv-reduce tree f init)] 887 | (if (reduced? init) 888 | @init 889 | init)))) 890 | 891 | IReduce 892 | (-reduce [this f] 893 | (case cnt 894 | 0 (f) 895 | 1 (MapEntry. (.getKey tree) (.getVal tree) nil) 896 | (let [n0 (select tree 0) 897 | init (avl-map-reduce-skip tree f (MapEntry. (.getKey n0) (.getVal n0) nil) n0)] 898 | (if (reduced? init) 899 | (-deref init) 900 | init)))) 901 | 902 | (-reduce [this f init] 903 | (if (nil? tree) 904 | init 905 | (let [init (avl-map-reduce tree f init)] 906 | (if (reduced? init) 907 | (-deref init) 908 | init)))) 909 | 910 | IFn 911 | (-invoke [this k] 912 | (-lookup this k)) 913 | 914 | (-invoke [this k not-found] 915 | (-lookup this k not-found)) 916 | 917 | ISeqable 918 | (-seq [this] 919 | (if (pos? cnt) 920 | (create-seq tree true cnt))) 921 | 922 | IReversible 923 | (-rseq [this] 924 | (if (pos? cnt) 925 | (create-seq tree false cnt))) 926 | 927 | ILookup 928 | (-lookup [this k] 929 | (-lookup this k nil)) 930 | 931 | (-lookup [this k not-found] 932 | (let [n (lookup comp tree k)] 933 | (if-not (nil? n) 934 | (.-val n) 935 | not-found))) 936 | 937 | IAssociative 938 | (-assoc [this k v] 939 | (let [found? (Box. false) 940 | new-tree (insert comp tree k v found?)] 941 | (AVLMap. comp 942 | new-tree 943 | (if (.-val found?) cnt (inc cnt)) 944 | _meta nil))) 945 | 946 | (-contains-key? [this k] 947 | (not (nil? (lookup comp tree k)))) 948 | 949 | IMap 950 | (-dissoc [this k] 951 | (let [found? (Box. false) 952 | new-tree (delete comp tree k found?)] 953 | (if (.-val found?) 954 | (AVLMap. comp 955 | new-tree 956 | (dec cnt) 957 | _meta nil) 958 | this))) 959 | 960 | ISorted 961 | (-sorted-seq [this ascending?] 962 | (if (pos? cnt) 963 | (create-seq tree ascending? cnt))) 964 | 965 | (-sorted-seq-from [this k ascending?] 966 | (if (pos? cnt) 967 | (loop [stack nil t tree] 968 | (if-not (nil? t) 969 | (let [c (comp k (.-key t))] 970 | (cond 971 | (zero? c) (AVLMapSeq. nil (conj stack t) ascending? -1 nil) 972 | ascending? (if (neg? c) 973 | (recur (conj stack t) (.-left t)) 974 | (recur stack (.-right t))) 975 | :else (if (pos? c) 976 | (recur (conj stack t) (.-right t)) 977 | (recur stack (.-left t))))) 978 | (if-not (nil? stack) 979 | (AVLMapSeq. nil stack ascending? -1 nil)))))) 980 | 981 | (-entry-key [this entry] 982 | (key entry)) 983 | 984 | (-comparator [this] 985 | comp) 986 | 987 | IEditableCollection 988 | (-as-transient [this] 989 | (->AVLTransientMap (js-obj) comp tree cnt))) 990 | 991 | (deftype AVLTransientMap [^:mutable edit comp ^:mutable tree ^:mutable cnt] 992 | ICounted 993 | (-count [this] 994 | cnt) 995 | 996 | ILookup 997 | (-lookup [this k] 998 | (-lookup this k nil)) 999 | 1000 | (-lookup [this k not-found] 1001 | (let [n (lookup comp tree k)] 1002 | (if-not (nil? n) 1003 | (.getVal n) 1004 | not-found))) 1005 | 1006 | IFn 1007 | (-invoke [this k] 1008 | (-lookup this k)) 1009 | 1010 | (-invoke [this k not-found] 1011 | (-lookup this k not-found)) 1012 | 1013 | ITransientCollection 1014 | (-conj! [this entry] 1015 | (if (vector? entry) 1016 | (assoc! this (nth entry 0) (nth entry 1)) 1017 | (reduce conj! this entry))) 1018 | 1019 | (-persistent! [this] 1020 | (ensure-editable edit) 1021 | (set! edit nil) 1022 | (AVLMap. comp tree cnt nil nil)) 1023 | 1024 | ITransientAssociative 1025 | (-assoc! [this k v] 1026 | (ensure-editable edit) 1027 | (let [found? (Box. false) 1028 | new-tree (insert! edit comp tree k v found?)] 1029 | (set! tree new-tree) 1030 | (if-not (.-val found?) 1031 | (set! cnt (inc cnt))) 1032 | this)) 1033 | 1034 | ITransientMap 1035 | (-dissoc! [this k] 1036 | (ensure-editable edit) 1037 | (let [found? (Box. false) 1038 | new-tree (delete! edit comp tree k found?)] 1039 | (when (.-val found?) 1040 | (set! tree new-tree) 1041 | (set! cnt (dec cnt))) 1042 | this))) 1043 | 1044 | (declare ->AVLTransientSet) 1045 | 1046 | (deftype AVLSet [_meta avl-map ^:mutable _hash] 1047 | Object 1048 | (toString [this] 1049 | (pr-str* this)) 1050 | 1051 | (getTree [this] 1052 | (.-tree avl-map)) 1053 | 1054 | (nearest [this test k] 1055 | (if-let [node (lookup-nearest (.-comp avl-map) (.getTree avl-map) test k)] 1056 | (.getKey node))) 1057 | 1058 | IHash 1059 | (-hash [this] 1060 | (caching-hash this hash-unordered-coll _hash)) 1061 | 1062 | IMeta 1063 | (-meta [this] 1064 | _meta) 1065 | 1066 | IWithMeta 1067 | (-with-meta [this meta] 1068 | (AVLSet. meta avl-map _hash)) 1069 | 1070 | ICounted 1071 | (-count [this] 1072 | (-count avl-map)) 1073 | 1074 | IIndexed 1075 | (-nth [this i] 1076 | (if-let [n (select (.-tree avl-map) i)] 1077 | (.getVal n) 1078 | (throw (ex-info "nth index out of bounds in AVL tree" {})))) 1079 | 1080 | (-nth [this i not-found] 1081 | (if-let [n (select (.-tree avl-map) i)] 1082 | (.getVal n) 1083 | not-found)) 1084 | 1085 | ICollection 1086 | (-conj [this x] 1087 | (AVLSet. _meta (assoc avl-map x x) nil)) 1088 | 1089 | IEmptyableCollection 1090 | (-empty [this] 1091 | (AVLSet. _meta (empty avl-map) 0)) 1092 | 1093 | IEquiv 1094 | (-equiv [this that] 1095 | (and 1096 | (set? that) 1097 | (== (count this) (count that)) 1098 | (every? #(contains? this %) that))) 1099 | 1100 | ISeqable 1101 | (-seq [this] 1102 | (keys avl-map)) 1103 | 1104 | ISorted 1105 | (-sorted-seq [this ascending?] 1106 | (keys (-sorted-seq avl-map ascending?))) 1107 | 1108 | (-sorted-seq-from [this k ascending?] 1109 | (keys (-sorted-seq-from avl-map k ascending?))) 1110 | 1111 | (-entry-key [this entry] 1112 | entry) 1113 | 1114 | (-comparator [this] 1115 | (-comparator avl-map)) 1116 | 1117 | IReversible 1118 | (-rseq [this] 1119 | (map key (rseq avl-map))) 1120 | 1121 | ILookup 1122 | (-lookup [this v] 1123 | (-lookup this v nil)) 1124 | 1125 | (-lookup [this v not-found] 1126 | (let [n (lookup (.-comp avl-map) (.-tree avl-map) v)] 1127 | (if-not (nil? n) 1128 | (.-key n) 1129 | not-found))) 1130 | 1131 | ISet 1132 | (-disjoin [this v] 1133 | (AVLSet. _meta (dissoc avl-map v) nil)) 1134 | 1135 | IReduce 1136 | (-reduce [this f] 1137 | (case (-count avl-map) 1138 | 0 (f) 1139 | 1 (.getKey (.getTree avl-map)) 1140 | (let [tree (.getTree avl-map) 1141 | n0 (select tree 0) 1142 | init (avl-set-reduce-skip tree f (.getKey n0) n0)] 1143 | (if (reduced? init) 1144 | (-deref init) 1145 | init)))) 1146 | 1147 | (-reduce [this f init] 1148 | (let [tree (.getTree avl-map)] 1149 | (if (nil? tree) 1150 | init 1151 | (let [init (avl-set-reduce tree f init)] 1152 | (if (reduced? init) 1153 | (-deref init) 1154 | init))))) 1155 | IFn 1156 | (-invoke [this k] 1157 | (-lookup this k)) 1158 | 1159 | (-invoke [this k not-found] 1160 | (-lookup this k not-found)) 1161 | 1162 | IEditableCollection 1163 | (-as-transient [this] 1164 | (->AVLTransientSet (-as-transient avl-map)))) 1165 | 1166 | (deftype AVLTransientSet [^:mutable transient-avl-map] 1167 | ITransientCollection 1168 | (-conj! [this k] 1169 | (set! transient-avl-map (-assoc! transient-avl-map k k)) 1170 | this) 1171 | 1172 | (-persistent! [this] 1173 | (if (nil? (.-edit transient-avl-map)) 1174 | (throw (ex-info "persistent! used twice" {})) 1175 | (AVLSet. nil (-persistent! transient-avl-map) nil))) 1176 | 1177 | ITransientSet 1178 | (-disjoin! [this k] 1179 | (set! transient-avl-map (-dissoc! transient-avl-map k)) 1180 | this) 1181 | 1182 | ICounted 1183 | (-count [this] 1184 | (-count transient-avl-map)) 1185 | 1186 | ILookup 1187 | (-lookup [this k] 1188 | (-lookup this k nil)) 1189 | 1190 | (-lookup [this k not-found] 1191 | (if (identical? (-lookup transient-avl-map k lookup-sentinel) 1192 | lookup-sentinel) 1193 | not-found 1194 | k)) 1195 | 1196 | IFn 1197 | (-invoke [this k] 1198 | (-lookup transient-avl-map k)) 1199 | 1200 | (-invoke [this k not-found] 1201 | (-lookup transient-avl-map k not-found))) 1202 | 1203 | (def ^:private empty-map (AVLMap. compare nil 0 nil 0)) 1204 | 1205 | (def ^:private empty-set (AVLSet. nil empty-map 0)) 1206 | 1207 | (extend-protocol IPrintWithWriter 1208 | AVLMapSeq 1209 | (-pr-writer [this writer opts] 1210 | (pr-sequential-writer writer pr-writer "(" " " ")" opts this)) 1211 | 1212 | AVLMap 1213 | (-pr-writer [this writer opts] 1214 | (letfn [(pr-pair [keyval] 1215 | (pr-sequential-writer writer pr-writer "" " " "" opts keyval))] 1216 | (pr-sequential-writer writer pr-pair "{" ", " "}" opts this))) 1217 | 1218 | AVLSet 1219 | (-pr-writer [this writer opts] 1220 | (pr-sequential-writer writer pr-writer "#{" " " "}" opts this))) 1221 | 1222 | (defn sorted-map 1223 | "keyval => key val 1224 | Returns a new AVL map with supplied mappings." 1225 | [& keyvals] 1226 | (loop [in (seq keyvals) out (transient empty-map)] 1227 | (if in 1228 | (if-let [nin (next in)] 1229 | (recur (next nin) (assoc! out (first in) (first nin))) 1230 | (throw (ex-info 1231 | (str "sorted-map: no value supplied for key: " (first in)) 1232 | {}))) 1233 | (persistent! out)))) 1234 | 1235 | (defn sorted-map-by 1236 | "keyval => key val 1237 | Returns a new sorted map with supplied mappings, using the supplied 1238 | comparator." 1239 | [comparator & keyvals] 1240 | (loop [in (seq keyvals) 1241 | out (AVLTransientMap. (js-obj) (fn->comparator comparator) nil 0)] 1242 | (if in 1243 | (if-let [nin (next in)] 1244 | (recur (next nin) (assoc! out (first in) (first nin))) 1245 | (throw (ex-info 1246 | (str "sorted-map-by: no value supplied for key: " (first in)) 1247 | {}))) 1248 | (persistent! out)))) 1249 | 1250 | (defn sorted-set 1251 | "Returns a new sorted set with supplied keys." 1252 | [& keys] 1253 | (persistent! (reduce conj! (transient empty-set) keys))) 1254 | 1255 | (defn sorted-set-by 1256 | "Returns a new sorted set with supplied keys, using the supplied comparator." 1257 | [comparator & keys] 1258 | (persistent! 1259 | (reduce conj! 1260 | (AVLTransientSet. 1261 | (-as-transient (sorted-map-by (fn->comparator comparator)))) 1262 | keys))) 1263 | 1264 | (defn rank-of 1265 | "Returns the rank of x in coll or -1 if not present." 1266 | [coll x] 1267 | (rank (-comparator coll) (.getTree coll) x)) 1268 | 1269 | (defn nearest 1270 | "(alpha) 1271 | 1272 | Equivalent to, but more efficient than, (first (subseq* coll test x)), 1273 | where subseq* is clojure.core/subseq for test in #{>, >=} and 1274 | clojure.core/rsubseq for test in #{<, <=}." 1275 | [coll test x] 1276 | (.nearest coll test x)) 1277 | 1278 | (defn split-key 1279 | "(alpha) 1280 | 1281 | Returns [left e? right], where left and right are collections of 1282 | the same type as coll and containing, respectively, the keys below 1283 | and above k in the ordering determined by coll's comparator, while 1284 | e? is the entry at key k for maps, the stored copy of the key k for 1285 | sets, nil if coll does not contain k." 1286 | [k coll] 1287 | (let [comp (-comparator coll) 1288 | [left e? right] (split comp (.getTree coll) k) 1289 | keyfn (if (map? coll) key identity) 1290 | wrap (if (map? coll) 1291 | (fn wrap-map [tree cnt] 1292 | (AVLMap. comp tree cnt nil -1)) 1293 | (fn wrap-set [tree cnt] 1294 | (AVLSet. nil (AVLMap. comp tree cnt nil -1) -1)))] 1295 | [(wrap left 1296 | (if (or e? right) 1297 | (rank-of coll (keyfn (nearest coll >= k))) 1298 | (count coll))) 1299 | (if (and e? (set? coll)) 1300 | (key e?) 1301 | e?) 1302 | (wrap right 1303 | (if right 1304 | (- (count coll) (rank-of coll (keyfn (nearest coll > k)))) 1305 | 0))])) 1306 | 1307 | (defn split-at 1308 | "(alpha) 1309 | 1310 | Equivalent to, but more efficient than, 1311 | [(into (empty coll) (take n coll)) 1312 | (into (empty coll) (drop n coll))]." 1313 | [n coll] 1314 | (if (>= n (count coll)) 1315 | [coll (empty coll)] 1316 | (let [k (nth coll n) 1317 | k (if (map? coll) (key k) k) 1318 | [l e r] (split-key k coll)] 1319 | [l (conj r e)]))) 1320 | 1321 | (defn subrange 1322 | "(alpha) 1323 | 1324 | Returns an AVL collection comprising the entries of coll between 1325 | start and end (in the sense determined by coll's comparator) in 1326 | logarithmic time. Whether the endpoints are themselves included in 1327 | the returned collection depends on the provided tests; start-test 1328 | must be either > or >=, end-test must be either < or <=. 1329 | 1330 | When passed a single test and limit, subrange infers the other end 1331 | of the range from the test: > / >= mean to include items up to the 1332 | end of coll, < / <= mean to include items taken from the beginning 1333 | of coll. 1334 | 1335 | (subrange coll >= start <= end) is equivalent to, but more efficient 1336 | than, (into (empty coll) (subseq coll >= start <= end)." 1337 | ([coll test limit] 1338 | (if (zero? (count coll)) 1339 | coll 1340 | (let [comp (-comparator coll)] 1341 | (if (#{> >=} test) 1342 | (let [n (select (.getTree coll) (dec (count coll))) 1343 | k (.getKey n)] 1344 | (if (pos? (comp limit k)) 1345 | (empty coll) 1346 | (subrange coll 1347 | test limit 1348 | <= k))) 1349 | (let [n (select (.getTree coll) 0) 1350 | k (.getKey n)] 1351 | (if (neg? (comp limit k)) 1352 | (empty coll) 1353 | (subrange coll 1354 | >= k 1355 | test limit))))))) 1356 | ([coll start-test start end-test end] 1357 | (if (zero? (count coll)) 1358 | coll 1359 | (let [comp (-comparator coll)] 1360 | (if (pos? (comp start end)) 1361 | (throw (ex-info "start greater than end in subrange" {})) 1362 | (let [input-tree (.getTree coll) 1363 | l (lookup-nearest comp input-tree start-test start) 1364 | h (lookup-nearest comp input-tree end-test end)] 1365 | (if (and l h) 1366 | (let [lk (.getKey l) 1367 | hk (.getKey h)] 1368 | (if (neg? (comp hk lk)) 1369 | (empty coll) 1370 | (let [tree (range comp (.getTree coll) lk hk) 1371 | cnt (inc (- (rank-of coll hk) 1372 | (rank-of coll lk))) 1373 | m (AVLMap. comp tree cnt nil -1)] 1374 | (if (map? coll) 1375 | m 1376 | (AVLSet. nil m -1))))) 1377 | (empty coll)))))))) 1378 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/avl.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.avl 10 | 11 | "An implementation of persistent sorted maps and sets based on AVL 12 | trees which can be used as drop-in replacements for Clojure's 13 | built-in sorted maps and sets based on red-black trees. Apart from 14 | the standard sorted collection API, the provided map and set types 15 | support the transients API and several additional logarithmic time 16 | operations: rank queries via clojure.core/nth (select element by 17 | rank) and clojure.data.avl/rank-of (discover rank of element), 18 | \"nearest key\" lookups via clojure.data.avl/nearest, splits by key 19 | and index via clojure.data.avl/split-key and 20 | clojure.data.avl/split-at, respectively, and subsets/submaps using 21 | clojure.data.avl/subrange." 22 | 23 | {:author "Michał Marczyk"} 24 | 25 | (:refer-clojure :exclude [sorted-map sorted-map-by sorted-set sorted-set-by 26 | range split-at]) 27 | (:import (clojure.lang RT Util APersistentMap APersistentSet 28 | IPersistentMap IPersistentSet IPersistentStack 29 | Box MapEntry SeqIterator) 30 | (java.util Comparator Collections ArrayList) 31 | (java.util.concurrent.atomic AtomicReference))) 32 | 33 | (set! *warn-on-reflection* true) 34 | (set! *unchecked-math* :warn-on-boxed) 35 | 36 | (defn ^:private throw-unsupported [] 37 | (throw (UnsupportedOperationException.))) 38 | 39 | (defmacro ^:private caching-hash [coll hash-fn hash-key] 40 | `(let [h# ~hash-key] 41 | (if-not (== h# (int -1)) 42 | h# 43 | (let [h# (~hash-fn ~coll)] 44 | (set! ~hash-key (int h#)) 45 | h#)))) 46 | 47 | (defmacro ^:private compile-if [test then else] 48 | (if (eval test) 49 | then 50 | else)) 51 | 52 | (def ^:private ^:const empty-set-hashcode (.hashCode #{})) 53 | (def ^:private ^:const empty-set-hasheq (hash #{})) 54 | (def ^:private ^:const empty-map-hashcode (.hashCode {})) 55 | (def ^:private ^:const empty-map-hasheq (hash {})) 56 | 57 | (defn ^:private hash-imap 58 | [^IPersistentMap m] 59 | (APersistentMap/mapHash m)) 60 | 61 | (defn ^:private hasheq-imap 62 | [^IPersistentMap m] 63 | (compile-if (resolve 'clojure.core/hash-unordered-coll) 64 | (hash-unordered-coll m) 65 | (APersistentMap/mapHasheq m))) 66 | 67 | (defn ^:private hash-iset [^IPersistentSet s] 68 | ;; a la clojure.lang.APersistentSet 69 | (loop [h (int 0) s (seq s)] 70 | (if s 71 | (let [e (first s)] 72 | (recur (unchecked-add-int h (if (nil? e) 0 (.hashCode ^Object e))) 73 | (next s))) 74 | h))) 75 | 76 | (defn ^:private hasheq-iset [^IPersistentSet s] 77 | (compile-if (resolve 'clojure.core/hash-unordered-coll) 78 | (hash-unordered-coll s) 79 | (loop [h (int 0) s (seq s)] 80 | (if s 81 | (recur (unchecked-add-int h (Util/hasheq (first s))) 82 | (next s)) 83 | h)))) 84 | 85 | (defn ^:private hash-seq 86 | [s] 87 | (loop [h (int 1) s (seq s)] 88 | (if s 89 | (recur (unchecked-add-int (unchecked-multiply-int (int 31) h) 90 | (if (nil? (first s)) 91 | (int 0) 92 | (.hashCode ^Object (first s)))) 93 | (next s)) 94 | h))) 95 | 96 | (defn ^:private hasheq-seq 97 | [s] 98 | (compile-if (resolve 'clojure.core/hash-ordered-coll) 99 | (hash-ordered-coll s) 100 | (loop [h (int 1) s (seq s)] 101 | (if s 102 | (recur (unchecked-add-int (unchecked-multiply-int (int 31) h) 103 | (Util/hasheq (first s))) 104 | (next s)) 105 | h)))) 106 | 107 | (defn ^:private equiv-sequential 108 | "Assumes x is sequential. Returns true if x equals y, otherwise 109 | returns false." 110 | [x y] 111 | (boolean 112 | (when (or (sequential? y) (instance? java.util.List y)) 113 | (loop [xs (seq x) ys (seq y)] 114 | (cond (nil? xs) (nil? ys) 115 | (nil? ys) false 116 | (= (first xs) (first ys)) (recur (next xs) (next ys)) 117 | :else false))))) 118 | 119 | (def ^:private never-equiv (Object.)) 120 | 121 | (defn ^:private equiv-map 122 | "Assumes x is a map. Returns true if y equals x, otherwise returns 123 | false." 124 | [^clojure.lang.IPersistentMap x y] 125 | (if-not (instance? java.util.Map y) 126 | false 127 | (if (and (instance? clojure.lang.IPersistentMap y) 128 | (not (instance? clojure.lang.MapEquivalence y))) 129 | false 130 | (let [m ^java.util.Map y] 131 | (if-not (== (.size ^java.util.Map x) (.size m)) 132 | false 133 | (reduce-kv (fn [t k v] 134 | (if-not (.containsKey m k) 135 | (reduced false) 136 | (if-not (Util/equiv v (.get m k)) 137 | (reduced false) 138 | t))) 139 | true 140 | x)))))) 141 | 142 | (gen-interface 143 | :name clojure.data.avl.IAVLNode 144 | :methods 145 | [[getKey [] Object] 146 | [setKey [Object] clojure.data.avl.IAVLNode] 147 | [getVal [] Object] 148 | [setVal [Object] clojure.data.avl.IAVLNode] 149 | [getLeft [] clojure.data.avl.IAVLNode] 150 | [setLeft [clojure.data.avl.IAVLNode] clojure.data.avl.IAVLNode] 151 | [getRight [] clojure.data.avl.IAVLNode] 152 | [setRight [clojure.data.avl.IAVLNode] clojure.data.avl.IAVLNode] 153 | [getHeight [] int] 154 | [setHeight [int] clojure.data.avl.IAVLNode] 155 | [getRank [] int] 156 | [setRank [int] clojure.data.avl.IAVLNode]]) 157 | 158 | (gen-interface 159 | :name clojure.data.avl.IAVLTree 160 | :methods [[getTree [] clojure.data.avl.IAVLNode]]) 161 | 162 | (defmacro ^:private define-i-transient-associative-2-impl [] 163 | (let [ita2-exists? 164 | (try (Class/forName "clojure.lang.ITransientAssociative2") 165 | true 166 | (catch ClassNotFoundException _ 167 | false))] 168 | `(gen-interface 169 | :name ~'clojure.data.avl.ITransientAssociative2Impl 170 | ~@(if ita2-exists? 171 | '[:extends [clojure.lang.ITransientAssociative2]]) 172 | :methods 173 | ~'[[containsKey [Object] boolean] 174 | [entryAt [Object] clojure.lang.IMapEntry]]))) 175 | 176 | (define-i-transient-associative-2-impl) 177 | 178 | (import (clojure.data.avl IAVLNode IAVLTree ITransientAssociative2Impl)) 179 | 180 | (definterface INavigableTree 181 | (nearest [test k])) 182 | 183 | (deftype AVLNode [^AtomicReference edit 184 | ^:unsynchronized-mutable key 185 | ^:unsynchronized-mutable val 186 | ^:unsynchronized-mutable ^IAVLNode left 187 | ^:unsynchronized-mutable ^IAVLNode right 188 | ^:unsynchronized-mutable ^int height 189 | ^:unsynchronized-mutable ^int rank] 190 | IAVLNode 191 | (getKey [this] 192 | key) 193 | 194 | (setKey [this k] 195 | (set! key k) 196 | this) 197 | 198 | (getVal [this] 199 | val) 200 | 201 | (setVal [this v] 202 | (set! val v) 203 | this) 204 | 205 | (getLeft [this] 206 | left) 207 | 208 | (setLeft [this l] 209 | (set! left l) 210 | this) 211 | 212 | (getRight [this] 213 | right) 214 | 215 | (setRight [this r] 216 | (set! right r) 217 | this) 218 | 219 | (getHeight [this] 220 | height) 221 | 222 | (setHeight [this h] 223 | (set! height h) 224 | this) 225 | 226 | (getRank [this] 227 | rank) 228 | 229 | (setRank [this r] 230 | (set! rank r) 231 | this) 232 | 233 | Object 234 | (equals [this that] 235 | (cond 236 | (identical? this that) true 237 | 238 | (or (instance? clojure.lang.IPersistentVector that) 239 | (instance? java.util.RandomAccess that)) 240 | (and (== 2 (count that)) 241 | (.equals key (nth that 0)) 242 | (.equals val (nth that 1))) 243 | 244 | (or (instance? clojure.lang.Sequential that) 245 | (instance? java.util.List that)) 246 | (and (== 2 (count that)) 247 | (.equals key (first that)) 248 | (.equals val (second that))) 249 | 250 | :else false)) 251 | 252 | (hashCode [this] 253 | (-> (int 31) 254 | (unchecked-add-int (Util/hash key)) 255 | (unchecked-multiply-int (int 31)) 256 | (unchecked-add-int (Util/hash val)))) 257 | 258 | (toString [this] 259 | (pr-str this)) 260 | 261 | clojure.lang.IHashEq 262 | (hasheq [this] 263 | (compile-if (resolve 'clojure.core/hash-ordered-coll) 264 | (hash-ordered-coll this) 265 | (-> (int 31) 266 | (unchecked-add-int (Util/hasheq key)) 267 | (unchecked-multiply-int (int 31)) 268 | (unchecked-add-int (Util/hasheq val))))) 269 | 270 | clojure.lang.Indexed 271 | (nth [this n] 272 | (case n 273 | 0 key 274 | 1 val 275 | (throw 276 | (IndexOutOfBoundsException. "nth index out of bounds in AVLNode")))) 277 | 278 | (nth [this n not-found] 279 | (case n 280 | 0 key 281 | 1 val 282 | not-found)) 283 | 284 | clojure.lang.Counted 285 | (count [this] 286 | 2) 287 | 288 | clojure.lang.IMeta 289 | (meta [this] 290 | nil) 291 | 292 | clojure.lang.IObj 293 | (withMeta [this m] 294 | (with-meta [key val] m)) 295 | 296 | clojure.lang.IPersistentCollection 297 | (cons [this x] 298 | [key val x]) 299 | 300 | (empty [this] 301 | []) 302 | 303 | (equiv [this that] 304 | (cond 305 | (or (instance? clojure.lang.IPersistentVector that) 306 | (instance? java.util.RandomAccess that)) 307 | (and (== 2 (count that)) 308 | (= key (nth that 0)) 309 | (= val (nth that 1))) 310 | 311 | (or (instance? clojure.lang.Sequential that) 312 | (instance? java.util.List that)) 313 | (and (== 2 (count that)) 314 | (= key (first that)) 315 | (= val (second that))) 316 | 317 | :else false)) 318 | 319 | clojure.lang.IPersistentStack 320 | (peek [this] 321 | val) 322 | 323 | (pop [this] 324 | [key]) 325 | 326 | clojure.lang.IPersistentVector 327 | (assocN [this i x] 328 | (case i 329 | 0 [x val] 330 | 1 [key x] 331 | (throw 332 | (IndexOutOfBoundsException. "assocN index out of bounds in AVLNode")))) 333 | 334 | (length [this] 335 | 2) 336 | 337 | clojure.lang.Reversible 338 | (rseq [this] 339 | (list val key)) 340 | 341 | clojure.lang.Associative 342 | (assoc [this k v] 343 | (if (Util/isInteger k) 344 | (.assocN this k v) 345 | (throw (IllegalArgumentException. "key must be integer")))) 346 | 347 | (containsKey [this k] 348 | (if (Util/isInteger k) 349 | (case (int k) 350 | 0 true 351 | 1 true 352 | false) 353 | false)) 354 | 355 | (entryAt [this k] 356 | (if (Util/isInteger k) 357 | (case (int k) 358 | 0 (MapEntry. 0 key) 359 | 1 (MapEntry. 1 val) 360 | nil))) 361 | 362 | clojure.lang.ILookup 363 | (valAt [this k not-found] 364 | (if (Util/isInteger k) 365 | (case (int k) 366 | 0 key 367 | 1 val 368 | not-found) 369 | not-found)) 370 | 371 | (valAt [this k] 372 | (.valAt this k nil)) 373 | 374 | clojure.lang.IFn 375 | (invoke [this k] 376 | (if (Util/isInteger k) 377 | (case (int k) 378 | 0 key 379 | 1 val 380 | (throw 381 | (IndexOutOfBoundsException. 382 | "invoke index out of bounds in AVLNode"))) 383 | (throw (IllegalArgumentException. "key must be integer")))) 384 | 385 | (applyTo [this args] 386 | (let [n (RT/boundedLength args 1)] 387 | (case n 388 | 0 (throw (clojure.lang.ArityException. 389 | n (.. this (getClass) (getSimpleName)))) 390 | 1 (.invoke this (first args)) 391 | 2 (throw (clojure.lang.ArityException. 392 | n (.. this (getClass) (getSimpleName))))))) 393 | 394 | clojure.lang.Seqable 395 | (seq [this] 396 | (list key val)) 397 | 398 | clojure.lang.Sequential 399 | 400 | clojure.lang.IEditableCollection 401 | (asTransient [this] 402 | (transient [key val])) 403 | 404 | clojure.lang.IMapEntry 405 | (key [this] 406 | key) 407 | 408 | (val [this] 409 | val) 410 | 411 | java.util.Map$Entry 412 | (getValue [this] 413 | val) 414 | 415 | (setValue [this x] 416 | (throw-unsupported)) 417 | 418 | java.io.Serializable 419 | 420 | java.lang.Comparable 421 | (compareTo [this that] 422 | (if (identical? this that) 423 | 0 424 | (let [^clojure.lang.IPersistentVector v 425 | (cast clojure.lang.IPersistentVector that) 426 | vcnt (.count v)] 427 | (cond 428 | (< 2 vcnt) -1 429 | (> 2 vcnt) 1 430 | :else 431 | (let [comp (Util/compare key (.nth v 0))] 432 | (if (zero? comp) 433 | (Util/compare val (.nth v 1)) 434 | comp)))))) 435 | 436 | java.lang.Iterable 437 | (iterator [this] 438 | (.iterator ^java.lang.Iterable (list key val))) 439 | 440 | java.util.RandomAccess 441 | java.util.List 442 | (get [this i] 443 | (.nth this i)) 444 | 445 | (indexOf [this x] 446 | (condp = x 447 | key 0 448 | val 1 449 | -1)) 450 | 451 | (lastIndexOf [this x] 452 | (condp = x 453 | val 1 454 | key 0 455 | -1)) 456 | 457 | (listIterator [this] 458 | (.listIterator this 0)) 459 | 460 | (listIterator [this i] 461 | (.listIterator (doto (java.util.ArrayList.) 462 | (.add key) 463 | (.add val)) 464 | i)) 465 | 466 | (subList [this a z] 467 | (if (<= 0 a z 2) 468 | (cond 469 | (== a z) [] 470 | (and (== a 0) (== z 2)) this 471 | :else (case a 472 | 0 [key] 473 | 1 [val])) 474 | (throw 475 | (IndexOutOfBoundsException. "subList index out of bounds in AVLNode")))) 476 | 477 | java.util.Collection 478 | (contains [this x] 479 | (or (= key x) (= val x))) 480 | 481 | (containsAll [this c] 482 | (every? #(.contains this %) c)) 483 | 484 | (isEmpty [this] 485 | false) 486 | 487 | (toArray [this] 488 | (into-array Object this)) 489 | 490 | (^objects toArray [this ^objects arr] 491 | (if (>= (count arr) 2) 492 | (doto arr 493 | (aset 0 key) 494 | (aset 1 val)) 495 | (into-array Object this))) 496 | 497 | (size [this] 498 | 2) 499 | 500 | (add [this x] (throw-unsupported)) 501 | (^boolean remove [this x] (throw-unsupported)) 502 | (addAll [this c] (throw-unsupported)) 503 | (clear [this] (throw-unsupported)) 504 | (retainAll [this c] (throw-unsupported)) 505 | (removeAll [this c] (throw-unsupported)) 506 | (set [this i e] (throw-unsupported)) 507 | (remove [this ^int i] (throw-unsupported)) 508 | (add [this i e] (throw-unsupported))) 509 | 510 | (defn ^:private ensure-editable 511 | (^IAVLNode [^AtomicReference edit] 512 | (let [owner (.get edit)] 513 | (cond 514 | (identical? owner (Thread/currentThread)) 515 | true 516 | 517 | (nil? owner) 518 | (throw (IllegalAccessError. "Transient used after persistent! call")) 519 | 520 | :else 521 | (throw (IllegalAccessError. "Transient used by non-owner thread"))))) 522 | (^IAVLNode [^AtomicReference edit ^AVLNode node] 523 | (if (identical? edit (.-edit node)) 524 | node 525 | (AVLNode. edit 526 | (.getKey node) (.getVal node) 527 | (.getLeft node) 528 | (.getRight node) 529 | (.getHeight node) 530 | (.getRank node))))) 531 | 532 | (defn ^:private height ^long [^IAVLNode node] 533 | (if (nil? node) 534 | 0 535 | (long (.getHeight node)))) 536 | 537 | (defn ^:private rotate-left ^IAVLNode [^IAVLNode node] 538 | (let [l (.getLeft node) 539 | r (.getRight node) 540 | rl (.getLeft r) 541 | rr (.getRight r) 542 | lh (height l) 543 | rlh (height rl) 544 | rrh (height rr) 545 | rnk (.getRank node) 546 | rnkr (.getRank r)] 547 | (AVLNode. nil 548 | (.getKey r) (.getVal r) 549 | (AVLNode. nil 550 | (.getKey node) (.getVal node) 551 | l 552 | rl 553 | (inc (max lh rlh)) 554 | rnk) 555 | rr 556 | (max (+ lh 2) 557 | (+ rlh 2) 558 | (inc rrh)) 559 | (inc (+ rnk rnkr))))) 560 | 561 | (defn ^:private rotate-left! ^IAVLNode [edit ^IAVLNode node] 562 | (let [node (ensure-editable edit node) 563 | l (.getLeft node) 564 | r (ensure-editable edit (.getRight node)) 565 | rl (.getLeft r) 566 | rr (.getRight r) 567 | lh (height l) 568 | rlh (height rl) 569 | rrh (height rr) 570 | rnk (.getRank node) 571 | rnkr (.getRank r)] 572 | (.setLeft r node) 573 | (.setHeight r (max (+ lh 2) (+ rlh 2) (inc rrh))) 574 | (.setRank r (inc (+ rnk rnkr))) 575 | (.setRight node rl) 576 | (.setHeight node (inc (max lh rlh))) 577 | r)) 578 | 579 | (defn ^:private rotate-right ^IAVLNode [^IAVLNode node] 580 | (let [r (.getRight node) 581 | l (.getLeft node) 582 | lr (.getRight l) 583 | ll (.getLeft l) 584 | rh (height r) 585 | lrh (height lr) 586 | llh (height ll) 587 | rnk (.getRank node) 588 | rnkl (.getRank l)] 589 | (AVLNode. nil 590 | (.getKey l) (.getVal l) 591 | ll 592 | (AVLNode. nil 593 | (.getKey node) (.getVal node) 594 | lr 595 | r 596 | (inc (max rh lrh)) 597 | (dec (- rnk rnkl))) 598 | (max (+ rh 2) 599 | (+ lrh 2) 600 | (inc llh)) 601 | rnkl))) 602 | 603 | (defn ^:private rotate-right! ^IAVLNode [edit ^IAVLNode node] 604 | (let [node (ensure-editable edit node) 605 | r (.getRight node) 606 | l (ensure-editable edit (.getLeft node)) 607 | lr (.getRight l) 608 | ll (.getLeft l) 609 | rh (height r) 610 | lrh (height lr) 611 | llh (height ll) 612 | rnk (.getRank node) 613 | rnkl (.getRank l)] 614 | (.setRight l node) 615 | (.setHeight l (max (+ rh 2) (+ lrh 2) (inc llh))) 616 | (.setLeft node lr) 617 | (.setHeight node (inc (max rh lrh))) 618 | (.setRank node (dec (- rnk rnkl))) 619 | l)) 620 | 621 | (defn ^:private lookup ^IAVLNode [^Comparator comp ^IAVLNode node k] 622 | (if (nil? node) 623 | nil 624 | (let [c (.compare comp k (.getKey node))] 625 | (cond 626 | (zero? c) node 627 | (neg? c) (recur comp (.getLeft node) k) 628 | :else (recur comp (.getRight node) k))))) 629 | 630 | (defn ^:private lookup-nearest 631 | ^IAVLNode [^Comparator comp ^IAVLNode node test k] 632 | (let [below? (or (identical? < test) (identical? <= test)) 633 | equal? (or (identical? <= test) (identical? >= test)) 634 | back? (if below? neg? pos?) 635 | backward (if below? 636 | #(.getLeft ^IAVLNode %) 637 | #(.getRight ^IAVLNode %)) 638 | forward (if below? 639 | #(.getRight ^IAVLNode %) 640 | #(.getLeft ^IAVLNode %))] 641 | (loop [prev nil 642 | node node] 643 | (if (nil? node) 644 | prev 645 | (let [c (.compare comp k (.getKey node))] 646 | (cond 647 | (zero? c) (if equal? 648 | node 649 | (recur prev (backward node))) 650 | (back? c) (recur prev (backward node)) 651 | :else (recur node (forward node)))))))) 652 | 653 | (defn ^:private select [^IAVLNode node ^long rank] 654 | (if (nil? node) 655 | nil 656 | (let [node-rank (.getRank node)] 657 | (cond 658 | (== node-rank rank) node 659 | (< node-rank rank) (recur (.getRight node) (dec (- rank node-rank))) 660 | :else (recur (.getLeft node) rank))))) 661 | 662 | (defn ^:private rank ^long [^Comparator comp ^IAVLNode node k] 663 | (if (nil? node) 664 | -1 665 | (let [c (.compare comp k (.getKey node))] 666 | (cond 667 | (zero? c) (.getRank node) 668 | (neg? c) (recur comp (.getLeft node) k) 669 | :else (let [r (rank comp (.getRight node) k)] 670 | (if (== -1 r) 671 | -1 672 | (inc (+ (.getRank node) r)))))))) 673 | 674 | (defn ^:private maybe-rebalance ^IAVLNode [^IAVLNode node] 675 | (let [l (.getLeft node) 676 | r (.getRight node) 677 | lh (height l) 678 | rh (height r) 679 | b (- lh rh)] 680 | (cond 681 | ;; right-heavy 682 | (< b -1) 683 | (let [rl (.getLeft r) 684 | rr (.getRight r) 685 | rlh (height rl) 686 | rrh (height rr)] 687 | (if (== (- rlh rrh) 1) 688 | ;; left-heavy 689 | (let [new-right (rotate-right r)] 690 | (rotate-left (AVLNode. nil 691 | (.getKey node) (.getVal node) 692 | (.getLeft node) 693 | new-right 694 | (inc (max lh (height new-right))) 695 | (.getRank node)))) 696 | (rotate-left node))) 697 | 698 | ;; left-heavy 699 | (> b 1) 700 | (let [ll (.getLeft l) 701 | lr (.getRight l) 702 | llh (height ll) 703 | lrh (height lr)] 704 | ;; right-heavy 705 | (if (== (- lrh llh) 1) 706 | (let [new-left (rotate-left l)] 707 | (rotate-right (AVLNode. nil 708 | (.getKey node) (.getVal node) 709 | new-left 710 | (.getRight node) 711 | (inc (max rh (height new-left))) 712 | (.getRank node)))) 713 | (rotate-right node))) 714 | 715 | :else 716 | node))) 717 | 718 | (defn ^:private maybe-rebalance! ^IAVLNode [edit ^IAVLNode node] 719 | (let [l (.getLeft node) 720 | r (.getRight node) 721 | lh (height l) 722 | rh (height r) 723 | b (- lh rh)] 724 | (cond 725 | ;; right-heavy 726 | (< b -1) 727 | (let [node (ensure-editable edit node) 728 | rl (.getLeft r) 729 | rr (.getRight r) 730 | rlh (height rl) 731 | rrh (height rr)] 732 | (if (== (- rlh rrh) 1) 733 | ;; left-heavy 734 | (let [new-right (rotate-right! edit r)] 735 | (.setRight node new-right) 736 | (.setHeight node (inc (max lh (height new-right)))) 737 | (rotate-left! edit node)) 738 | (rotate-left! edit node))) 739 | 740 | ;; left-heavy 741 | (> b 1) 742 | (let [node (ensure-editable edit node) 743 | ll (.getLeft l) 744 | lr (.getRight l) 745 | llh (height ll) 746 | lrh (height lr)] 747 | ;; right-heavy 748 | (if (== (- lrh llh) 1) 749 | (let [new-left (rotate-left! edit l)] 750 | (.setLeft node new-left) 751 | (.setHeight node (inc (max rh (height new-left)))) 752 | (rotate-right! edit node)) 753 | (rotate-right! edit node))) 754 | 755 | :else 756 | node))) 757 | 758 | (defn ^:private insert 759 | ^IAVLNode [^Comparator comp ^IAVLNode node k v ^Box found?] 760 | (if (nil? node) 761 | (AVLNode. nil k v nil nil 1 0) 762 | (let [nk (.getKey node) 763 | c (.compare comp k nk)] 764 | (cond 765 | (zero? c) 766 | (do 767 | (set! (.-val found?) true) 768 | (AVLNode. nil 769 | k v 770 | (.getLeft node) 771 | (.getRight node) 772 | (.getHeight node) 773 | (.getRank node))) 774 | 775 | (neg? c) 776 | (let [new-child (insert comp (.getLeft node) k v found?)] 777 | (maybe-rebalance 778 | (AVLNode. nil 779 | nk (.getVal node) 780 | new-child 781 | (.getRight node) 782 | (inc (max (.getHeight new-child) 783 | (height (.getRight node)))) 784 | (if (.-val found?) 785 | (.getRank node) 786 | (unchecked-inc-int (.getRank node)))))) 787 | 788 | :else 789 | (let [new-child (insert comp (.getRight node) k v found?)] 790 | (maybe-rebalance 791 | (AVLNode. nil 792 | nk (.getVal node) 793 | (.getLeft node) 794 | new-child 795 | (inc (max (.getHeight new-child) 796 | (height (.getLeft node)))) 797 | (.getRank node)))))))) 798 | 799 | (defn ^:private insert! 800 | ^IAVLNode [edit ^Comparator comp ^IAVLNode node k v ^Box found?] 801 | (if (nil? node) 802 | (AVLNode. edit k v nil nil 1 0) 803 | (let [node (ensure-editable edit node) 804 | nk (.getKey node) 805 | c (.compare comp k nk)] 806 | (cond 807 | (zero? c) 808 | (do 809 | (set! (.-val found?) true) 810 | (.setKey node k) 811 | (.setVal node v) 812 | node) 813 | 814 | (neg? c) 815 | (let [new-child (insert! edit comp (.getLeft node) k v found?)] 816 | (.setLeft node new-child) 817 | (.setHeight node 818 | (inc (max (.getHeight new-child) 819 | (height (.getRight node))))) 820 | (if-not (.-val found?) 821 | (.setRank node (unchecked-inc-int (.getRank node)))) 822 | (maybe-rebalance! edit node)) 823 | 824 | :else 825 | (let [new-child (insert! edit comp (.getRight node) k v found?)] 826 | (.setRight node new-child) 827 | (.setHeight node 828 | (inc (max (.getHeight new-child) 829 | (height (.getLeft node))))) 830 | (maybe-rebalance! edit node)))))) 831 | 832 | (defn ^:private get-rightmost ^IAVLNode [^IAVLNode node] 833 | (if-let [r (.getRight node)] 834 | (recur r) 835 | node)) 836 | 837 | (defn ^:private get-leftmost ^IAVLNode [^IAVLNode node] 838 | (if-let [l (.getLeft node)] 839 | (recur l) 840 | node)) 841 | 842 | (defn ^:private delete-rightmost ^IAVLNode [^IAVLNode node] 843 | (if-let [r (.getRight node)] 844 | (let [l (.getLeft node) 845 | new-right (delete-rightmost r)] 846 | (maybe-rebalance 847 | (AVLNode. nil 848 | (.getKey node) (.getVal node) 849 | l 850 | new-right 851 | (inc (max (height l) (height new-right))) 852 | (.getRank node)))) 853 | (.getLeft node))) 854 | 855 | (defn ^:private delete-rightmost! ^IAVLNode [edit ^IAVLNode node] 856 | (if-not (nil? node) 857 | (let [node (ensure-editable edit node) 858 | r ^IAVLNode (.getRight node)] 859 | (cond 860 | (nil? r) 861 | (if-let [l (.getLeft node)] 862 | (ensure-editable edit l)) 863 | 864 | (nil? (.getRight r)) 865 | (do 866 | (.setRight node (.getLeft r)) 867 | (.setHeight node 868 | (inc (max (height (.getLeft node)) 869 | (height (.getLeft r))))) 870 | (maybe-rebalance! edit node)) 871 | 872 | :else 873 | (let [new-right (delete-rightmost! edit r)] 874 | (.setRight node new-right) 875 | (.setHeight node 876 | (inc (max (height (.getLeft node)) 877 | (height new-right)))) 878 | (maybe-rebalance! edit node)))))) 879 | 880 | (defn ^:private delete 881 | ^IAVLNode [^Comparator comp ^IAVLNode node k ^Box found?] 882 | (if (nil? node) 883 | nil 884 | (let [nk (.getKey node) 885 | c (.compare comp k nk)] 886 | (cond 887 | (zero? c) 888 | (let [l (.getLeft node) 889 | r (.getRight node)] 890 | (set! (.-val found?) true) 891 | (if (and l r) 892 | (let [p (get-rightmost l) 893 | l' (delete-rightmost l)] 894 | (maybe-rebalance 895 | (AVLNode. nil 896 | (.getKey p) (.getVal p) 897 | l' 898 | r 899 | (inc (max (height l') (height r))) 900 | (unchecked-dec-int (.getRank node))))) 901 | (or l r))) 902 | 903 | (neg? c) 904 | (let [new-child (delete comp (.getLeft node) k found?)] 905 | (if (identical? new-child (.getLeft node)) 906 | node 907 | (maybe-rebalance 908 | (AVLNode. nil 909 | nk (.getVal node) 910 | new-child 911 | (.getRight node) 912 | (inc (max (height new-child) 913 | (height (.getRight node)))) 914 | (if (.-val found?) 915 | (unchecked-dec-int (.getRank node)) 916 | (.getRank node)))))) 917 | 918 | :else 919 | (let [new-child (delete comp (.getRight node) k found?)] 920 | (if (identical? new-child (.getRight node)) 921 | node 922 | (maybe-rebalance 923 | (AVLNode. nil 924 | nk (.getVal node) 925 | (.getLeft node) 926 | new-child 927 | (inc (max (height new-child) 928 | (height (.getLeft node)))) 929 | (.getRank node))))))))) 930 | 931 | (defn ^:private delete! 932 | ^IAVLNode [edit ^Comparator comp ^IAVLNode node k ^Box found?] 933 | (if (nil? node) 934 | nil 935 | (let [nk (.getKey node) 936 | c (.compare comp k nk)] 937 | (cond 938 | (zero? c) 939 | (let [l (.getLeft node) 940 | r (.getRight node)] 941 | (set! (.-val found?) true) 942 | (cond 943 | (and l r) 944 | (let [node (ensure-editable edit node) 945 | p (get-rightmost l) 946 | l' (delete-rightmost! edit l)] 947 | (.setKey node (.getKey p)) 948 | (.setVal node (.getVal p)) 949 | (.setLeft node l') 950 | (.setHeight node (inc (max (height l') (height r)))) 951 | (.setRank node (unchecked-dec-int (.getRank node))) 952 | (maybe-rebalance! edit node)) 953 | 954 | l l 955 | r r 956 | :else nil)) 957 | 958 | (neg? c) 959 | (let [new-child (delete! edit comp (.getLeft node) k found?)] 960 | (if (.-val found?) 961 | (let [node (ensure-editable edit node)] 962 | (.setLeft node new-child) 963 | (.setHeight node 964 | (inc (max (height new-child) 965 | (height (.getRight node))))) 966 | (.setRank node (unchecked-dec-int (.getRank node))) 967 | (maybe-rebalance! edit node)) 968 | node)) 969 | 970 | :else 971 | (let [new-child (delete! edit comp (.getRight node) k found?)] 972 | (if (.-val found?) 973 | (let [node (ensure-editable edit node)] 974 | (.setRight node new-child) 975 | (.setHeight node 976 | (inc (max (height new-child) 977 | (height (.getLeft node))))) 978 | (maybe-rebalance! edit node)) 979 | node)))))) 980 | 981 | (defn ^:private join 982 | [^Comparator comp ^long left-count ^IAVLNode left ^IAVLNode right] 983 | (cond 984 | (nil? left) right 985 | (nil? right) left 986 | :else 987 | (let [lh (.getHeight left) 988 | rh (.getHeight right)] 989 | (cond 990 | (== lh rh) 991 | (let [left-min (get-rightmost left) 992 | new-left (delete comp left (.getKey left-min) (Box. false))] 993 | (AVLNode. nil 994 | (.getKey left-min) (.getVal left-min) 995 | new-left 996 | right 997 | (unchecked-inc-int rh) 998 | (unchecked-dec-int left-count))) 999 | 1000 | (< lh rh) 1001 | (letfn [(step [^IAVLNode current ^long lvl] 1002 | (cond 1003 | (zero? lvl) 1004 | (join comp left-count left current) 1005 | 1006 | (nil? (.getLeft current)) 1007 | (AVLNode. nil 1008 | (.getKey current) (.getVal current) 1009 | left 1010 | (.getRight current) 1011 | 2 1012 | left-count) 1013 | 1014 | :else 1015 | (let [new-child (step (.getLeft current) (dec lvl)) 1016 | current-r (.getRight current)] 1017 | (maybe-rebalance 1018 | (AVLNode. nil 1019 | (.getKey current) (.getVal current) 1020 | new-child 1021 | current-r 1022 | (inc (max (.getHeight ^IAVLNode new-child) 1023 | (height current-r))) 1024 | (+ left-count (.getRank current)))))))] 1025 | (step right (- rh lh))) 1026 | 1027 | :else 1028 | (letfn [(step [^IAVLNode current ^long cnt ^long lvl] 1029 | (cond 1030 | (zero? lvl) 1031 | (join comp cnt current right) 1032 | 1033 | (nil? (.getRight current)) 1034 | (AVLNode. nil 1035 | (.getKey current) (.getVal current) 1036 | (.getLeft current) 1037 | right 1038 | 2 1039 | (.getRank current)) 1040 | 1041 | :else 1042 | (let [new-child (step (.getRight current) 1043 | (dec (- cnt (.getRank current))) 1044 | (dec lvl)) 1045 | current-l (.getLeft current)] 1046 | (maybe-rebalance 1047 | (AVLNode. nil 1048 | (.getKey current) (.getVal current) 1049 | current-l 1050 | new-child 1051 | (inc (max (.getHeight ^IAVLNode new-child) 1052 | (height current-l))) 1053 | (.getRank current))))))] 1054 | (step left left-count (- lh rh))))))) 1055 | 1056 | (defn ^:private split [^Comparator comp ^IAVLNode node k] 1057 | (letfn [(step [^IAVLNode node] 1058 | (if (nil? node) 1059 | [nil nil nil] 1060 | (let [c (.compare comp k (.getKey node))] 1061 | (cond 1062 | (zero? c) 1063 | [(.getLeft node) 1064 | (MapEntry. (.getKey node) (.getVal node)) 1065 | (.getRight node)] 1066 | 1067 | (neg? c) 1068 | (let [[l e r] (step (.getLeft node)) 1069 | r' (insert comp 1070 | (.getRight node) 1071 | (.getKey node) 1072 | (.getVal node) 1073 | (Box. false))] 1074 | [l 1075 | e 1076 | (cond 1077 | e (join comp 1078 | (- (.getRank node) 1079 | (inc (rank comp 1080 | (.getLeft node) 1081 | (.key ^MapEntry e)))) 1082 | r 1083 | r') 1084 | 1085 | r (join comp 1086 | (- (.getRank node) 1087 | (rank comp 1088 | (.getLeft node) 1089 | (.getKey (get-leftmost r)))) 1090 | r 1091 | r') 1092 | 1093 | :else r')]) 1094 | 1095 | :else 1096 | (let [[l e r] (step (.getRight node)) 1097 | l' (insert comp 1098 | (.getLeft node) 1099 | (.getKey node) 1100 | (.getVal node) 1101 | (Box. false))] 1102 | [(join comp 1103 | (unchecked-inc-int (.getRank node)) 1104 | l' 1105 | l) 1106 | e 1107 | r])))))] 1108 | (step node))) 1109 | 1110 | (defn ^:private range ^IAVLNode [^Comparator comp ^IAVLNode node low high] 1111 | (let [[_ ^MapEntry low-e r] (split comp node low) 1112 | [l ^MapEntry high-e _] (split comp r high)] 1113 | (cond-> l 1114 | low-e (as-> node 1115 | (insert comp node 1116 | (.key low-e) (.val low-e) 1117 | (Box. false))) 1118 | high-e (as-> node 1119 | (insert comp node 1120 | (.key high-e) (.val high-e) 1121 | (Box. false)))))) 1122 | 1123 | (defn ^:private seq-push [^IAVLNode node stack ascending?] 1124 | (loop [node node stack stack] 1125 | (if (nil? node) 1126 | stack 1127 | (recur (if ascending? (.getLeft node) (.getRight node)) 1128 | (conj stack node))))) 1129 | 1130 | (defn ^:private avl-map-kv-reduce [^IAVLNode node f init] 1131 | (let [init (if (nil? (.getLeft node)) 1132 | init 1133 | (avl-map-kv-reduce (.getLeft node) f init))] 1134 | (if (reduced? init) 1135 | init 1136 | (let [init (f init (.getKey node) (.getVal node))] 1137 | (if (reduced? init) 1138 | init 1139 | (if (nil? (.getRight node)) 1140 | init 1141 | (recur (.getRight node) f init))))))) 1142 | 1143 | (defn ^:private avl-map-reduce [^IAVLNode node f init] 1144 | (let [init (if (nil? (.getLeft node)) 1145 | init 1146 | (avl-map-reduce (.getLeft node) f init))] 1147 | (if (reduced? init) 1148 | init 1149 | (let [init (f init (MapEntry. (.getKey node) (.getVal node)))] 1150 | (if (reduced? init) 1151 | init 1152 | (if (nil? (.getRight node)) 1153 | init 1154 | (recur (.getRight node) f init))))))) 1155 | 1156 | (defn ^:private avl-map-reduce-skip [^IAVLNode node f init skip-node] 1157 | (let [init (if (nil? (.getLeft node)) 1158 | init 1159 | (avl-map-reduce-skip (.getLeft node) f init skip-node))] 1160 | (if (reduced? init) 1161 | init 1162 | (if (identical? skip-node node) 1163 | (if (nil? (.getRight node)) 1164 | init 1165 | (avl-map-reduce (.getRight node) f init)) 1166 | (let [init (f init (MapEntry. (.getKey node) (.getVal node)))] 1167 | (if (reduced? init) 1168 | init 1169 | (if (nil? (.getRight node)) 1170 | init 1171 | (recur (.getRight node) f init skip-node)))))))) 1172 | 1173 | (defn ^:private avl-set-reduce [^IAVLNode node f init] 1174 | (let [init (if (nil? (.getLeft node)) 1175 | init 1176 | (avl-set-reduce (.getLeft node) f init))] 1177 | (if (reduced? init) 1178 | init 1179 | (let [init (f init (.getKey node))] 1180 | (if (reduced? init) 1181 | init 1182 | (if (nil? (.getRight node)) 1183 | init 1184 | (recur (.getRight node) f init))))))) 1185 | 1186 | (defn ^:private avl-set-reduce-skip [^IAVLNode node f init skip-node] 1187 | (let [init (if (nil? (.getLeft node)) 1188 | init 1189 | (avl-set-reduce-skip (.getLeft node) f init skip-node))] 1190 | (if (reduced? init) 1191 | init 1192 | (if (identical? skip-node node) 1193 | (if (nil? (.getRight node)) 1194 | init 1195 | (avl-set-reduce (.getRight node) f init)) 1196 | (let [init (f init (.getKey node))] 1197 | (if (reduced? init) 1198 | init 1199 | (if (nil? (.getRight node)) 1200 | init 1201 | (avl-set-reduce (.getRight node) f init)))))))) 1202 | 1203 | (deftype AVLMapSeq [^IPersistentMap _meta 1204 | ^IPersistentStack stack 1205 | ^boolean ascending? 1206 | ^int cnt 1207 | ^:unsynchronized-mutable ^int _hash 1208 | ^:unsynchronized-mutable ^int _hasheq] 1209 | :no-print true 1210 | 1211 | Object 1212 | (toString [this] 1213 | (RT/printString this)) 1214 | 1215 | (hashCode [this] 1216 | (caching-hash this hash-seq _hash)) 1217 | 1218 | clojure.lang.IHashEq 1219 | (hasheq [this] 1220 | (caching-hash this hasheq-seq _hasheq)) 1221 | 1222 | clojure.lang.Seqable 1223 | (seq [this] 1224 | this) 1225 | 1226 | clojure.lang.Sequential 1227 | clojure.lang.ISeq 1228 | (first [this] 1229 | (peek stack)) 1230 | 1231 | (more [this] 1232 | (let [node ^IAVLNode (first stack) 1233 | next-stack (seq-push (if ascending? (.getRight node) (.getLeft node)) 1234 | (next stack) 1235 | ascending?)] 1236 | (if (nil? next-stack) 1237 | () 1238 | (AVLMapSeq. nil next-stack ascending? (unchecked-dec-int cnt) -1 -1)))) 1239 | 1240 | (next [this] 1241 | (.seq (.more this))) 1242 | 1243 | clojure.lang.Counted 1244 | (count [this] 1245 | (if (neg? cnt) 1246 | (unchecked-inc-int (count (next this))) 1247 | cnt)) 1248 | 1249 | clojure.lang.IPersistentCollection 1250 | (cons [this x] 1251 | (cons x this)) 1252 | 1253 | (equiv [this that] 1254 | (equiv-sequential this that)) 1255 | 1256 | (empty [this] 1257 | (with-meta () _meta)) 1258 | 1259 | clojure.lang.IMeta 1260 | (meta [this] 1261 | _meta) 1262 | 1263 | clojure.lang.IObj 1264 | (withMeta [this meta] 1265 | (AVLMapSeq. meta stack ascending? cnt _hash _hasheq)) 1266 | 1267 | java.io.Serializable 1268 | 1269 | java.util.List 1270 | (toArray [this] 1271 | (RT/seqToArray (seq this))) 1272 | 1273 | (^objects toArray [this ^objects arr] 1274 | (RT/seqToPassedArray (seq this) arr)) 1275 | 1276 | (containsAll [this c] 1277 | (every? #(.contains this %) (iterator-seq (.iterator c)))) 1278 | 1279 | (size [this] 1280 | (count this)) 1281 | 1282 | (isEmpty [this] 1283 | (zero? cnt)) 1284 | 1285 | (contains [this x] 1286 | (or (some #(Util/equiv % x) this) false)) 1287 | 1288 | (iterator [this] 1289 | (SeqIterator. this)) 1290 | 1291 | (subList [this from to] 1292 | (.subList (Collections/unmodifiableList (ArrayList. this)) from to)) 1293 | 1294 | (indexOf [this x] 1295 | (loop [i (int 0) s (seq this)] 1296 | (if s 1297 | (if (Util/equiv (first s) x) 1298 | i 1299 | (recur (unchecked-inc-int i) (next s))) 1300 | (int -1)))) 1301 | 1302 | (lastIndexOf [this x] 1303 | (.lastIndexOf (ArrayList. this) x)) 1304 | 1305 | (listIterator [this] 1306 | (.listIterator (Collections/unmodifiableList (ArrayList. this)))) 1307 | 1308 | (listIterator [this i] 1309 | (.listIterator (Collections/unmodifiableList (ArrayList. this)) i)) 1310 | 1311 | (get [this i] 1312 | (RT/nth this i)) 1313 | 1314 | (add [this x] (throw-unsupported)) 1315 | (^boolean remove [this x] (throw-unsupported)) 1316 | (addAll [this c] (throw-unsupported)) 1317 | (clear [this] (throw-unsupported)) 1318 | (retainAll [this c] (throw-unsupported)) 1319 | (removeAll [this c] (throw-unsupported)) 1320 | (set [this i e] (throw-unsupported)) 1321 | (remove [this ^int i] (throw-unsupported)) 1322 | (add [this i e] (throw-unsupported))) 1323 | 1324 | (defn ^:private create-seq [node ascending? cnt] 1325 | (AVLMapSeq. nil (seq-push node nil ascending?) ascending? cnt -1 -1)) 1326 | 1327 | (declare ->AVLTransientMap) 1328 | 1329 | (deftype AVLMap [^Comparator comp 1330 | ^IAVLNode tree 1331 | ^int cnt 1332 | ^IPersistentMap _meta 1333 | ^:unsynchronized-mutable ^int _hash 1334 | ^:unsynchronized-mutable ^int _hasheq] 1335 | Object 1336 | (toString [this] 1337 | (RT/printString this)) 1338 | 1339 | (hashCode [this] 1340 | (caching-hash this hash-imap _hash)) 1341 | 1342 | (equals [this that] 1343 | (APersistentMap/mapEquals this that)) 1344 | 1345 | IAVLTree 1346 | (getTree [this] 1347 | tree) 1348 | 1349 | INavigableTree 1350 | (nearest [this test k] 1351 | (if-let [node (lookup-nearest comp tree test k)] 1352 | (MapEntry. (.getKey node) (.getVal node)))) 1353 | 1354 | clojure.lang.IHashEq 1355 | (hasheq [this] 1356 | (caching-hash this hasheq-imap _hasheq)) 1357 | 1358 | clojure.lang.IMeta 1359 | (meta [this] 1360 | _meta) 1361 | 1362 | clojure.lang.IObj 1363 | (withMeta [this meta] 1364 | (AVLMap. comp tree cnt meta _hash _hasheq)) 1365 | 1366 | clojure.lang.Counted 1367 | (count [this] 1368 | cnt) 1369 | 1370 | clojure.lang.Indexed 1371 | (nth [this i] 1372 | (if-let [n (select tree i)] 1373 | (MapEntry. (.getKey ^IAVLNode n) (.getVal ^IAVLNode n)) 1374 | (throw 1375 | (IndexOutOfBoundsException. "nth index out of bounds in AVL tree")))) 1376 | 1377 | (nth [this i not-found] 1378 | (if-let [n (select tree i)] 1379 | (MapEntry. (.getKey ^IAVLNode n) (.getVal ^IAVLNode n)) 1380 | not-found)) 1381 | 1382 | clojure.lang.IPersistentCollection 1383 | (cons [this entry] 1384 | (if (vector? entry) 1385 | (assoc this (nth entry 0) (nth entry 1)) 1386 | (reduce conj this entry))) 1387 | 1388 | (empty [this] 1389 | (AVLMap. comp nil 0 _meta empty-map-hashcode empty-map-hasheq)) 1390 | 1391 | (equiv [this that] 1392 | (equiv-map this that)) 1393 | 1394 | clojure.lang.IFn 1395 | (invoke [this k] 1396 | (.valAt this k)) 1397 | 1398 | (invoke [this k not-found] 1399 | (.valAt this k not-found)) 1400 | 1401 | (applyTo [this args] 1402 | (let [n (RT/boundedLength args 2)] 1403 | (case n 1404 | 0 (throw (clojure.lang.ArityException. 1405 | n (.. this (getClass) (getSimpleName)))) 1406 | 1 (.invoke this (first args)) 1407 | 2 (.invoke this (first args) (second args)) 1408 | 3 (throw (clojure.lang.ArityException. 1409 | n (.. this (getClass) (getSimpleName))))))) 1410 | 1411 | clojure.lang.Seqable 1412 | (seq [this] 1413 | (if (pos? cnt) 1414 | (create-seq tree true cnt))) 1415 | 1416 | clojure.lang.Reversible 1417 | (rseq [this] 1418 | (if (pos? cnt) 1419 | (create-seq tree false cnt))) 1420 | 1421 | clojure.lang.ILookup 1422 | (valAt [this k] 1423 | (.valAt this k nil)) 1424 | 1425 | (valAt [this k not-found] 1426 | (let [n ^IAVLNode (lookup comp tree k)] 1427 | (if-not (nil? n) 1428 | (.getVal n) 1429 | not-found))) 1430 | 1431 | clojure.lang.Associative 1432 | (assoc [this k v] 1433 | (let [found? (Box. false) 1434 | new-tree (insert comp tree k v found?)] 1435 | (AVLMap. comp 1436 | new-tree 1437 | (if (.-val found?) cnt (unchecked-inc-int cnt)) 1438 | _meta -1 -1))) 1439 | 1440 | (containsKey [this k] 1441 | (not (nil? (.entryAt this k)))) 1442 | 1443 | (entryAt [this k] 1444 | (if-let [node (lookup comp tree k)] 1445 | (MapEntry. (.getKey node) (.getVal node)))) 1446 | 1447 | clojure.lang.MapEquivalence 1448 | clojure.lang.IPersistentMap 1449 | (without [this k] 1450 | (let [found? (Box. false) 1451 | new-tree (delete comp tree k found?)] 1452 | (if (.-val found?) 1453 | (AVLMap. comp 1454 | new-tree 1455 | (unchecked-dec-int cnt) 1456 | _meta -1 -1) 1457 | this))) 1458 | 1459 | (assocEx [this k v] 1460 | (let [found? (Box. false) 1461 | new-tree (insert comp tree k v found?)] 1462 | (if (.-val found?) 1463 | (throw (ex-info "key already present" {})) 1464 | (AVLMap. comp 1465 | new-tree 1466 | (unchecked-inc-int cnt) 1467 | _meta -1 -1)))) 1468 | 1469 | clojure.lang.Sorted 1470 | (seq [this ascending?] 1471 | (if (pos? cnt) 1472 | (create-seq tree ascending? cnt))) 1473 | 1474 | (seqFrom [this k ascending?] 1475 | (if (pos? cnt) 1476 | (loop [stack nil t tree] 1477 | (if-not (nil? t) 1478 | (let [c (.compare comp k (.getKey t))] 1479 | (cond 1480 | (zero? c) (AVLMapSeq. nil (conj stack t) ascending? -1 -1 -1) 1481 | ascending? (if (neg? c) 1482 | (recur (conj stack t) (.getLeft t)) 1483 | (recur stack (.getRight t))) 1484 | :else (if (pos? c) 1485 | (recur (conj stack t) (.getRight t)) 1486 | (recur stack (.getLeft t))))) 1487 | (if-not (nil? stack) 1488 | (AVLMapSeq. nil stack ascending? -1 -1 -1)))))) 1489 | 1490 | (entryKey [this entry] 1491 | (key entry)) 1492 | 1493 | (comparator [this] 1494 | comp) 1495 | 1496 | clojure.lang.IEditableCollection 1497 | (asTransient [this] 1498 | (->AVLTransientMap 1499 | (AtomicReference. (Thread/currentThread)) comp tree cnt)) 1500 | 1501 | clojure.core.protocols/IKVReduce 1502 | (kv-reduce [this f init] 1503 | (if (nil? tree) 1504 | init 1505 | (let [init (avl-map-kv-reduce tree f init)] 1506 | (if (reduced? init) 1507 | @init 1508 | init)))) 1509 | 1510 | clojure.lang.IReduce 1511 | (reduce [this f] 1512 | (case cnt 1513 | 0 (f) 1514 | 1 (MapEntry. (.getKey tree) (.getVal tree)) 1515 | (let [^IAVLNode n0 (select tree 0) 1516 | init (avl-map-reduce-skip tree f (MapEntry. (.getKey n0) (.getVal n0)) n0)] 1517 | (if (reduced? init) 1518 | @init 1519 | init)))) 1520 | 1521 | (reduce [this f init] 1522 | (if (nil? tree) 1523 | init 1524 | (let [init (avl-map-reduce tree f init)] 1525 | (if (reduced? init) 1526 | @init 1527 | init)))) 1528 | 1529 | java.io.Serializable 1530 | 1531 | Iterable 1532 | (iterator [this] 1533 | (SeqIterator. (seq this))) 1534 | 1535 | java.util.Map 1536 | (get [this k] 1537 | (.valAt this k)) 1538 | 1539 | (clear [this] 1540 | (throw-unsupported)) 1541 | 1542 | (containsValue [this v] 1543 | (.. this values (contains v))) 1544 | 1545 | (entrySet [this] 1546 | (set (seq this))) 1547 | 1548 | (put [this k v] 1549 | (throw-unsupported)) 1550 | 1551 | (putAll [this m] 1552 | (throw-unsupported)) 1553 | 1554 | (remove [this k] 1555 | (throw-unsupported)) 1556 | 1557 | (size [this] 1558 | cnt) 1559 | 1560 | (values [this] 1561 | (vals this))) 1562 | 1563 | (deftype AVLTransientMap [^AtomicReference edit 1564 | ^Comparator comp 1565 | ^:unsynchronized-mutable ^IAVLNode tree 1566 | ^:unsynchronized-mutable ^int cnt] 1567 | clojure.lang.Counted 1568 | (count [this] 1569 | cnt) 1570 | 1571 | clojure.lang.ILookup 1572 | (valAt [this k] 1573 | (.valAt this k nil)) 1574 | 1575 | (valAt [this k not-found] 1576 | (let [n ^IAVLNode (lookup comp tree k)] 1577 | (if-not (nil? n) 1578 | (.getVal n) 1579 | not-found))) 1580 | 1581 | clojure.lang.IFn 1582 | (invoke [this k] 1583 | (.valAt this k)) 1584 | 1585 | (invoke [this k not-found] 1586 | (.valAt this k not-found)) 1587 | 1588 | (applyTo [this args] 1589 | (let [n (RT/boundedLength args 2)] 1590 | (case n 1591 | 0 (throw (clojure.lang.ArityException. 1592 | n (.. this (getClass) (getSimpleName)))) 1593 | 1 (.invoke this (first args)) 1594 | 2 (.invoke this (first args) (second args)) 1595 | 3 (throw (clojure.lang.ArityException. 1596 | n (.. this (getClass) (getSimpleName))))))) 1597 | 1598 | clojure.lang.ITransientCollection 1599 | (conj [this entry] 1600 | (ensure-editable edit) 1601 | (if (vector? entry) 1602 | (assoc! this (nth entry 0) (nth entry 1)) 1603 | (reduce conj! this entry))) 1604 | 1605 | (persistent [this] 1606 | (ensure-editable edit) 1607 | (.set edit nil) 1608 | (AVLMap. comp tree cnt nil -1 -1)) 1609 | 1610 | clojure.lang.ITransientAssociative 1611 | (assoc [this k v] 1612 | (ensure-editable edit) 1613 | (let [found? (Box. false) 1614 | new-tree (insert! edit comp tree k v found?)] 1615 | (set! tree new-tree) 1616 | (if-not (.-val found?) 1617 | (set! cnt (unchecked-inc-int cnt))) 1618 | this)) 1619 | 1620 | ITransientAssociative2Impl 1621 | (containsKey [this k] 1622 | (not (nil? (.entryAt this k)))) 1623 | 1624 | (entryAt [this k] 1625 | (if-let [node (lookup comp tree k)] 1626 | (MapEntry. (.getKey node) (.getVal node)))) 1627 | 1628 | clojure.lang.ITransientMap 1629 | (without [this k] 1630 | (ensure-editable edit) 1631 | (let [found? (Box. false) 1632 | new-tree (delete! edit comp tree k found?)] 1633 | (when (.-val found?) 1634 | (set! tree new-tree) 1635 | (set! cnt (unchecked-dec-int cnt))) 1636 | this))) 1637 | 1638 | (declare ->AVLTransientSet) 1639 | 1640 | (deftype AVLSet [^IPersistentMap _meta 1641 | ^AVLMap avl-map 1642 | ^:unsynchronized-mutable ^int _hash 1643 | ^:unsynchronized-mutable ^int _hasheq] 1644 | Object 1645 | (toString [this] 1646 | (RT/printString this)) 1647 | 1648 | (hashCode [this] 1649 | (caching-hash this hash-iset _hash)) 1650 | 1651 | (equals [this that] 1652 | (APersistentSet/setEquals this that)) 1653 | 1654 | IAVLTree 1655 | (getTree [this] 1656 | (.getTree avl-map)) 1657 | 1658 | INavigableTree 1659 | (nearest [this test k] 1660 | (if-let [node (lookup-nearest (.comparator avl-map) 1661 | (.getTree avl-map) 1662 | test 1663 | k)] 1664 | (.getKey node))) 1665 | 1666 | clojure.lang.IHashEq 1667 | (hasheq [this] 1668 | (caching-hash this hasheq-iset _hasheq)) 1669 | 1670 | clojure.lang.IMeta 1671 | (meta [this] 1672 | _meta) 1673 | 1674 | clojure.lang.IObj 1675 | (withMeta [this meta] 1676 | (AVLSet. meta avl-map _hash _hasheq)) 1677 | 1678 | clojure.lang.Counted 1679 | (count [this] 1680 | (count avl-map)) 1681 | 1682 | clojure.lang.Indexed 1683 | (nth [this i] 1684 | (if-let [n (select (.-tree avl-map) i)] 1685 | (.getVal ^IAVLNode n) 1686 | (throw 1687 | (IndexOutOfBoundsException. "nth index out of bounds in AVL tree")))) 1688 | 1689 | (nth [this i not-found] 1690 | (if-let [n (select (.-tree avl-map) i)] 1691 | (.getVal ^IAVLNode n) 1692 | not-found)) 1693 | 1694 | clojure.lang.IPersistentCollection 1695 | (cons [this x] 1696 | (AVLSet. _meta (assoc avl-map x x) -1 -1)) 1697 | 1698 | (empty [this] 1699 | (AVLSet. _meta (empty avl-map) empty-set-hashcode empty-set-hasheq)) 1700 | 1701 | (equiv [this that] 1702 | (and 1703 | (set? that) 1704 | (== (count this) (count that)) 1705 | (every? #(contains? this %) that))) 1706 | 1707 | clojure.lang.Seqable 1708 | (seq [this] 1709 | (keys avl-map)) 1710 | 1711 | clojure.lang.Sorted 1712 | (seq [this ascending?] 1713 | (RT/keys (.seq avl-map ascending?))) 1714 | 1715 | (seqFrom [this k ascending?] 1716 | (RT/keys (.seqFrom avl-map k ascending?))) 1717 | 1718 | (entryKey [this entry] 1719 | entry) 1720 | 1721 | (comparator [this] 1722 | (.comparator avl-map)) 1723 | 1724 | clojure.lang.Reversible 1725 | (rseq [this] 1726 | (map key (rseq avl-map))) 1727 | 1728 | clojure.lang.ILookup 1729 | (valAt [this v] 1730 | (.valAt this v nil)) 1731 | 1732 | (valAt [this v not-found] 1733 | (let [n (.entryAt avl-map v)] 1734 | (if-not (nil? n) 1735 | (.getKey n) 1736 | not-found))) 1737 | 1738 | clojure.lang.IPersistentSet 1739 | (disjoin [this v] 1740 | (AVLSet. _meta (dissoc avl-map v) -1 -1)) 1741 | 1742 | (contains [this k] 1743 | (contains? avl-map k)) 1744 | 1745 | (get [this k] 1746 | (.valAt this k nil)) 1747 | 1748 | clojure.lang.IReduce 1749 | (reduce [this f] 1750 | (case (count avl-map) 1751 | 0 (f) 1752 | 1 (.getKey (.getTree avl-map)) 1753 | (let [tree (.getTree avl-map) 1754 | ^IAVLNode n0 (select tree 0) 1755 | init (avl-set-reduce-skip tree f (.getKey n0) n0)] 1756 | (if (reduced? init) 1757 | @init 1758 | init)))) 1759 | 1760 | (reduce [this f init] 1761 | (let [tree (.getTree avl-map)] 1762 | (if (nil? tree) 1763 | init 1764 | (let [init (avl-set-reduce tree f init)] 1765 | (if (reduced? init) 1766 | @init 1767 | init))))) 1768 | 1769 | clojure.lang.IFn 1770 | (invoke [this k] 1771 | (.valAt this k)) 1772 | 1773 | (applyTo [this args] 1774 | (let [n (RT/boundedLength args 1)] 1775 | (case n 1776 | 0 (throw (clojure.lang.ArityException. 1777 | n (.. this (getClass) (getSimpleName)))) 1778 | 1 (.invoke this (first args)) 1779 | 2 (throw (clojure.lang.ArityException. 1780 | n (.. this (getClass) (getSimpleName))))))) 1781 | 1782 | clojure.lang.IEditableCollection 1783 | (asTransient [this] 1784 | (->AVLTransientSet (.asTransient avl-map))) 1785 | 1786 | java.io.Serializable 1787 | 1788 | java.util.Set 1789 | (add [this o] (throw-unsupported)) 1790 | (remove [this o] (throw-unsupported)) 1791 | (addAll [this c] (throw-unsupported)) 1792 | (clear [this] (throw-unsupported)) 1793 | (retainAll [this c] (throw-unsupported)) 1794 | (removeAll [this c] (throw-unsupported)) 1795 | 1796 | (containsAll [this c] 1797 | (every? #(.contains this %) (iterator-seq (.iterator c)))) 1798 | 1799 | (size [this] 1800 | (count this)) 1801 | 1802 | (isEmpty [this] 1803 | (zero? (count this))) 1804 | 1805 | (iterator [this] 1806 | (SeqIterator. (seq this))) 1807 | 1808 | (toArray [this] 1809 | (RT/seqToArray (seq this))) 1810 | 1811 | (^objects toArray [this ^objects a] 1812 | (RT/seqToPassedArray (seq this) a))) 1813 | 1814 | (deftype AVLTransientSet 1815 | [^:unsynchronized-mutable ^AVLTransientMap transient-avl-map] 1816 | clojure.lang.ITransientCollection 1817 | (conj [this k] 1818 | (set! transient-avl-map (.assoc transient-avl-map k k)) 1819 | this) 1820 | 1821 | (persistent [this] 1822 | (AVLSet. nil (.persistent transient-avl-map) -1 -1)) 1823 | 1824 | clojure.lang.ITransientSet 1825 | (disjoin [this k] 1826 | (set! transient-avl-map (.without transient-avl-map k)) 1827 | this) 1828 | 1829 | (contains [this k] 1830 | (not (identical? this (.valAt transient-avl-map k this)))) 1831 | 1832 | (get [this k] 1833 | (.valAt transient-avl-map k)) 1834 | 1835 | clojure.lang.IFn 1836 | (invoke [this k] 1837 | (.valAt transient-avl-map k)) 1838 | 1839 | (invoke [this k not-found] 1840 | (.valAt transient-avl-map k not-found)) 1841 | 1842 | (applyTo [this args] 1843 | (let [n (RT/boundedLength args 2)] 1844 | (case n 1845 | 0 (throw (clojure.lang.ArityException. 1846 | n (.. this (getClass) (getSimpleName)))) 1847 | 1 (.invoke this (first args)) 1848 | 2 (.invoke this (first args) (second args)) 1849 | 3 (throw (clojure.lang.ArityException. 1850 | n (.. this (getClass) (getSimpleName))))))) 1851 | 1852 | clojure.lang.Counted 1853 | (count [this] 1854 | (.count transient-avl-map))) 1855 | 1856 | (def ^:private empty-map 1857 | (AVLMap. RT/DEFAULT_COMPARATOR nil 0 nil 1858 | empty-map-hashcode empty-map-hasheq)) 1859 | 1860 | (def ^:private empty-set 1861 | (AVLSet. nil empty-map empty-set-hashcode empty-set-hasheq)) 1862 | 1863 | (defmethod print-dup AVLMap [m ^java.io.Writer w] 1864 | (if-let [[[k v] & more] (seq m)] 1865 | (do 1866 | (.write w "#=(clojure.data.avl/sorted-map ") 1867 | (print-dup k w) 1868 | (.write w " ") 1869 | (print-dup v w) 1870 | (doseq [[k v] more] 1871 | (.write w ", ") 1872 | (print-dup k w) 1873 | (.write w " ") 1874 | (print-dup v w)) 1875 | (.write w ")")) 1876 | (.write w "#=(clojure.data.avl/sorted-map)"))) 1877 | 1878 | (defmethod print-dup AVLSet [s ^java.io.Writer w] 1879 | (if-let [[x & xs] (seq s)] 1880 | (do 1881 | (.write w "#=(clojure.data.avl/sorted-set ") 1882 | (print-dup x w) 1883 | (doseq [x xs] 1884 | (.write w " ") 1885 | (print-dup x w)) 1886 | (.write w ")")) 1887 | (.write w "#=(clojure.data.avl/sorted-set)"))) 1888 | 1889 | (doseq [v [#'->AVLMapSeq 1890 | #'->AVLNode 1891 | #'->AVLMap 1892 | #'->AVLSet 1893 | #'->AVLTransientMap 1894 | #'->AVLTransientSet]] 1895 | (alter-meta! v assoc :private true)) 1896 | 1897 | (defn sorted-map 1898 | "keyval => key val 1899 | Returns a new AVL map with supplied mappings." 1900 | {:added "0.0.1"} 1901 | [& keyvals] 1902 | (loop [in (seq keyvals) out (transient empty-map)] 1903 | (if in 1904 | (if-let [nin (next in)] 1905 | (recur (next nin) (assoc! out (first in) (first nin))) 1906 | (throw (IllegalArgumentException. 1907 | (format 1908 | "sorted-map: no value supplied for key: %s" 1909 | (first in))))) 1910 | (persistent! out)))) 1911 | 1912 | (defn sorted-map-by 1913 | "keyval => key val 1914 | Returns a new sorted map with supplied mappings, using the supplied 1915 | comparator." 1916 | {:added "0.0.1"} 1917 | [^Comparator comparator & keyvals] 1918 | (loop [in (seq keyvals) 1919 | out (AVLTransientMap. 1920 | (AtomicReference. (Thread/currentThread)) comparator nil 0)] 1921 | (if in 1922 | (if-let [nin (next in)] 1923 | (recur (next nin) (assoc! out (first in) (first nin))) 1924 | (throw (IllegalArgumentException. 1925 | (format 1926 | "sorted-map-by: no value supplied for key: %s" 1927 | (first in))))) 1928 | (persistent! out)))) 1929 | 1930 | (defn sorted-set 1931 | "Returns a new sorted set with supplied keys." 1932 | {:added "0.0.1"} 1933 | [& keys] 1934 | (persistent! (reduce conj! (transient empty-set) keys))) 1935 | 1936 | (defn sorted-set-by 1937 | "Returns a new sorted set with supplied keys, using the supplied comparator." 1938 | {:added "0.0.1"} 1939 | [^Comparator comparator & keys] 1940 | (persistent! 1941 | (reduce conj! 1942 | (AVLTransientSet. (transient (sorted-map-by comparator))) 1943 | keys))) 1944 | 1945 | (defn rank-of 1946 | "Returns the rank of x in coll or -1 if not present." 1947 | {:added "0.0.6"} 1948 | ^long [coll x] 1949 | (rank (.comparator ^clojure.lang.Sorted coll) (.getTree ^IAVLTree coll) x)) 1950 | 1951 | (defn nearest 1952 | "(alpha) 1953 | 1954 | Equivalent to, but more efficient than, (first (subseq* coll test x)), 1955 | where subseq* is clojure.core/subseq for test in #{>, >=} and 1956 | clojure.core/rsubseq for test in #{<, <=}." 1957 | {:added "0.0.12"} 1958 | [coll test x] 1959 | (.nearest ^INavigableTree coll test x)) 1960 | 1961 | (defn split-key 1962 | "(alpha) 1963 | 1964 | Returns [left e? right], where left and right are collections of 1965 | the same type as coll and containing, respectively, the keys below 1966 | and above k in the ordering determined by coll's comparator, while 1967 | e? is the entry at key k for maps, the stored copy of the key k for 1968 | sets, nil if coll does not contain k." 1969 | {:added "0.0.12"} 1970 | [k coll] 1971 | (let [comp (.comparator ^clojure.lang.Sorted coll) 1972 | [left e? right] (split comp (.getTree ^IAVLTree coll) k) 1973 | keyfn (if (map? coll) key identity) 1974 | wrap (if (map? coll) 1975 | (fn wrap-map [tree cnt] 1976 | (AVLMap. comp tree cnt nil -1 -1)) 1977 | (fn wrap-set [tree cnt] 1978 | (AVLSet. nil (AVLMap. comp tree cnt nil -1 -1) -1 -1)))] 1979 | [(wrap left 1980 | (if (or e? right) 1981 | (rank-of coll (keyfn (nearest coll >= k))) 1982 | (count coll))) 1983 | (if (and e? (set? coll)) 1984 | (.getKey ^MapEntry e?) 1985 | e?) 1986 | (wrap right 1987 | (if right 1988 | (- (count coll) (rank-of coll (keyfn (nearest coll > k)))) 1989 | 0))])) 1990 | 1991 | (defn split-at 1992 | "(alpha) 1993 | 1994 | Equivalent to, but more efficient than, 1995 | [(into (empty coll) (take n coll)) 1996 | (into (empty coll) (drop n coll))]." 1997 | {:added "0.0.12"} 1998 | [^long n coll] 1999 | (if (>= n (count coll)) 2000 | [coll (empty coll)] 2001 | (let [k (nth coll n) 2002 | k (if (map? coll) (key k) k) 2003 | [l e r] (split-key k coll)] 2004 | [l (conj r e)]))) 2005 | 2006 | (defn subrange 2007 | "(alpha) 2008 | 2009 | Returns an AVL collection comprising the entries of coll between 2010 | start and end (in the sense determined by coll's comparator) in 2011 | logarithmic time. Whether the endpoints are themselves included in 2012 | the returned collection depends on the provided tests; start-test 2013 | must be either > or >=, end-test must be either < or <=. 2014 | 2015 | When passed a single test and limit, subrange infers the other end 2016 | of the range from the test: > / >= mean to include items up to the 2017 | end of coll, < / <= mean to include items taken from the beginning 2018 | of coll. 2019 | 2020 | (subrange coll >= start <= end) is equivalent to, but more efficient 2021 | than, (into (empty coll) (subseq coll >= start <= end))." 2022 | {:added "0.0.12"} 2023 | ([coll test limit] 2024 | (cond 2025 | (zero? (count coll)) 2026 | coll 2027 | 2028 | (#{> >=} test) 2029 | (let [n (select (.getTree ^IAVLTree coll) 2030 | (dec (count coll))) 2031 | k (.getKey ^IAVLNode n)] 2032 | (if (pos? (.compare (.comparator ^clojure.lang.Sorted coll) 2033 | limit k)) 2034 | (empty coll) 2035 | (subrange coll 2036 | test limit 2037 | <= k))) 2038 | 2039 | :else 2040 | (let [n (select (.getTree ^IAVLTree coll) 0) 2041 | k (.getKey ^IAVLNode n)] 2042 | (if (neg? (.compare (.comparator ^clojure.lang.Sorted coll) 2043 | limit k)) 2044 | (empty coll) 2045 | (subrange coll 2046 | >= k 2047 | test limit))))) 2048 | ([coll start-test start end-test end] 2049 | (if (zero? (count coll)) 2050 | coll 2051 | (let [comp (.comparator ^clojure.lang.Sorted coll)] 2052 | (if (pos? (.compare comp start end)) 2053 | (throw 2054 | (IndexOutOfBoundsException. "start greater than end in subrange")) 2055 | (let [input-tree (.getTree ^IAVLTree coll) 2056 | l (lookup-nearest comp input-tree start-test start) 2057 | h (lookup-nearest comp input-tree end-test end)] 2058 | (if (and l h) 2059 | (let [lk (.getKey l) 2060 | hk (.getKey h)] 2061 | (if (neg? (.compare comp hk lk)) 2062 | (empty coll) 2063 | (let [tree (range comp (.getTree ^IAVLTree coll) lk hk) 2064 | cnt (inc (- (rank-of coll hk) 2065 | (rank-of coll lk))) 2066 | m (AVLMap. comp tree cnt nil -1 -1)] 2067 | (if (map? coll) 2068 | m 2069 | (AVLSet. nil m -1 -1))))) 2070 | (empty coll)))))))) 2071 | --------------------------------------------------------------------------------