├── .gitignore ├── deps.edn ├── .github └── workflows │ ├── test.yml │ ├── snapshot.yml │ ├── doc-build.yml │ └── release.yml ├── CONTRIBUTING.md ├── Changes.md ├── pom.xml ├── notes.txt ├── README.md ├── LICENSE └── src ├── test └── clojure │ └── clojure │ └── data │ └── finger_tree │ └── tests.clj └── main └── clojure └── clojure └── data └── finger_tree.clj /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | .cpcache/ 3 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src/main/clojure"]} 2 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: [push] 4 | 5 | jobs: 6 | call-test: 7 | uses: clojure/build.ci/.github/workflows/test.yml@master 8 | -------------------------------------------------------------------------------- /.github/workflows/snapshot.yml: -------------------------------------------------------------------------------- 1 | name: Snapshot on demand 2 | 3 | on: [workflow_dispatch] 4 | 5 | jobs: 6 | call-snapshot: 7 | uses: clojure/build.ci/.github/workflows/snapshot.yml@master 8 | secrets: inherit 9 | -------------------------------------------------------------------------------- /.github/workflows/doc-build.yml: -------------------------------------------------------------------------------- 1 | name: Build API Docs 2 | 3 | on: 4 | workflow_dispatch: 5 | 6 | jobs: 7 | call-doc-build-workflow: 8 | uses: clojure/build.ci/.github/workflows/doc-build.yml@master 9 | with: 10 | project: clojure/data.finger-tree 11 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This is a [Clojure contrib] project. 2 | 3 | Under the Clojure contrib [guidelines], this project cannot accept 4 | pull requests. All patches must be submitted via [JIRA]. 5 | 6 | See [Contributing] on the Clojure website for 7 | more information on how to contribute. 8 | 9 | [Clojure contrib]: https://clojure.org/community/contrib_libs 10 | [Contributing]: https://clojure.org/community/contributing 11 | [JIRA]: https://clojure.atlassian.net/browse/DFINGER 12 | [guidelines]: https://clojure.org/community/contrib_howto 13 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release on demand 2 | 3 | on: 4 | workflow_dispatch: 5 | inputs: 6 | releaseVersion: 7 | description: "Version to release" 8 | required: true 9 | snapshotVersion: 10 | description: "Snapshot version after release" 11 | required: true 12 | 13 | jobs: 14 | call-release: 15 | uses: clojure/build.ci/.github/workflows/release.yml@master 16 | with: 17 | releaseVersion: ${{ github.event.inputs.releaseVersion }} 18 | snapshotVersion: ${{ github.event.inputs.snapshotVersion }} 19 | secrets: inherit -------------------------------------------------------------------------------- /Changes.md: -------------------------------------------------------------------------------- 1 | # Finger Tree change log 2 | 3 | ### Version 0.0.3 4 | 5 | Removed TBD toArray impls to fix reflection error with Java 11. 6 | 7 | ### Version 0.0.2 8 | 9 | Breaking changes: 10 | - Renamed `consl` to `conjl` (same argument order) 11 | - Removed `conjr` -- just use `conj` for appending on the right 12 | 13 | New: 14 | - Implemented equality 15 | - counted-sorted-set can be equal to both sets and sequentials 16 | - Implemented hashCode 17 | - Implemented support for meta and with-meta (IObj) 18 | 19 | ### Version 0.0.1 20 | 21 | This is essentially the version described in the [Clojure Conj talk][1] 22 | 23 | [1]: http://talk-finger-tree.heroku.com/ 24 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | data.finger-tree 4 | 0.1.1-SNAPSHOT 5 | data.finger-tree 6 | Persistent collections based on 2-3 finger trees. 7 | 8 | 9 | 10 | Chouser 11 | chouser@n01se.net 12 | https://chouser.n01se.net 13 | -5 14 | 15 | 16 | 17 | 18 | org.clojure 19 | pom.contrib 20 | 1.3.0 21 | 22 | 23 | 24 | scm:git:git@github.com:clojure/data.finger-tree.git 25 | scm:git:git@github.com:clojure/data.finger-tree.git 26 | git@github.com:clojure/data.finger-tree.git 27 | HEAD 28 | 29 | 30 | 31 | 32 | 33 | sonatype-oss-snapshots 34 | https://oss.sonatype.org/content/repositories/snapshots 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /notes.txt: -------------------------------------------------------------------------------- 1 | Queue: 2 | (time (count (reduce #(-> % (conjr %2) rest) (reduce consl (EmptyTree. nil) (range 1e4)) (range 1e6)))) 3 | 4 | letfn: "Elapsed time: 5043.853495 msecs" 5 | digit macro: "Elapsed time: 3411.159957 msecs" 6 | 32% better 7 | 8 | 9 | Split: 10 | (time (let [n 1e4, t (to-tree {:size [(constantly 1) + 0]} (range n))] (dotimes [i n] (split-tree t #(< i (:size %)))))) 11 | 12 | "Elapsed time: 4408.469664 msecs" 13 | loopless split digit: "Elapsed time: 4102.303245 msecs" 14 | later got this for the same code: "Elapsed time: 3976.687969 msecs" 15 | 16 | 17 | Concat: 18 | (time (let [t (to-tree nil (range 1e5))] (dotimes [_ 3e4] (ft-concat t t)))) 19 | "Elapsed time: 2402.644912 msecs" 20 | nodes without apply: "Elapsed time: 2004.185324 msecs" 21 | 22 | 23 | Using digit for node and always using a delayed measure cache: 24 | queue: 3302.095682 (3% better) 25 | split: 3096.94213 (22% better) 26 | concat: 1680.462405 (16% better) 27 | ...it's also less code. 28 | 29 | Removing the assert in 'deep' helps a bit too: 30 | queue: 2934.046655 31 | split: 3086.496488 32 | concat: 1631.712977 33 | 34 | Delay deep's measure: 35 | queue: 2156.064809 36 | split: 2471.035156 37 | concat: 1510.606604 38 | 39 | Slightly better 'split' only calling measure/reduce on middle tree when needed. 40 | split: 2347.711168 41 | 42 | Reify: 43 | queue: 2151.073871 44 | split: 2351.481345 45 | concat: 1699.367853 46 | 47 | defprotocol: 48 | queue: 6234.505356 49 | split: 3824.236948 50 | concat: 1958.039438 51 | 52 | protocol call site caching: 53 | queue: 5380.091688 54 | split: 3552.108167 55 | concat: 1679.4733 56 | 57 | protocol methods inside deftype: 58 | queue: 6115.087433 59 | split: 2851.264586 60 | concat: 1532.471135 61 | 62 | Note PersistentQueue does queue test in 363.281297 msecs 63 | (defn t [] (count (reduce #(-> % (conj %2) pop) (reduce conj clojure.lang.PersistentQueue/EMPTY (range 1e4)) (range 1e6)))) 64 | 65 | with Clojure 1.2.0: 66 | queue: 2645.928817 67 | split: 2374.810216 68 | concat: 1530.395627 69 | 70 | with record-based meters (+ some performance tweaks): 71 | queue: (time (count (reduce #(-> % (conjr %2) rest) (reduce consl (EmptyTree. nil) (range 1e4)) (range 1e6)))) 72 | split: (time (let [n 1e4, t (to-tree len-meter (range n))] (dotimes [i n] (split-tree t #(< i %))))) 73 | concat: (time (let [t (to-tree nil (range 1e5))] (dotimes [_ 3e4] (ft-concat t t)))) 74 | 75 | queue: 3334.090979 76 | split: 313.484652 77 | concat: 1763.906721 78 | 79 | Len-Meter instead of Integer: 80 | queue: (time (count (reduce #(-> % (conjr %2) rest) (reduce consl (EmptyTree. nil) (range 1e4)) (range 1e6)))) 81 | split: (time (let [n 1e4, t (to-tree len-meter (range n))] (dotimes [i n] (split-tree t #(< i (:len %)))))) 82 | concat: (time (let [t (to-tree nil (range 1e5))] (dotimes [_ 3e4] (ft-concat t t)))) 83 | split: 331.637379 84 | 85 | Test for nil op: 86 | queue: 2346.357413 87 | split: 352.238152 88 | concat 1518.418893 89 | 90 | split with len-string-meter: 40264.907112 91 | 92 | --- sorted set slowness: 93 | (do (def rands (let [r (java.util.Random. 42)] (take 10000 (repeatedly #(.nextInt r))))) nil) 94 | 95 | (defn s1 [] (first (reduce (fn [t i] (insert-where t #(when-let [r (:right %)] (< i r)) i)) (finger-tree right-meter) rands))) 96 | ; 914.896926 97 | 98 | (defn s2 [] (first (reduce conj (sorted-set) rands))) 99 | ; 55.687814 100 | 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Finger Trees 2 | 3 | Finger trees are a versatile family of fully persistent collections. This library includes everything you need to make your own, as well a few ready-to-use collection types: 4 | 5 | - **double-list** is a sequential collection that provides constant-time access to both the left and right ends. 6 | 7 | - **counted-double-list** provides all the features of double-list plus constant-time `count` and log-n `nth`. 8 | 9 | - **counted-sorted-set** is sorted set that also provides log-n `nth` 10 | 11 | There are examples of all these later in the README. 12 | 13 | # Finger Tree Quickstart 14 | 15 | ## [CLI/`deps.edn`](https://clojure.org/reference/deps_and_cli) dependency information: 16 | ```clojure 17 | org.clojure/data.finger-tree {:mvn/version "0.1.0"} 18 | ``` 19 | 20 | ## project.clj 21 | 22 | If you use leiningen or cake, add this to the `:dependencies` in your `project.clj`: 23 | 24 | [org.clojure/data.finger-tree "0.1.0"] 25 | 26 | ## pom.xml 27 | 28 | If you use maven, add this to the `` in your `pom.xml`: 29 | 30 | 31 | org.clojure 32 | data.finger-tree 33 | 0.1.0 34 | 35 | 36 | You'll need git and maven, then execute the following at a shell prompt to fetch finger trees and all its dependencies (including a recent snapshot of Clojure itself) and start a REPL: 37 | 38 | ## use/require 39 | 40 | Regardless of how you fetch the dependency, to use a finger-tree 41 | function in your project you'll need to add something like this to 42 | your `ns` declaration: 43 | 44 | (:use [clojure.data.finger-tree :only [double-list]]) 45 | 46 | # Talk 47 | 48 | Thanks to heroku for hosting the [slides for my Clojure Conj talk][1] about this library. The rather raw sources and enormous PDF of the slides are at [github][2]. 49 | 50 | # Examples 51 | 52 | The finger-tree lib actually includes several collections built on top 53 | of [Ralf Hinze and Ross Paterson's finger trees][3]. Here are some 54 | examples of each of them: 55 | 56 | ## double-list 57 | 58 | The double-list is a sequential collection that provides constant-time 59 | access to both the left and right ends: 60 | 61 | (def dl (double-list 4 5 6 7)) 62 | 63 | dl 64 | ;=> (4 5 6 7) 65 | 66 | [(first dl) (rest dl)] 67 | ;=> [4 (5 6 7)] 68 | 69 | (conjl dl 'x) 70 | ;=> (x 4 5 6 7) 71 | 72 | [(pop dl) (peek dl)] 73 | ;=> [(4 5 6) 7] 74 | 75 | (conj dl 'x) 76 | ;=> (4 5 6 7 x) 77 | 78 | ## counted-double-list 79 | 80 | This provides all the features of double-list plus constant-time 81 | `count` and log-n `nth`: 82 | 83 | (def cdl 84 | (apply counted-double-list '[a b c d e f g h i j k l m])) 85 | 86 | (nth cdl 5) 87 | ;=> f 88 | 89 | (assoc cdl 5 'XX) 90 | ;=> (a b c d e XX g h i j k l m) 91 | 92 | (def parts 93 | (let [[left _ right] (ft-split-at cdl 5)] 94 | {:left left, :right right})) 95 | 96 | parts 97 | ;=> {:left (a b c d e), :right (g h i j k l m)} 98 | 99 | (ft-concat (conj (:left parts) 'XX) (:right parts)) 100 | ;=> (a b c d e XX g h i j k l m) 101 | 102 | (ft-concat (:left parts) (:right parts)) 103 | ;=> (a b c d e g h i j k l m) 104 | ; ^-- missing f 105 | 106 | (ft-concat (into (:left parts) '[X Y Z]) (:right parts)) 107 | ;=> (a b c d e X Y Z g h i j k l m) 108 | 109 | ## counted-sorted-set 110 | 111 | This is like counted-double-list, but does not support `conjl`. Instead, `conj` is used to insert items in sorted order. 112 | 113 | (def css (apply counted-sorted-set 114 | '[m j i e d a f k b c f g h l])) 115 | css 116 | ;=> (a b c d e f g h i j k l m) 117 | 118 | (get css 'e) ; O(log(n)) 119 | ;=> e 120 | 121 | (get css 'ee) ; O(log(n)) 122 | ;=> nil 123 | 124 | (count css) ; O(1) 125 | ;=> 13 126 | 127 | (nth css 5) ; O(log(n)) 128 | ;=> f 129 | 130 | ## Build-your-own finger tree 131 | 132 | (def empty-cost-tree (finger-tree (meter :cost 0 +))) 133 | 134 | (def ct (conj empty-cost-tree 135 | {:id :h, :cost 5} {:id :i, :cost 1} 136 | {:id :j, :cost 2} {:id :k, :cost 3} 137 | {:id :l, :cost 4})) 138 | 139 | (measured ct) 140 | ;=> 15 141 | 142 | (next (split-tree ct #(> % 7))) 143 | ;=> ({:cost 2, :id :j} 144 | ({:cost 3, :id :k} {:cost 4, :id :l})) 145 | 146 | (next (split-tree (rest ct) #(> % 7))) 147 | ;=> ({:cost 4, :id :l} ()) 148 | 149 | [1]: http://talk-finger-tree.heroku.com/ 150 | [2]: http://github.com/Chouser/talk-finger-tree 151 | [3]: http://www.soi.city.ac.uk/~ross/papers/FingerTree.html 152 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | 206 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/finger_tree/tests.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. 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 ^{:doc "Tests for finger tree collections." 10 | :author "Chris Houser"} 11 | clojure.data.finger-tree.tests 12 | (:use [clojure.test :only [deftest is are]] 13 | [clojure.data.finger-tree 14 | :only [finger-tree meter conjl ft-concat ft-split-at split-tree 15 | opfn idElem measure measured to-tree getMeter 16 | double-list counted-double-list counted-sorted-set 17 | counted-sorted-set-by]]) 18 | (:import (clojure.data.finger_tree CountedSortedSet CountedDoubleList))) 19 | 20 | (deftest Conj-Seq-Queue 21 | (let [len 100] 22 | (are [x] (and (= (range len) x) (= x (range len)) (= x x)) 23 | (rseq (reduce conjl (double-list) (range len))) 24 | (seq (reduce conj (double-list) (range len)))))) 25 | 26 | (deftest Conj-Seq-Stack 27 | (let [len 100, r (range (dec len) -1 -1)] 28 | (are [x] (and (= x r) (= r x) (= x x)) 29 | (rseq (reduce conj (double-list) (range len))) 30 | (seq (reduce conjl (double-list) (range len)))))) 31 | 32 | (deftest Conj-Seq-Mixed 33 | (doseq [m (range 2 7)] 34 | (loop [ft (double-list), vc [], i (int 0)] 35 | (when (< i 40) 36 | (is (= ft vc)) 37 | (is (= vc ft)) 38 | (is (= ft ft)) 39 | (if (zero? (rem i m)) 40 | (recur (conjl ft i) (vec (cons i vc)) (inc i)) 41 | (recur (conj ft i) (conj vc i) (inc i))))))) 42 | 43 | (deftest Concat 44 | (doseq [a-len (range 25), b-len (range 25)] 45 | (let [a-s (map #(symbol (str % 'a)) (range a-len)) 46 | b-s (map #(symbol (str % 'b)) (range b-len)) 47 | a (apply double-list a-s) 48 | b (apply double-list b-s) 49 | s (concat a-s b-s) 50 | ft (ft-concat a b)] 51 | (is (= s ft)) 52 | (is (= ft s)) 53 | (is (= ft ft))))) 54 | 55 | (defn test-split-at [expected-vec counted-tree tree-type] 56 | (dotimes [n (count expected-vec)] 57 | (let [[l m r] (ft-split-at counted-tree n)] 58 | (is (instance? tree-type l)) 59 | (is (instance? tree-type r)) 60 | (is (= (nth expected-vec n) m)) 61 | (is (= n (count l))) 62 | (is (= (- (count expected-vec) n 1) (count r))) 63 | (is (= (seq (subvec expected-vec 0 n)) (seq l))) 64 | (is (= (seq (subvec expected-vec (inc n))) (seq r))))) 65 | 66 | (let [[l m r] (ft-split-at counted-tree -1)] 67 | (is (instance? tree-type l)) 68 | (is (instance? tree-type r)) 69 | (is (nil? m)) 70 | (is (zero? (count l))) 71 | (is (= (count expected-vec) (count r))) 72 | (is (empty? l)) 73 | (is (= (seq expected-vec) (seq r))) 74 | (is (= r expected-vec)) 75 | (is (= r r))) 76 | 77 | (let [len (count expected-vec) 78 | [l m r] (ft-split-at counted-tree len)] 79 | (is (instance? tree-type l)) 80 | (is (instance? tree-type r)) 81 | (is (nil? m)) 82 | (is (= len (count l))) 83 | (is (zero? (count r))) 84 | (is (= (seq expected-vec) (seq l))) 85 | (is (= l expected-vec)) 86 | (is (= l l)) 87 | (is (empty? r)))) 88 | 89 | (deftest CDLSplit 90 | (let [basevec (vec (map #(format "x%02d" %) (range 50)))] 91 | (dotimes [len (count basevec)] 92 | (let [lenvec (subvec basevec 0 len)] 93 | (test-split-at lenvec (apply counted-double-list lenvec) 94 | CountedDoubleList))))) 95 | 96 | (deftest CDLAssoc 97 | (doseq [len (range 50), n (range (inc len))] 98 | (let [v (assoc (vec (range len)) n :x) 99 | cdl (assoc (apply counted-double-list (range len)) n :x)] 100 | (is (= v cdl)) 101 | (is (= cdl v)) 102 | (is (= cdl cdl)) 103 | (doseq [i (range len)] 104 | (is (= (nth v i) (nth cdl i))) 105 | (is (= (get v i) (get cdl i)))) 106 | (doseq [i [-1 len]] 107 | (is (= (nth v i :nf) (nth cdl i :nf))) 108 | (is (= (get v i :nf) (get cdl i :nf))))))) 109 | 110 | (deftest CDLAssocCons 111 | (doseq [len (range 50)] 112 | (let [v (vec (cons :x (range len))) 113 | cdl(assoc (apply counted-double-list (range len)) -1 :x)] 114 | (is (= v cdl)) 115 | (is (= cdl v)) 116 | (is (= cdl cdl))))) 117 | 118 | (deftest CDLAssocFail 119 | (doseq [len (range 50), n [-2 (inc len)]] 120 | (is (thrown? Exception 121 | (assoc (apply counted-double-list (range len)) n :x))))) 122 | 123 | ; XXX continue here 124 | (deftest CSSConjDisj 125 | (let [values (vec (concat (range 50) [4.5 10.5 45.5 30.5]))] 126 | (dotimes [len (count values)] 127 | (let [pset (apply sorted-set (take len values)) 128 | base (apply counted-sorted-set (take len values))] ; cons 129 | (is (= len (count base))) ; counted 130 | (dotimes [n len] 131 | (is (= pset (conj base (values n)))) ; exclusive set, next 132 | (is (= (nth (seq pset) n) (nth base n))) ; indexed lookup 133 | (is (= (values n) (get base (values n))))) ; set lookup 134 | (reduce (fn [[pset base] value] ; disj 135 | (is (= pset base)) 136 | (is (= base pset)) 137 | (is (= (count pset) (count base))) 138 | [(disj pset value) (disj base value)]) 139 | [pset base] (take len values)))))) 140 | 141 | (deftest CSSSplitAt 142 | (let [basevec (vec (map #(format "x%02d" %) (range 50)))] 143 | (dotimes [len (count basevec)] 144 | (let [lenvec (subvec basevec 0 len)] 145 | (test-split-at lenvec (apply counted-sorted-set lenvec) 146 | CountedSortedSet))))) 147 | 148 | (deftest CSSPeekPop 149 | (let [basevec (vec (map #(format "x%02d" %) (range 50)))] 150 | (loop [v basevec, t (apply counted-sorted-set basevec)] 151 | (is (= (peek v) (peek t))) 152 | (is (= (seq v) (seq t))) 153 | (when (seq v) 154 | (recur (pop v) (pop t)))))) 155 | 156 | ; for CSS: subseq, rsubseq 157 | 158 | (defrecord Len-Meter [^int len]) 159 | (def measure-len (constantly (Len-Meter. 1))) 160 | (def len-meter (meter measure-len 161 | (Len-Meter. 0) 162 | #(Len-Meter. (+ (:len %1) (:len %2))))) 163 | 164 | (defrecord String-Meter [string]) 165 | (defn ^:static measure-str [node] (String-Meter. (str node))) 166 | (def string-meter (meter measure-str 167 | (String-Meter. "") 168 | #(String-Meter. (str (:string %1) (:string %2))))) 169 | 170 | 171 | (defrecord Len-String-Meter [len string]) 172 | 173 | (def len-string-meter 174 | (let [len-op (opfn len-meter) 175 | string-op (opfn string-meter)] 176 | (meter 177 | (fn [o] 178 | (Len-String-Meter. (:len (measure len-meter o)) 179 | (:string (measure string-meter o)))) 180 | (Len-String-Meter. (:len (idElem len-meter)) 181 | (:string (idElem string-meter))) 182 | (fn [a b] (Len-String-Meter. 183 | (:len (len-op a b)) 184 | (:string (string-op a b))))))) 185 | 186 | (deftest Annotate-One-Direction 187 | (let [measure-fns len-string-meter] 188 | (let [len 100] 189 | (are [x] (= x (Len-String-Meter. len (apply str (range len)))) 190 | (measured (reduce conj (finger-tree measure-fns) (range len)))) 191 | (are [x] (= x (Len-String-Meter. len (apply str (reverse (range len))))) 192 | (measured (reduce conjl (finger-tree measure-fns) (range len))))))) 193 | 194 | (deftest Annotate-Mixed-Conj 195 | (let [measure-fns len-string-meter] 196 | (doseq [m (range 2 7)] 197 | (loop [ft (finger-tree measure-fns), vc [], i (int 0)] 198 | (when (< i 40) 199 | (is (= (measured ft) (Len-String-Meter. (count vc) (apply str vc)))) 200 | (if (zero? (rem i m)) 201 | (recur (conjl ft i) (vec (cons i vc)) (inc i)) 202 | (recur (conj ft i) (conj vc i) (inc i)))))))) 203 | 204 | (deftest Ann-Conj-Seq-Queue 205 | (let [len 100] 206 | (are [x] (= (map identity x) (range len)) 207 | (rseq (reduce conjl (counted-double-list) (range len))) 208 | (seq (reduce conj (counted-double-list) (range len)))))) 209 | 210 | (deftest Counted-Test 211 | (let [xs (map #(str "x" %) (range 1000)) 212 | cdl (apply counted-double-list xs)] 213 | (is (= (concat [nil] xs [nil]) (map #(get cdl %) (range -1 1001)))))) 214 | 215 | (deftest Annotate-Concat 216 | (let [measure-fns len-string-meter] 217 | (doseq [a-len (range 25), b-len (range 25)] 218 | (let [a-s (map #(symbol (str % 'a)) (range a-len)) 219 | b-s (map #(symbol (str % 'b)) (range b-len)) 220 | a (apply finger-tree measure-fns a-s) 221 | b (apply finger-tree measure-fns b-s)] 222 | (is (= (Len-String-Meter. 223 | (+ (count a-s) (count b-s)) 224 | (apply str (concat a-s b-s))) 225 | (measured (ft-concat a b)))))))) 226 | 227 | (deftest Split 228 | (let [make-item (fn [i] (symbol (str i 'a)))] 229 | (doseq [len (range 10) 230 | :let [tree (to-tree len-string-meter (map make-item (range len)))] 231 | split-i (range len)] 232 | (is (= [len split-i (make-item split-i)] 233 | [len split-i (second (split-tree tree #(< split-i (:len %))))]))))) 234 | 235 | (defrecord Right-Meter [right]) 236 | (defn measure-right [x] (Right-Meter. x)) 237 | (def zero-right (Right-Meter. nil)) 238 | (def right-meter 239 | (meter measure-right 240 | zero-right 241 | #(if (:right %2) %2 %1))) 242 | 243 | (defn insert-where [tree pred value] 244 | (if (empty? tree) 245 | (conj tree value) 246 | (let [[l x r] (split-tree tree pred) 247 | [a b] (if (pred (measure (getMeter tree) x)) [value x] [x value])] 248 | (ft-concat (conj l a) (conjl r b))))) 249 | 250 | 251 | (deftest Sorted-Set 252 | (let [r (java.util.Random. 42)] 253 | (reduce (fn [[t s] i] 254 | (let [t2 (insert-where t 255 | #(when-let [r (:right %)] (< i r)) 256 | i) 257 | s (conj s i)] 258 | (is (every? true? (map = s t2))) 259 | [t2 s])) 260 | [(finger-tree right-meter) (sorted-set)] 261 | (take 2 (repeatedly #(.nextInt r)))))) 262 | 263 | (deftest Remove-From-Empty-Trees 264 | (is (= () (pop (double-list)))) 265 | (is (= () (rest (double-list)))) 266 | (is (= () (pop (counted-double-list)))) 267 | (is (= () (rest (counted-double-list)))) 268 | (is (= #{} (pop (counted-sorted-set)))) 269 | (is (= #{} (rest (counted-sorted-set)))) 270 | (is (= #{} (disj (counted-sorted-set) :foo)))) 271 | 272 | (deftest Get-Empty-Trees 273 | (is (nil? (first (double-list)))) 274 | (is (nil? (peek (double-list)))) 275 | (is (nil? (get (double-list) :anything))) 276 | (is (nil? (first (counted-double-list)))) 277 | (is (nil? (peek (counted-double-list)))) 278 | (is (nil? (get (counted-double-list) 0))) 279 | (is (nil? (first (counted-sorted-set)))) 280 | (is (nil? (peek (counted-sorted-set)))) 281 | (is (nil? (get (counted-sorted-set) :foo)))) 282 | 283 | (deftest Get-Not-Found 284 | (is (= :notfound (get (double-list) :anything :notfound))) 285 | (is (= :notfound (get (counted-double-list) 0 :notfound))) 286 | (is (= :notfound (get (counted-sorted-set) :foo :notfound)))) 287 | 288 | (deftest Unequal-Lists 289 | (doseq [[a b] [[[] [1]] [[1] []] [[1] [2]] [[1 2] [2 1]]] 290 | ctor [double-list counted-double-list]] 291 | (let [aobj (apply ctor a)] 292 | (is (not= aobj b)) 293 | (is (not= b aobj)) 294 | (doseq [afn [#(apply hash-set %) #(zipmap % %)]] 295 | (is (not= aobj (afn a))) 296 | (is (not= (afn a) aobj)))))) 297 | 298 | (deftest Unequal-Sets 299 | (doseq [[a b] [[[] [1]] [[1] []] [[1] [2]] [[1 2] [2 1]]]] 300 | (let [aobj (apply counted-sorted-set a)] 301 | (is (not= aobj b)) 302 | (is (not= b aobj)) 303 | (is (not= aobj (zipmap a a))) 304 | (is (not= (zipmap a a) aobj))))) 305 | 306 | (deftest Meta 307 | (doseq [data [[] [3 2 1] (range 50)] 308 | ctor [double-list counted-double-list counted-sorted-set]] 309 | (let [mdata {:foo :bar} 310 | coll (with-meta (apply ctor data) mdata)] 311 | (is (= mdata (meta coll))) 312 | (is (= coll (with-meta coll nil)))))) 313 | 314 | (defn is-same-coll [a b] 315 | (let [msg (format "(class a)=%s (class b)=%s (count a)=%s (count b)=%s a=%s b=%s (seq a)=%s (seq b)=%s" 316 | (.getName (class a)) (.getName (class b)) 317 | (count a) (count b) 318 | a b 319 | (seq a) (seq b))] 320 | (is (= (count a) (count b)) msg) 321 | (is (= a b) msg) 322 | (is (= b a) msg) 323 | (is (.equals ^Object a b) msg) 324 | (is (.equals ^Object b a) msg) 325 | (is (= (hash a) (hash b)) msg) 326 | (is (= (.hashCode ^Object a) (.hashCode ^Object b)) msg))) 327 | 328 | (deftest sanity-checks 329 | (let [colls [ [(int -2) 4 5 6 7] 330 | (double-list (int -2) 4 5 6 7) 331 | (counted-double-list (int -2) 4 5 6 7) ]] 332 | (doseq [e1 colls, e2 colls] 333 | (is-same-coll e1 e2))) 334 | (let [colls [ [] 335 | (double-list) 336 | (counted-double-list) 337 | (empty [(int -2) 4 5 6 7]) 338 | (empty (double-list (int -2) 4 5 6 7)) 339 | (empty (counted-double-list (int -2) 4 5 6 7)) ]] 340 | (doseq [e1 colls, e2 colls] 341 | (is-same-coll e1 e2))) 342 | (let [colls [ (sorted-set) 343 | (sorted-set-by >) 344 | (counted-sorted-set) 345 | (counted-sorted-set-by (comparator >)) 346 | (empty (sorted-set (int -2) 4 5 6 7)) 347 | (empty (sorted-set-by > (int -2) 4 5 6 7)) 348 | (empty (counted-sorted-set (int -2) 4 5 6 7)) 349 | (empty (counted-sorted-set-by (comparator >) (int -2) 4 5 6 7)) ]] 350 | (doseq [e1 colls, e2 colls] 351 | (is-same-coll e1 e2))) 352 | (let [colls [ (sorted-set (int -2) 4 5 6 7) 353 | (sorted-set-by > (int -2) 4 5 6 7) 354 | (counted-sorted-set (int -2) 4 5 6 7) 355 | (counted-sorted-set-by (comparator >) (int -2) 4 5 6 7) ]] 356 | (doseq [e1 colls, e2 colls] 357 | (is-same-coll e1 e2)))) 358 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/finger_tree.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. 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 ^{:doc "Persistent collections based on 2-3 finger trees." 10 | :author "Chris Houser"} 11 | clojure.data.finger-tree 12 | (:import (clojure.lang Seqable Sequential ISeq IPersistentSet ILookup 13 | IPersistentStack IPersistentCollection Associative 14 | Sorted Reversible Indexed Counted IHashEq))) 15 | 16 | (comment ; TODO: 17 | 18 | - implement java.util.Collection 19 | - implement IMeta 20 | - implement IChunkedSeq? 21 | - replace copy/pasted code with macros 22 | - test dequeue complexity 23 | - confirm recursion is bounded, though perhaps O(log n) growth is slow enough 24 | - add simple lookup to Splittable? 25 | - add sorted map with index? 26 | ) 27 | 28 | ;(set! *warn-on-reflection* true) 29 | 30 | (defprotocol ConjL 31 | (conjl [s a] "Append a to the left-hand side of s")) 32 | 33 | (defprotocol ObjMeter 34 | "Object for annotating tree elements. idElem and op together form a Monoid." 35 | (measure [_ o] "Return the measured value of o (same type as idElem)") 36 | (idElem [_] "Return the identity element for this meter") 37 | (opfn [_] "Return an associative function of two args for combining measures")) 38 | 39 | (defprotocol Measured 40 | (measured [o] "Return the measured value of o") 41 | (getMeter [o] "Return the meter object for o")) 42 | 43 | (defprotocol Splittable 44 | (split [o pred acc] "Return [pre m post] where pre and post are trees")) 45 | 46 | (defprotocol SplitAt 47 | (ft-split-at [o k notfound] [o k] 48 | "Return [pre m post] where pre and post are trees")) 49 | 50 | (defprotocol Tree 51 | (app3 [t1 ts t2] "Append ts and (possibly deep) t2 to tree t1") 52 | (app3deep [t2 ts t1] "Append ts and t2 to deep tree t1") 53 | (measureMore [o] "Return the measure of o not including the leftmost item") 54 | (measurePop [o] "Return the measure of o not including the rightmost item")) 55 | 56 | (extend-type nil 57 | ObjMeter 58 | (measure [_ _] nil) 59 | (idElem [_] nil) 60 | (opfn [_] nil) 61 | Measured 62 | (measured [_] nil) 63 | (getMeter [_] nil)) 64 | 65 | (declare newEmptyTree newSingleTree newDeepTree digit deep) 66 | 67 | (defmacro ^:private defdigit [& items] 68 | (let [i (gensym "i_") 69 | p (gensym "p_") 70 | o (gensym "o_") 71 | typename (symbol (str "Digit" (count items))) 72 | this-items (map #(list (keyword %) o) items)] 73 | `(deftype ~typename [~@items ~'meter-obj ~'measure-ref] 74 | Seqable 75 | (seq [_] ~(reduce #(list `cons %2 %1) nil (reverse items))) 76 | Indexed 77 | (count [_] ~(count items)) ; not needed? 78 | (nth [_ ~i notfound#] 79 | (cond ~@(mapcat (fn [sym n] [`(== ~i (int ~n)) sym]) 80 | items 81 | (range (count items))) 82 | :else notfound#)) 83 | Sequential 84 | ISeq 85 | (first [_] ~(first items)) 86 | (more [_] ~(if (> (count items) 1) 87 | `(digit ~'meter-obj ~@(next items)) 88 | `(newEmptyTree ~'meter-obj))) 89 | (next [_] ~(when (> (count items) 1) 90 | `(digit ~'meter-obj ~@(next items)))) 91 | IPersistentStack 92 | (peek [_] ~(last items)) 93 | (pop [_] ~(if (> (count items) 1) 94 | `(digit ~'meter-obj ~@(drop-last items)) 95 | `(newEmptyTree ~'meter-obj))) 96 | IPersistentCollection 97 | (empty [_]) ; TBD ; not needed? 98 | (equiv [_ x#] false) ; TBD 99 | (cons [_ x#] (digit ~'meter-obj ~@items x#)) 100 | ConjL 101 | (conjl [_ x#] (digit ~'meter-obj x# ~@items)) 102 | Measured 103 | (measured [_] @~'measure-ref) 104 | (getMeter [_] ~'meter-obj) ; not needed? 105 | Splittable ; allow to fail if op is nil: 106 | (split [_ ~p ~i] 107 | ~(letfn [(step [ips [ix & ixs]] 108 | (if (empty? ixs) 109 | [(when ips `(digit ~'meter-obj ~@ips)) 110 | ix 111 | nil] 112 | `(let [~i ((opfn ~'meter-obj) 113 | ~i 114 | (measure ~'meter-obj ~ix))] 115 | (if (~p ~i) 116 | [~(when ips 117 | `(digit ~'meter-obj ~@ips)) 118 | ~ix 119 | (digit ~'meter-obj ~@ixs)] 120 | ~(step (concat ips [ix]) ixs)))))] 121 | (step nil items)))))) 122 | 123 | (defmacro ^:private make-digit [meter-obj & items] 124 | (let [typename (symbol (str "Digit" (count items)))] 125 | `(let [~'mobj ~meter-obj 126 | ~'op (opfn ~'mobj)] 127 | (new ~typename ~@items ~'mobj 128 | (when ~'op 129 | (delay ~(reduce #(list 'op %1 %2) 130 | (map #(list `measure 'mobj %) items)))))))) 131 | 132 | (defmacro meter [measure idElem op] 133 | `(reify ObjMeter 134 | (measure [_ a#] (~measure a#)) 135 | (idElem [_] ~idElem) 136 | (opfn [_] ~op))) 137 | 138 | (defdigit a) 139 | (defdigit a b) 140 | (defdigit a b c) 141 | (defdigit a b c d) 142 | 143 | ;; cannot be static because it calls protocol methods 144 | (defn digit 145 | ([meter-obj a] (make-digit meter-obj a)) 146 | ([meter-obj a b] (make-digit meter-obj a b)) 147 | ([meter-obj a b c] (make-digit meter-obj a b c)) 148 | ([meter-obj a b c d] (make-digit meter-obj a b c d))) 149 | 150 | (defn ^:static nodes [mfns xs] 151 | (let [v (vec xs), c (count v)] 152 | (seq 153 | (loop [i (int 0), nds []] 154 | (condp == (- c i) 155 | (int 2) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i))))) 156 | (int 3) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i)) 157 | (v (+ (int 2) i))))) 158 | (int 4) (-> nds (conj (digit mfns (v i) (v (+ (int 1) i)))) 159 | (conj (digit mfns (v (+ (int 2) i)) 160 | (v (+ (int 3) i))))) 161 | (recur (+ (int 3) i) 162 | (-> nds 163 | (conj (digit mfns (v i) (v (+ (int 1) i)) 164 | (v (+ (int 2) i))))))))))) 165 | 166 | (deftype EmptyTree [meter-obj] 167 | Seqable 168 | (seq [_] nil) 169 | Sequential 170 | ISeq 171 | (first [_] nil) 172 | (more [this] this) 173 | (next [_] nil) 174 | IPersistentStack 175 | (peek [_] nil) 176 | (pop [this] this) 177 | Reversible 178 | (rseq [_] nil) 179 | IPersistentCollection 180 | (count [_] 0) ; not needed? 181 | (empty [this] this) 182 | (equiv [_ x] false) ; TBD 183 | (cons [_ b] (newSingleTree meter-obj b)) 184 | ConjL 185 | (conjl [_ a] (newSingleTree meter-obj a)) 186 | Measured 187 | (measured [_] (idElem meter-obj)) 188 | (getMeter [_] meter-obj) ; not needed? 189 | ; Splittable 190 | ; (split [pred acc]) ; TBD -- not needed?? 191 | Tree 192 | (app3 [_ ts t2] (reduce conjl t2 (reverse ts))) 193 | (app3deep [_ ts t1] (reduce conj t1 ts)) 194 | (measureMore [_] (idElem meter-obj)) 195 | (measurePop [_] (idElem meter-obj))) 196 | 197 | (defn ^:static newEmptyTree [meter-obj] 198 | (EmptyTree. meter-obj)) 199 | 200 | (defn ^:static finger-meter [meter-obj] 201 | (when meter-obj 202 | (meter 203 | #(measured %) 204 | (idElem meter-obj) 205 | (opfn meter-obj)))) 206 | 207 | (deftype SingleTree [meter-obj x] 208 | Seqable 209 | (seq [this] this) 210 | Sequential 211 | ISeq 212 | (first [_] x) 213 | (more [_] (EmptyTree. meter-obj)) 214 | (next [_] nil) 215 | IPersistentStack 216 | (peek [_] x) 217 | (pop [_] (EmptyTree. meter-obj)) 218 | Reversible 219 | (rseq [_] (list x)) ; not 'this' because tree ops can't be reversed 220 | IPersistentCollection 221 | (count [_]) ; not needed? 222 | (empty [_] (EmptyTree. meter-obj)) ; not needed? 223 | (equiv [_ x] false) ; TBD 224 | (cons [_ b] (deep (digit meter-obj x) 225 | (EmptyTree. (finger-meter meter-obj)) 226 | (digit meter-obj b))) 227 | ConjL 228 | (conjl [_ a] (deep (digit meter-obj a) 229 | (EmptyTree. (finger-meter meter-obj)) 230 | (digit meter-obj x))) 231 | Measured 232 | (measured [_] (measure meter-obj x)) 233 | (getMeter [_] meter-obj) ; not needed? 234 | Splittable 235 | (split [this pred acc] (let [e (empty this)] [e x e])) 236 | Tree 237 | (app3 [this ts t2] (conjl (app3 (empty this) ts t2) x)) 238 | (app3deep [_ ts t1] (conj (reduce conj t1 ts) x)) 239 | (measureMore [_] (idElem meter-obj)) 240 | (measurePop [_] (idElem meter-obj))) 241 | 242 | (defn ^:static newSingleTree [meter-obj x] 243 | (SingleTree. meter-obj x)) 244 | 245 | (deftype DelayedTree [tree-ref mval] 246 | Seqable 247 | (seq [this] this) 248 | Sequential 249 | ISeq 250 | (first [_] (first @tree-ref)) 251 | (more [_] (rest @tree-ref)) 252 | (next [_] (next @tree-ref)) 253 | IPersistentStack 254 | (peek [_] (peek @tree-ref)) 255 | (pop [_] (pop @tree-ref)) 256 | Reversible 257 | (rseq [_] (rseq @tree-ref)) ; not this because tree ops can't be reversed 258 | IPersistentCollection 259 | (count [_]) ; not needed? 260 | (empty [_] (empty @tree-ref)) 261 | (equiv [_ x] false) ; TBD 262 | (cons [_ b] (conj @tree-ref b)) 263 | ConjL 264 | (conjl [_ a] (conjl @tree-ref a)) 265 | Measured 266 | (measured [_] mval) 267 | (getMeter [_] (getMeter @tree-ref)) ; not needed? 268 | Splittable 269 | (split [_ pred acc] (split @tree-ref pred acc)) 270 | Tree 271 | (app3 [_ ts t2] (app3 @tree-ref ts t2)) 272 | (app3deep [_ ts t1] (app3deep @tree-ref ts t1)) 273 | (measureMore [_] (measureMore @tree-ref)) 274 | (measurePop [_] (measurePop @tree-ref))) 275 | 276 | (defmacro ^:private delay-ft [tree-expr mval] 277 | `(DelayedTree. (delay ~tree-expr) ~mval)) 278 | ;`(let [v# ~mval] (assert v#) ~tree-expr)) 279 | ;`(delayed-ft (delay (do (print "\nforce ") ~tree-expr)) ~mval)) 280 | 281 | (defn ^:static to-tree [meter-obj coll] 282 | (reduce conj (EmptyTree. meter-obj) coll)) 283 | 284 | (defn deep-left [pre m suf] 285 | (cond 286 | (seq pre) (deep pre m suf) 287 | (empty? (first m)) (to-tree (getMeter suf) suf) 288 | :else (deep (first m) 289 | (delay-ft (rest m) (measureMore m)) 290 | suf))) 291 | 292 | (defn deep-right [pre m suf] 293 | (cond 294 | (seq suf) (deep pre m suf) 295 | (empty? (peek m)) (to-tree (getMeter pre) pre) 296 | :else (deep pre 297 | (delay-ft (pop m) (measurePop m)) 298 | (peek m)))) 299 | 300 | (defn ^:private measured3 [meter-obj pre m suf] 301 | (when-let [op (opfn meter-obj)] 302 | (op 303 | (op (measured pre) 304 | (measured m)) 305 | (measured suf)))) 306 | 307 | (defn deep [pre m suf] 308 | (let [meter-obj (getMeter pre) 309 | op (opfn meter-obj)] 310 | (newDeepTree meter-obj pre m suf 311 | (when op 312 | (delay (if (seq m) 313 | (measured3 meter-obj pre m suf) 314 | (op (measured pre) (measured suf)))))))) 315 | 316 | (deftype DeepTree [meter-obj pre mid suf mval] 317 | Seqable 318 | (seq [this] this) 319 | Sequential 320 | ISeq 321 | (first [_] (first pre)) 322 | (more [_] (deep-left (rest pre) mid suf)) 323 | (next [this] (seq (rest this))) 324 | IPersistentStack 325 | (peek [_] (peek suf)) 326 | (pop [_] (deep-right pre mid (pop suf))) 327 | Reversible 328 | (rseq [this] (lazy-seq (cons (peek this) (rseq (pop this))))) 329 | IPersistentCollection 330 | (count [_]) ; not needed? 331 | (empty [_] (newEmptyTree meter-obj)) 332 | (equiv [_ x] false) ; TBD 333 | (cons [_ a] (if (< (count suf) 4) 334 | (deep pre mid (conj suf a)) 335 | (let [[e d c b] suf 336 | n (digit meter-obj e d c)] 337 | (deep pre (conj mid n) (digit meter-obj b a))))) 338 | ConjL 339 | (conjl [_ a] (if (< (count pre) 4) 340 | (deep (conjl pre a) mid suf) 341 | (let [[b c d e] pre 342 | n (digit meter-obj c d e)] 343 | (deep (digit meter-obj a b) (conjl mid n) suf)))) 344 | Measured 345 | (measured [_] @mval) 346 | (getMeter [_] (getMeter pre)) ; not needed? 347 | Splittable ; allow to fail if op is nil: 348 | (split [_ pred acc] 349 | (let [op (opfn meter-obj) 350 | vpr (op acc (measured pre))] 351 | (if (pred vpr) 352 | (let [[sl sx sr] (split pre pred acc)] 353 | [(to-tree meter-obj sl) sx (deep-left sr mid suf)]) 354 | (let [vm (op vpr (measured mid))] 355 | (if (pred vm) 356 | (let [[ml xs mr] (split mid pred vpr) 357 | [sl sx sr] (split xs pred (op vpr (measured ml)))] 358 | [(deep-right pre ml sl) sx (deep-left sr mr suf)]) 359 | (let [[sl sx sr] (split suf pred vm)] 360 | [(deep-right pre mid sl) 361 | sx 362 | (to-tree meter-obj sr)])))))) 363 | Tree 364 | (app3 [this ts t2] (app3deep t2 ts this)) 365 | (app3deep [_ ts t1] 366 | (deep (.pre ^DeepTree t1) 367 | (app3 (.mid ^DeepTree t1) 368 | (nodes meter-obj (concat (.suf ^DeepTree t1) ts pre)) 369 | mid) 370 | suf)) 371 | (measureMore [this] (measured3 meter-obj (rest pre) mid suf)) 372 | (measurePop [this] (measured3 meter-obj pre mid (pop suf)))) 373 | 374 | (defn ^:static newDeepTree [meter-obj pre mid suf mval] 375 | (DeepTree. meter-obj pre mid suf mval)) 376 | 377 | (defn ^:static finger-tree [meter-obj & xs] 378 | (to-tree meter-obj xs)) 379 | 380 | (defn split-tree [t p] 381 | (split t p (idElem (getMeter t)))) 382 | 383 | (defn ft-concat [t1 t2] 384 | (assert (= (getMeter t1) (getMeter t2))) ;meters must be the same 385 | (app3 t1 nil t2)) 386 | 387 | (defn- seq-equals [a b] 388 | (boolean 389 | (when (or (sequential? b) (instance? java.util.List b)) 390 | (loop [a (seq a), b (seq b)] 391 | (when (= (nil? a) (nil? b)) 392 | (or 393 | (nil? a) 394 | (when (= (first a) (first b)) 395 | (recur (next a) (next b))))))))) 396 | 397 | ;;=== applications === 398 | 399 | (defmacro compile-if [test then else] 400 | (if (eval test) 401 | then 402 | else)) 403 | 404 | (defn hashcode [x] 405 | (clojure.lang.Util/hash x)) 406 | 407 | (defn hash-ordered [coll] 408 | (compile-if (resolve 'clojure.core/hash-ordered-coll) 409 | (hash-ordered-coll coll) 410 | (loop [h (int 1), xs coll] 411 | (if-let [xs (seq xs)] 412 | (recur (unchecked-add-int (unchecked-multiply-int (int 31) h) 413 | (clojure.lang.Util/hasheq (first xs))) 414 | (next xs)) 415 | h)))) 416 | 417 | (defn hash-unordered [coll] 418 | (compile-if (resolve 'clojure.core/hash-unordered-coll) 419 | (hash-unordered-coll coll) 420 | (loop [h (int 0), xs coll] 421 | (if-let [xs (seq xs)] 422 | (recur (unchecked-add-int h 423 | (clojure.lang.Util/hasheq (first xs))) 424 | (next xs)) 425 | h)))) 426 | 427 | (deftype DoubleList [tree mdata] 428 | Object 429 | (equals [_ x] (seq-equals tree x)) 430 | (hashCode [this] (hashcode (map identity this))) 431 | IHashEq 432 | (hasheq [this] 433 | (hash-ordered this)) 434 | java.lang.Iterable 435 | (iterator [this] 436 | (clojure.lang.SeqIterator. (seq this))) 437 | clojure.lang.IObj 438 | (meta [_] mdata) 439 | (withMeta [_ mdata] (DoubleList. tree mdata)) 440 | Sequential 441 | Seqable 442 | (seq [this] (when (seq tree) this)) 443 | ISeq 444 | (first [_] (first tree)) 445 | (more [_] (DoubleList. (rest tree) mdata)) 446 | (next [_] (if-let [t (next tree)] (DoubleList. t mdata))) 447 | IPersistentStack ; actually, queue 448 | (peek [_] (peek tree)) 449 | (pop [_] (DoubleList. (pop tree) mdata)) 450 | Reversible 451 | (rseq [_] (rseq tree)) ; not 'this' because tree ops can't be reversed 452 | IPersistentCollection 453 | (count [_] (count (seq tree))) ; Slow! 454 | (empty [_] (DoubleList. (empty tree) mdata)) 455 | (equiv [_ x] (seq-equals tree x)) 456 | (cons [_ b] (DoubleList. (conj tree b) mdata)) 457 | ConjL 458 | (conjl [_ a] (DoubleList. (conjl tree a) mdata)) 459 | Measured 460 | (measured [_] (measured tree)) 461 | (getMeter [_] (getMeter tree)) 462 | Tree 463 | (app3 [_ ts t2] (DoubleList. (app3 tree ts t2) mdata)) 464 | (app3deep [_ ts t1] (DoubleList. (app3deep tree ts t1) mdata))) 465 | 466 | (defn double-list [& args] 467 | (into (DoubleList. (EmptyTree. nil) nil) args)) 468 | 469 | (deftype CountedDoubleList [tree mdata] 470 | Object 471 | (equals [_ x] (seq-equals tree x)) 472 | (hashCode [this] (hashcode (map identity this))) 473 | IHashEq 474 | (hasheq [this] 475 | (hash-ordered this)) 476 | java.lang.Iterable 477 | (iterator [this] 478 | (clojure.lang.SeqIterator. (seq this))) 479 | clojure.lang.IObj 480 | (meta [_] mdata) 481 | (withMeta [_ mdata] (CountedDoubleList. tree mdata)) 482 | Sequential 483 | Seqable 484 | (seq [this] (when (seq tree) this)) 485 | ISeq 486 | (first [_] (first tree)) 487 | (more [_] (CountedDoubleList. (rest tree) mdata)) 488 | (next [_] (if-let [t (next tree)] (CountedDoubleList. t mdata))) 489 | IPersistentStack 490 | (peek [_] (peek tree)) 491 | (pop [_] (CountedDoubleList. (pop tree) mdata)) 492 | Reversible 493 | (rseq [_] (rseq tree)) ; not 'this' because tree ops can't be reversed 494 | IPersistentCollection 495 | (empty [_] (CountedDoubleList. (empty tree) mdata)) 496 | (equiv [_ x] (seq-equals tree x)) 497 | (cons [_ b] (CountedDoubleList. (conj tree b) mdata)) 498 | ConjL 499 | (conjl [_ a] (CountedDoubleList. (conjl tree a) mdata)) 500 | Measured 501 | (measured [_] (measured tree)) 502 | (getMeter [_] (getMeter tree)) ; not needed? 503 | SplitAt 504 | (ft-split-at [this n notfound] 505 | (cond 506 | (< n 0) [(empty this) notfound this] 507 | (< n (count this)) 508 | (let [[pre m post] (split-tree tree #(> % n))] 509 | [(CountedDoubleList. pre mdata) m (CountedDoubleList. post mdata)]) 510 | :else [this notfound (empty this)])) 511 | (ft-split-at [this n] 512 | (ft-split-at this n nil)) 513 | Tree 514 | (app3 [_ ts t2] 515 | (CountedDoubleList. (app3 tree ts (.tree ^CountedDoubleList t2)) mdata)) 516 | ;(app3deep [_ ts t1] (CountedDoubleList. (app3deep tree ts t1) mdata)) 517 | (measureMore [_] (measureMore tree)) 518 | (measurePop [_] (measurePop tree)) 519 | Counted 520 | (count [_] (measured tree)) 521 | Associative 522 | (assoc [this k v] 523 | (cond 524 | (== k -1) (conjl this v) 525 | (== k (measured tree)) (conj this v) 526 | (< -1 k (measured tree)) 527 | (let [[pre mid post] (split-tree tree #(> % k))] 528 | (CountedDoubleList. (ft-concat (conj pre v) post) mdata)) 529 | :else (throw (IndexOutOfBoundsException.)))) 530 | (containsKey [_ k] (< -1 k (measured tree))) 531 | (entryAt [_ n] (clojure.lang.MapEntry. 532 | n (second (split-tree tree #(> % n))))) 533 | (valAt [this n notfound] (if (.containsKey this n) 534 | (second (split-tree tree #(> % n))) 535 | notfound)) 536 | (valAt [this n] (.valAt this n nil)) 537 | Indexed 538 | (nth [this n notfound] (if (.containsKey this n) 539 | (second (split-tree tree #(> % n))) 540 | notfound)) 541 | (nth [this n] (if (.containsKey this n) 542 | (second (split-tree tree #(> % n))) 543 | (throw (IndexOutOfBoundsException.))))) 544 | 545 | (let [measure-len (constantly 1) 546 | len-meter (meter measure-len 0 +)] 547 | (def empty-counted-double-list 548 | (CountedDoubleList. (EmptyTree. len-meter) nil))) 549 | 550 | (defn counted-double-list [& args] 551 | (into empty-counted-double-list args)) 552 | 553 | 554 | (defrecord Len-Right-Meter [^int len right]) 555 | 556 | (def ^:private notfound (Object.)) 557 | 558 | (deftype CountedSortedSet [cmpr tree mdata] 559 | Object 560 | (equals [_ x] 561 | (boolean 562 | (if (instance? java.util.Set x) 563 | (and (= (count x) (count tree)) 564 | (every? #(contains? x %) tree)) 565 | (seq-equals tree x)))) 566 | (hashCode [_] (reduce + (map hashcode tree))) 567 | IHashEq 568 | (hasheq [this] 569 | (hash-unordered this)) 570 | clojure.lang.IObj 571 | (meta [_] mdata) 572 | (withMeta [_ mdata] (CountedSortedSet. cmpr tree mdata)) 573 | Seqable 574 | ; return 'tree' instead of 'this' so that result will be Sequential 575 | (seq [this] (when (seq tree) tree)) 576 | IPersistentCollection 577 | (cons [this value] 578 | (if (empty? tree) 579 | (CountedSortedSet. cmpr (conj tree value) mdata) 580 | (let [[l x r] (split-tree tree #(>= 0 (cmpr value (:right %)))) 581 | compared (cmpr value x)] 582 | (if (zero? compared) 583 | this ; already in set 584 | (let [[a b] (if (>= 0 compared) [value x] [x value])] 585 | (CountedSortedSet. cmpr (ft-concat (conj l a) (conjl r b)) mdata)))))) 586 | (empty [_] (CountedSortedSet. cmpr (empty tree) mdata)) 587 | (equiv [this x] (.equals this x)) ; TBD 588 | ISeq 589 | (first [_] (first tree)) 590 | (more [_] (CountedSortedSet. cmpr (rest tree) mdata)) 591 | (next [_] (if-let [t (next tree)] (CountedSortedSet. cmpr t mdata))) 592 | IPersistentStack 593 | (peek [_] (peek tree)) 594 | (pop [_] (CountedSortedSet. cmpr (pop tree) mdata)) 595 | Reversible 596 | (rseq [_] (rseq tree)) ; not 'this' because tree ops can't be reversed 597 | Measured 598 | (measured [_] (measured tree)) 599 | (getMeter [_] (getMeter tree)) ; not needed? 600 | SplitAt 601 | (ft-split-at [this n notfound] 602 | (cond 603 | (< n 0) [(empty this) notfound this] 604 | (< n (count this)) (let [[l x r] (split-tree tree #(> (:len %) n))] 605 | [(CountedSortedSet. cmpr l mdata) x 606 | (CountedSortedSet. cmpr r mdata)]) 607 | :else [this notfound (empty this)])) 608 | (ft-split-at [this n] 609 | (ft-split-at this n nil)) 610 | Counted 611 | (count [_] (:len (measured tree))) 612 | ILookup 613 | (valAt [_ k notfound] 614 | (if (empty? tree) 615 | notfound 616 | (let [x (second (split-tree tree #(>= 0 (cmpr k (:right %)))))] 617 | (if (= x k) 618 | k 619 | notfound)))) 620 | (valAt [this k] 621 | (.valAt this k nil)) 622 | IPersistentSet 623 | (disjoin [this k] 624 | (if (empty? tree) 625 | this 626 | (let [[l x r] (split-tree tree #(>= 0 (cmpr k (:right %))))] 627 | (if (= x k) 628 | (CountedSortedSet. cmpr (ft-concat l r) mdata) 629 | this)))) 630 | (get [this k] (.valAt this k nil)) 631 | Indexed 632 | (nth [this n notfound] (if (< -1 n (:len (measured tree))) 633 | (second (split-tree tree #(> (:len %) n))) 634 | notfound)) 635 | (nth [this n] (if (< -1 n (:len (measured tree))) 636 | (second (split-tree tree #(> (:len %) n))) 637 | (throw (IndexOutOfBoundsException.)))) 638 | Sorted 639 | (comparator [_] cmpr) 640 | (entryKey [_ x] x) 641 | (seq [this ascending?] (if ascending? (.seq this) (rseq tree))) 642 | (seqFrom [_ k ascending?] 643 | (let [[l x r] (split-tree tree #(>= 0 (cmpr k (:right %))))] 644 | (if ascending? 645 | (CountedSortedSet. cmpr (conjl r x) mdata) 646 | (rseq (conj l x))))) 647 | java.util.Set 648 | (contains [this x] (not= notfound (get this x notfound))) 649 | (containsAll [this xs] (every? #(contains? this %) xs)) 650 | (isEmpty [_] (empty? tree)) 651 | (iterator [_] 652 | (let [t (atom tree)] 653 | (reify java.util.Iterator 654 | (next [_] (let [f (first @t)] 655 | (swap! t next) 656 | f)) 657 | (hasNext [_] (boolean (first @t)))))) 658 | (size [this] (count this)) 659 | ;;toArray ... TBD 660 | ) 661 | 662 | (let [measure-lr (fn [x] (Len-Right-Meter. 1 x)) 663 | zero-lr (Len-Right-Meter. 0 nil) 664 | len-lr (meter measure-lr 665 | zero-lr 666 | #(Len-Right-Meter. (+ (.len ^Len-Right-Meter %1) 667 | (.len ^Len-Right-Meter %2)) 668 | (or (:right %2) (:right %1)))) 669 | empty-tree (EmptyTree. len-lr) 670 | default-empty-set (CountedSortedSet. compare empty-tree nil)] 671 | (defn counted-sorted-set-by [cmpr & args] 672 | (into (CountedSortedSet. cmpr empty-tree nil) args)) 673 | (defn counted-sorted-set [& args] 674 | (into default-empty-set args))) 675 | 676 | ;(prefer-method clojure.pprint/simple-dispatch IPersistentSet ISeq) 677 | 678 | (defprotocol PrintableTree 679 | (print-tree [tree])) 680 | 681 | (defn- p [t & xs] 682 | (print "<") 683 | (print t) 684 | (doseq [x xs] 685 | (print " ") 686 | (print-tree x)) 687 | (print ">")) 688 | 689 | (extend-protocol PrintableTree 690 | Digit1 (print-tree [x] (p "Digit1" (.a x))) 691 | Digit2 (print-tree [x] (p "Digit2" (.a x) (.b x))) 692 | Digit3 (print-tree [x] (p "Digit3" (.a x) (.b x) (.c x))) 693 | Digit4 (print-tree [x] (p "Digit4" (.a x) (.b x) (.c x) (.d x))) 694 | EmptyTree (print-tree [x] (p "EmptyTree")) 695 | DelayedTree (print-tree [x] (p "DelayedTree" @(.tree-ref x))) 696 | DeepTree (print-tree [x] (p "DeepTree" (.pre x) (.mid x) (.suf x))) 697 | SingleTree (print-tree [x] (p "SingleTree" (.x x))) 698 | Object (print-tree [x] (pr x))) 699 | --------------------------------------------------------------------------------