├── .gitignore ├── LICENSE ├── README.org ├── src ├── bidirindex.org ├── core.org ├── heap.org ├── intervaltree.org ├── setup.org ├── streams.org └── unionfind.org ├── tangle-all.sh ├── tangle.sh └── test └── core.org /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: thi.ng/dstruct 2 | #+SETUPFILE: src/setup.org 3 | #+AUTHOR: Karsten Schmidt 4 | #+EMAIL: k@thi.ng 5 | 6 | * Contents :toc_3_gh: 7 | - [[#about-the-project][About the project]] 8 | - [[#description][Description]] 9 | - [[#leiningen-coordinates][Leiningen coordinates]] 10 | - [[#latest-stable][Latest stable]] 11 | - [[#namespaces][Namespaces]] 12 | - [[#tests][Tests]] 13 | - [[#project-definition][Project definition]] 14 | - [[#injected-properties][Injected properties]] 15 | - [[#dependencies][Dependencies]] 16 | - [[#runtime][Runtime]] 17 | - [[#development][Development]] 18 | - [[#building-this-project][Building this project]] 19 | - [[#testing][Testing]] 20 | - [[#working-with-the-repl][Working with the REPL]] 21 | - [[#leiningen-project-file][Leiningen project file]] 22 | - [[#clojurescript-html-harness][ClojureScript HTML harness]] 23 | - [[#accessing-library-version-during-runtime][Accessing library version during runtime]] 24 | - [[#version-namespace][Version namespace]] 25 | - [[#release-history][Release history]] 26 | - [[#contributors][Contributors]] 27 | - [[#license][License]] 28 | 29 | * About the project 30 | ** Description 31 | 32 | This library provides the following data structures for 33 | Clojure/Clojurescript: 34 | 35 | - Bi-directional index / map 36 | - Heap 37 | - Interval tree 38 | - I/O stream abstractions 39 | - Unionfind (disjoint sets, connected components, undirected graph) 40 | 41 | Furthermore, a number of general purpose helper functions for 42 | indexing, sequencing etc. is included. 43 | 44 | This library is the result of a thi.ng projectwide 45 | restructuring / dissolving of the [[http://thi.ng/common][thi.ng/common]] library. 46 | 47 | *Note:* This library relies on the new conditional reader syntax of 48 | recent Clojure & Clojurescript versions and therefore is *not 49 | compatible with Clojure versions < 1.7.0*... 50 | 51 | ** Leiningen coordinates 52 | *** Latest stable 53 | #+BEGIN_SRC clojure :noweb yes :noweb-ref lein-coords 54 | [thi.ng/dstruct "0.1.5"] 55 | #+END_SRC 56 | 57 | * Namespaces 58 | 59 | - [[./src/core.org][thi.ng.dstruct.core]] 60 | - [[./src/bidirindex.org][thi.ng.dstruct.bidirindex]] 61 | - [[./src/heap.org][thi.ng.dstruct.heap]] 62 | - [[./src/intervaltree.org][thi.ng.dstruct.intervaltree]] 63 | - [[./src/streams.org][thi.ng.dstruct.streams]] 64 | - [[./src/unionfind.org][thi.ng.dstruct.unionfind]] 65 | 66 | * Tests 67 | 68 | - TBD 69 | 70 | * Project definition 71 | ** Injected properties :noexport: 72 | 73 | #+BEGIN_SRC clojure :noweb-ref version 74 | 0.2.2 75 | #+END_SRC 76 | 77 | #+BEGIN_SRC clojure :exports none :noweb-ref project-url 78 | http://thi.ng/dstruct 79 | #+END_SRC 80 | 81 | #+BEGIN_SRC clojure :exports none :noweb yes :noweb-ref cljs-artefact-path 82 | target/dstruct-<>.js 83 | #+END_SRC 84 | 85 | ** Dependencies 86 | *** Runtime 87 | **** [[https://github.com/clojure/clojure][Clojure]] 88 | #+BEGIN_SRC clojure :noweb-ref dep-clj 89 | [org.clojure/clojure "1.11.1"] 90 | #+END_SRC 91 | **** [[https://github.com/clojure/clojurescript][ClojureScript]] 92 | #+BEGIN_SRC clojure :noweb-ref dep-cljs 93 | [org.clojure/clojurescript "1.11.4"] 94 | #+END_SRC 95 | **** [[https://github.com/thi-ng/math][thi.ng/math]] 96 | #+BEGIN_SRC clojure :noweb-ref dep-math 97 | [thi.ng/math "0.3.1"] 98 | #+END_SRC 99 | **** [[https://github.com/thi-ng/xerror][thi.ng/xerror]] 100 | #+BEGIN_SRC clojure :noweb-ref dep-xerror 101 | [thi.ng/xerror "0.1.0"] 102 | #+END_SRC 103 | 104 | *** Development 105 | **** [[https://github.com/hugoduncan/criterium][Criterium]] 106 | #+BEGIN_SRC clojure :noweb-ref dep-criterium 107 | [criterium "0.4.6"] 108 | #+END_SRC 109 | **** [[https://github.com/cemerick/clojurescript.test][clojurescript.test]] 110 | #+BEGIN_SRC clojure :noweb-ref dep-cljs-test 111 | [com.cemerick/clojurescript.test "0.3.3"] 112 | #+END_SRC 113 | **** [[https://github.com/emezeske/lein-cljsbuild][Cljsbuild]] 114 | #+BEGIN_SRC clojure :noweb-ref dep-cljsbuild 115 | [lein-cljsbuild "1.1.8"] 116 | #+END_SRC 117 | 118 | ** Building this project 119 | 120 | This project is written in a literate programming format and requires 121 | [[https://www.gnu.org/software/emacs/][Emacs]] & [[http://orgmode.org][Org-mode]] to generate usable source code. Assuming both tools 122 | are installed, the easiest way to generate a working project is via 123 | command line (make sure =emacs= is on your path or else edit its path 124 | in =tangle.sh=): 125 | 126 | #+BEGIN_SRC bash 127 | git clone https://github.com/thi.ng/dstruct.git 128 | cd dstruct 129 | ./tangle.sh src/*.org test/*.org 130 | #+END_SRC 131 | 132 | Tangling is the process of extracting & combining source blocks from 133 | =.org= files into an actual working project/source tree. Once tangling 134 | is complete, you can =cd= into the generated project directory 135 | (=babel=) and then use =lein= as usual. 136 | 137 | *** Testing 138 | 139 | The =project.clj= file defines an alias to trigger a complete build & 140 | tests for both CLJ & CLJS versions. 141 | 142 | #+BEGIN_SRC bash 143 | cd babel 144 | lein cleantest 145 | #+END_SRC 146 | 147 | To build the Clojurescript version simply run =lein cljsbuild test= 148 | from the same directory. A small HTML harness for the resulting JS 149 | file is also located in that folder (=babel/index.html=), allowing for 150 | further experimentation in the browser. 151 | 152 | *** Working with the REPL 153 | 154 | Editing code blocks or files in Org-mode, then re-loading & testing 155 | changes is quite trivial. Simply launch a REPL (via =lein= or Emacs) 156 | as usual. Everytime you've made changes to an =.org= file, re-tangle 157 | it from Emacs (=C-c C-v t=) or =tangle.sh=, then reload the namespace 158 | in the REPL via =(require 'thi.ng.dstruct... :reload)= or similar. 159 | 160 | ** Leiningen project file :noexport: 161 | 162 | #+BEGIN_SRC clojure :tangle babel/project.clj :noweb yes :mkdirp yes :padline no 163 | (defproject thi.ng/dstruct "<>" 164 | :description "Data structures & utilities for CLJ/CLJS" 165 | :url "<>" 166 | :license {:name "Apache Software License 2.0" 167 | :url "http://www.apache.org/licenses/LICENSE-2.0" 168 | :distribution :repo} 169 | :scm {:name "git" 170 | :url "git@github.com:thi-ng/dstruct.git"} 171 | 172 | :min-lein-vesion "2.4.0" 173 | 174 | :dependencies [<> 175 | <> 176 | <> 177 | <>] 178 | 179 | :source-paths ["src"] 180 | :test-paths ["test"] 181 | 182 | :profiles {:dev {:dependencies [<>] 183 | :plugins [<> 184 | <>] 185 | :global-vars {*warn-on-reflection* true} 186 | :jvm-opts ^:replace [] 187 | :aliases {"cleantest" ["do" "clean," "test," "cljsbuild" "test"]}}} 188 | 189 | :cljsbuild {:builds [{:id "simple" 190 | :source-paths ["src" "test"] 191 | :compiler {:output-to "<>" 192 | :optimizations :whitespace 193 | :parallel-build true 194 | :static-fns true 195 | :pretty-print true}}] 196 | :test-commands {"unit-tests" ["phantomjs" :runner "<>"]}} 197 | 198 | :pom-addition [:developers [:developer 199 | [:name "Karsten Schmidt"] 200 | [:url "https://thi.ng/"] 201 | [:timezone "1"]]]) 202 | #+END_SRC 203 | 204 | ** ClojureScript HTML harness :noexport: 205 | 206 | #+BEGIN_SRC html :tangle babel/index.html :noweb yes :mkdirp yes :padline no 207 | 208 | 209 | 210 | <<lein-coords>> test 211 | 212 | 213 | 214 | 215 | 216 | #+END_SRC 217 | 218 | ** Accessing library version during runtime 219 | 220 | The autogenerated namespace =thi.ng.dstruct.version= contains a single 221 | symbol =version= holding the version string defined above: 222 | 223 | #+BEGIN_SRC clojure :noweb yes 224 | (use '[thi.ng.dstruct.version]) 225 | 226 | (prn version) 227 | ;; "<>" 228 | #+END_SRC 229 | 230 | *** Version namespace :noexport: 231 | 232 | #+BEGIN_SRC clojure :tangle babel/src/thi/ng/dstruct/version.cljc :noweb yes :mkdirp yes :padline no :exports none 233 | (ns thi.ng.dstruct.version) 234 | 235 | (def version "<>") 236 | #+END_SRC 237 | 238 | ** Release history 239 | 240 | | *Version* | *Released* | *Description* | 241 | |-----------+------------+---------------------------------------------------------------| 242 | | 0.2.2 | 2022-04-23 | update deps | 243 | | 0.2.1 | 2016-06-13 | bugfix CLJS InputStreamWrapper | 244 | | 0.2.0 | 2016-04-05 | refactor IBuffer / IIntoBuffer protocol, minor other bugfixes | 245 | | 0.1.5 | 2016-03-19 | update deps, minor fix streams ns | 246 | | 0.1.4 | 2016-03-19 | fix tangling of tree walk fns | 247 | | 0.1.3 | 2016-03-19 | add BidirIndex, minor refactor, update deps | 248 | | 0.1.2 | 2015-11-05 | add clj/cljs i/o stream abstractions | 249 | | 0.1.1 | 2015-09-07 | bugfix DisjointSet, updated dependencies | 250 | | 0.1.0 | 2015-05-25 | initial test release | 251 | 252 | ** Contributors 253 | 254 | | *Name* | *Role* | *Website* | 255 | |-----------------+---------------------------------+----------------------------| 256 | | [[k@thi.ng][Karsten Schmidt]] | initiator & principal developer | https://thi.ng | 257 | 258 | I've got a fairly detailed roadmap and task list to implement over the 259 | coming months, but am always happy to receive feedback & suggestions 260 | and have issues filed. Once the core engine is more refined I'll be 261 | gladly welcoming other contributions. Thanks for understanding! 262 | 263 | ** License 264 | 265 | This project is open source and licensed under the [[http://www.apache.org/licenses/LICENSE-2.0][Apache Software License 2.0]]. 266 | -------------------------------------------------------------------------------- /src/bidirindex.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructbidirindex][Namespace: thi.ng.dstruct.bidirindex]] 5 | - [[#protocols][Protocols]] 6 | - [[#implementation][Implementation]] 7 | - [[#monotonicbidirindex][MonotonicBidirIndex]] 8 | - [[#custombidirindex][CustomBidirIndex]] 9 | - [[#constructors][Constructors]] 10 | - [[#id-generators][ID generators]] 11 | - [[#indexing-operations--helper-functions][Indexing operations & helper functions]] 12 | - [[#complete-namespace-definition][Complete namespace definition]] 13 | 14 | * Namespace: thi.ng.dstruct.bidirindex 15 | 16 | This namespace provides bi-directional index implementations between 17 | values to IDs and vice versa. 18 | 19 | ** Protocols 20 | 21 | #+BEGIN_SRC clojure :noweb-ref protos 22 | (defprotocol PIndex 23 | (index [_ item] 24 | "Attempts to find item in index and adds it to index if not found. 25 | Returns 2-elem vector of [updated-index item-id].") 26 | (unindex [_ item] 27 | "Attempts to remove item from index. Does nothing if item can't be 28 | found. Returns updated index.") 29 | (reindex [_ old new] 30 | "Attempts to re-associate the ID of old item with new item. Does 31 | nothing if old item can't be found. Returns update index.")) 32 | #+END_SRC 33 | 34 | ** Implementation 35 | 36 | The =PIndex= implementations below each consists of two hash maps to create the 2-way mapping: 37 | 38 | - =v->id= - maps indexed items to their respective ID 39 | - =id->v= - provides reverse mapping from ID to index value (uses =sorted-map=) 40 | 41 | Since the indices are implemented as =defrecord=, both fields can be 42 | accessed via their respective keywords. 43 | 44 | *** MonotonicBidirIndex 45 | 46 | #+BEGIN_SRC clojure :noweb-ref impl 47 | (defrecord MonotonicBidirIndex [v->id id->v next] 48 | PIndex 49 | (index 50 | [_ item] 51 | (let [id (get v->id item)] 52 | (if id 53 | [_ id] 54 | [(MonotonicBidirIndex. 55 | (assoc v->id item next) 56 | (assoc id->v next item) 57 | (inc next)) 58 | next]))) 59 | (unindex 60 | [_ item] 61 | (let [id (get v->id item)] 62 | (if id 63 | (MonotonicBidirIndex. 64 | (dissoc v->id item) 65 | (dissoc id->v id) 66 | next) 67 | _))) 68 | (reindex 69 | [_ item newitem] 70 | (let [id (get v->id item)] 71 | (if id 72 | (MonotonicBidirIndex. 73 | (-> v->id (dissoc item) (assoc newitem id)) 74 | (assoc id->v id newitem) 75 | next) 76 | _)))) 77 | #+END_SRC 78 | 79 | *** CustomBidirIndex 80 | 81 | IDs for this implementation are generated via an user supplied 82 | function which is called for every new item to be indexed. The default 83 | implementation provides a monotonically increasing counter generator. 84 | 85 | #+BEGIN_SRC clojure :noweb-ref impl 86 | (defrecord CustomBidirIndex [v->id id->v id-gen] 87 | PIndex 88 | (index 89 | [_ item] 90 | (let [id (get v->id item)] 91 | (if id 92 | [_ id] 93 | (let [id (id-gen item)] 94 | [(CustomBidirIndex. 95 | (assoc v->id item id) 96 | (assoc id->v id item) 97 | id-gen) 98 | id])))) 99 | (unindex 100 | [_ item] 101 | (let [id (get v->id item)] 102 | (if id 103 | (CustomBidirIndex. 104 | (dissoc v->id item) 105 | (dissoc id->v id) 106 | id-gen) 107 | _))) 108 | (reindex 109 | [_ item newitem] 110 | (let [id (get v->id item)] 111 | (if id 112 | (CustomBidirIndex. 113 | (-> v->id (dissoc item) (assoc newitem id)) 114 | (assoc id->v id newitem) 115 | id-gen) 116 | _)))) 117 | #+END_SRC 118 | 119 | ** Constructors 120 | 121 | #+BEGIN_SRC clojure :noweb-ref ctors 122 | (defn monotonic-index 123 | ([] (monotonic-index 0)) 124 | ([start] (MonotonicBidirIndex. (hash-map) (sorted-map) start)) 125 | ([start items] (reduce #(first (index %1 %2)) (monotonic-index start) items))) 126 | 127 | (defn custom-index 128 | ([] (custom-index (counter))) 129 | ([id-gen] (CustomBidirIndex. (hash-map) (sorted-map) id-gen)) 130 | ([id-gen items] (reduce #(first (index %1 %2)) (custom-index id-gen) items))) 131 | #+END_SRC 132 | 133 | ** ID generators 134 | 135 | #+BEGIN_SRC clojure :noweb-ref idgen 136 | (defn counter 137 | ([] (counter 0)) 138 | ([start] (let [id (volatile! (dec start))] (fn [_] (vswap! id inc))))) 139 | #+END_SRC 140 | 141 | ** Indexing operations & helper functions 142 | 143 | #+BEGIN_SRC clojure :noweb-ref ops 144 | (defn index-coll 145 | [idx coll] 146 | (reduce 147 | (fn [[idx ids] v] 148 | (let [[idx id] (index idx v)] 149 | [idx (conj ids id)])) 150 | [idx []] coll)) 151 | 152 | (defn index-attribs 153 | ([idx attribs] 154 | (index-attribs idx monotonic-index attribs)) 155 | ([idx ctor attribs] 156 | (reduce-kv 157 | (fn [[attr aids] id v] 158 | (let [[idx ids] (index-coll (or (get attr id) (ctor)) v)] 159 | [(assoc attr id idx) (assoc aids id ids)])) 160 | [idx {}] attribs))) 161 | 162 | (defn attrib-values 163 | [idx ids] (mapv (:id->v idx) ids)) 164 | #+END_SRC 165 | 166 | ** Complete namespace definition 167 | 168 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/bidirindex.cljc :noweb yes :mkdirp yes :padline no 169 | (ns thi.ng.dstruct.bidirindex) 170 | 171 | <> 172 | 173 | <> 174 | 175 | <> 176 | 177 | <> 178 | 179 | <> 180 | #+END_SRC 181 | -------------------------------------------------------------------------------- /src/core.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructcore][Namespace: thi.ng.dstruct.core]] 5 | - [[#indexing-functions][Indexing functions]] 6 | - [[#maps][Maps]] 7 | - [[#sets][Sets]] 8 | - [[#tree-walking][Tree walking]] 9 | - [[#sequence-functions][Sequence functions]] 10 | - [[#string-functions][String functions]] 11 | - [[#complete-namespace-definition][Complete namespace definition]] 12 | 13 | * Namespace: thi.ng.dstruct.core 14 | 15 | ** Indexing functions 16 | 17 | #+BEGIN_SRC clojure :noweb-ref index 18 | (defn index 19 | [i t] 20 | (if-let [tt (get i t)] [i tt] [(conj i t) t])) 21 | 22 | (defn index! 23 | [i t] 24 | (if-let [tt (get i t)] [i tt] [(conj! i t) t])) 25 | 26 | (defn index-kv 27 | [m k v] 28 | (if-let [e (find m k)] 29 | (assoc m (key e) (conj (val e) v)) 30 | (assoc m k #{v}))) 31 | 32 | (defn index-kv! 33 | [m k v] 34 | (if-let [vv (get m k)] 35 | (assoc! m k (conj vv v)) 36 | (assoc! m k #{v}))) 37 | 38 | (defn value-set 39 | ([idx v] (into #{} (get idx v))) 40 | ([f idx v] (into #{} (map f) (get idx v)))) 41 | 42 | (def set-conj (fnil conj #{})) 43 | 44 | (def vec-conj (fnil conj [])) 45 | 46 | (def set-conj2* #(if (nil? %) %2 (if (set? %) (conj % %2) #{% %2}))) 47 | 48 | (def vec-conj2* #(if (nil? %) %2 (if (vector? %) (conj % %2) [% %2]))) 49 | 50 | (defn collect-set 51 | [f coll] (into #{} (map f) coll)) 52 | 53 | (defn collect-indexed 54 | [f f2 coll] 55 | (let [keys (collect-set f coll)] 56 | (zipmap keys (if (= f2 identity) keys (map f2 keys))))) 57 | #+END_SRC 58 | 59 | ** Maps 60 | #+BEGIN_SRC clojure :noweb-ref maps 61 | (defn deep-merge 62 | "Merge fn to be used with `merge-with`. Recursively merges map 63 | values which are maps or seqs (for the latter `into` is used, only 64 | if RHS is seq or set as well). If the RHS value has the metadata key 65 | `:replace` set, it is used as new value without merging." 66 | [l r] 67 | (cond 68 | (get (meta r) :replace) r 69 | (or (sequential? l) (set? l)) (if (or (sequential? r) (set? r)) (into l r) r) 70 | (map? l) (merge-with deep-merge l r) 71 | :else r)) 72 | 73 | (defn merge-deep 74 | "Calls `merge-with` using `deep-merge` as merge fn." 75 | ([a b] (merge-with deep-merge a b)) 76 | ([a b & maps] (apply merge-with deep-merge a b maps))) 77 | #+END_SRC 78 | 79 | ** Sets 80 | 81 | #+BEGIN_SRC clojure :noweb-ref sets 82 | (defn interval-set 83 | [& ivals] 84 | (into 85 | (sorted-set) 86 | (mapcat 87 | (fn [v] (if (sequential? v) (range (first v) (inc (nth v 1))) [v]))) 88 | ivals)) 89 | 90 | (defn check-intervals 91 | [& ivals] 92 | (let [[ivals const] 93 | (reduce 94 | (fn [[i c] v] 95 | (if (sequential? v) 96 | [(conj i v) c] 97 | [i (conj c v)])) 98 | [[] #{}] ivals)] 99 | (fn [x] 100 | (if (const x) x 101 | (some #(if (<= (first %) x) (<= x (nth % 1))) ivals))))) 102 | #+END_SRC 103 | 104 | ** Tree walking 105 | 106 | CLJS walk differs to clojure's impl and doesn't work for 107 | defrecords hence we provide a custom version here. 108 | 109 | #+BEGIN_SRC clojure :noweb-ref walk 110 | (defn walk 111 | [inner outer form] 112 | (cond 113 | (seq? form) (outer (doall (map inner form))) 114 | (vector? form) (outer (mapv inner form)) 115 | :else (outer form))) 116 | 117 | (defn postwalk 118 | [f form] (walk #(postwalk f %) f form)) 119 | 120 | (defn filter-tree 121 | "Applies `f` to root coll and every of its (nested) elements. Returns 122 | a vector of items for which `f` returned a truthy value." 123 | [f root] 124 | (let [walk (fn walk [acc node] 125 | (cond 126 | (f node) (conj! acc node) 127 | (coll? node) (reduce walk acc node) 128 | :else acc))] 129 | (persistent! (reduce walk (transient []) root)))) 130 | #+END_SRC 131 | 132 | ** Sequence functions 133 | 134 | #+BEGIN_SRC clojure :noweb-ref seqs 135 | (defn cartesian-product 136 | "All the ways to take one item from each sequence 137 | (taken from clojure.contrib.combinatorics)" 138 | [& seqs] 139 | (let [v-original-seqs (vec seqs) 140 | step 141 | (fn step [v-seqs] 142 | (let [increment 143 | (fn [v-seqs] 144 | (loop [i (dec (count v-seqs)), v-seqs v-seqs] 145 | (if (neg? i) nil 146 | (if-let [rst (next (v-seqs i))] 147 | (assoc v-seqs i rst) 148 | (recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))] 149 | (when v-seqs 150 | (cons (map first v-seqs) 151 | (lazy-seq (step (increment v-seqs)))))))] 152 | (when (every? seq seqs) 153 | (lazy-seq (step v-original-seqs))))) 154 | 155 | (defn bisect 156 | ([f coll] 157 | (let [[m n] (reduce 158 | (fn [[m n] v] (if (f v) [(conj! m v) n] [m (conj! n v)])) 159 | [(transient []) (transient [])] coll)] 160 | [(persistent! m) (persistent! n)])) 161 | ([f f2 coll] 162 | (mapv f2 (bisect f coll)))) 163 | 164 | (defn neighbors 165 | [x coll] 166 | (let [n (dec (count coll))] 167 | (loop [i n] 168 | (when (>= i 0) 169 | (if (= x (nth coll i)) 170 | [(nth coll (if (pos? i) (dec i) n)) 171 | (nth coll (if (< i n) (inc i) 0))] 172 | (recur (dec i))))))) 173 | 174 | (defn successive-nth 175 | "Returns a lazyseq of `n`-element vectors, each one containing 176 | a successive elements of the original collection. 177 | 178 | (successive-nth 3 [1 2 3 4]) 179 | => ([1 2 3] [2 3 4] [3 4 5])" 180 | ([n coll] 181 | (lazy-seq 182 | (let [s (take n coll)] 183 | (if (= n (count s)) 184 | (cons (vec s) (successive-nth n (rest coll))))))) 185 | ([n step coll] 186 | (lazy-seq 187 | (let [s (take n coll)] 188 | (if (= n (count s)) 189 | (cons (vec s) (successive-nth n step (drop step coll)))))))) 190 | 191 | (defn successive-nth-indexed 192 | "Returns a lazyseq of nested 2-element vectors, each one containing 193 | a vector of `n` successive elements of the original collection and 194 | an sequence index. 195 | 196 | (successive-nth-indexed 2 [10 20 30 40]) 197 | => ([[10 20] 0] [[20 30] 1] [[30 40] 2])" 198 | ([n coll] (successive-nth-indexed n 0 coll)) 199 | ([n idx coll] 200 | (lazy-seq 201 | (let [s (take n coll)] 202 | (if (= n (count s)) 203 | (cons [(vec s) idx] 204 | (successive-nth-indexed n (inc idx) (rest coll)))))))) 205 | 206 | (defn apply-to-keys 207 | "Applies `f` with `args` to all given `keys` in `type`." 208 | [type keys f & args] 209 | (reduce (fn [acc k] (assoc acc k (apply f (get type k) args))) type keys)) 210 | 211 | (defn reduce-pairs 212 | ([f1 f2 coll] (reduce-pairs f1 f2 nil coll)) 213 | ([f1 f2 acc coll] 214 | (when (> (count coll) 1) 215 | (let [pairs (map (fn [[a b]] (f2 a b)) (partition 2 1 coll))] 216 | (if acc 217 | (reduce f1 acc pairs) 218 | (reduce f1 pairs)))))) 219 | 220 | (defn wrap-seq 221 | [s head tail] 222 | (concat 223 | (if (sequential? head) (concat head s) (cons head s)) 224 | (if (sequential? tail) tail [tail]))) 225 | 226 | (defn append-first 227 | [xs] (concat xs [(first xs)])) 228 | 229 | (defn rotate-left 230 | [n xs] 231 | (if (vector? xs) 232 | (into (subvec xs n) (subvec xs 0 n)) 233 | (concat (drop n xs) (take n xs)))) 234 | 235 | (defn index-of 236 | [coll item] 237 | (loop [i 0, coll coll] 238 | (if coll 239 | (if (= item (first coll)) 240 | i (recur (inc i) (next coll))) 241 | -1))) 242 | 243 | (defn all-after 244 | "Returns a new collection of all items after `item` in original `coll`. 245 | If `coll` is a vector, the new collection is created with `subvec`. 246 | Returns original coll if item isn't found." 247 | [item coll] 248 | (let [idx (inc (index-of coll item))] 249 | (if (pos? idx) 250 | (if (vector? coll) (subvec coll idx) (drop idx coll)) 251 | coll))) 252 | 253 | (defn iterate-while 254 | [pred f x] 255 | (lazy-seq 256 | (if (pred x) 257 | (cons x (iterate-while pred f (f x)))))) 258 | 259 | (defn iterate-n 260 | "Iteratively applies f to x, n times, then returns result." 261 | [n f x] 262 | (loop [x x, i 0] 263 | (if (< i n) 264 | (recur (f x) (inc i)) 265 | x))) 266 | #+END_SRC 267 | 268 | ** String functions 269 | 270 | #+BEGIN_SRC clojure :noweb-ref strings 271 | (defn unwrap-str [s n] (subs s n (- (count s) n))) 272 | 273 | (defn wrap-str [s pre post] (str pre s post)) 274 | 275 | (defn stringify-keys 276 | [m] (into {} (map (fn [e] [(str (key e)) (val e)])) m)) 277 | 278 | (defn demunge-flags 279 | "Takes a keyword or string of flags and string/seq of items, returns 280 | map with items as keys and boolean values indicating if an item has 281 | been found in the string representation of the kw. If `kw` is nil, 282 | returns nil. 283 | 284 | (demunge-flags :cad \"abcd\") 285 | #_=> {:a true :b false :c true :d true}" 286 | [kw xs] 287 | (when kw 288 | (let [^String flags (name kw)] 289 | (reduce 290 | (fn [acc x] 291 | (let [x (str x)] 292 | (assoc acc (keyword x) (<= 0 (.indexOf flags x))))) 293 | {} xs)))) 294 | 295 | (defn demunge-flags-seq 296 | "Like `demunge-flags` but returns lazyseq of booleans in same order as xs. 297 | 298 | (demunge-flags-seq :cad \"abcd\") => [true false true true]" 299 | [kw xs] 300 | (when kw 301 | (let [^String flags (name kw)] 302 | (map #(<= 0 (.indexOf flags (str %))) xs)))) 303 | #+END_SRC 304 | 305 | ** Complete namespace definition 306 | 307 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/core.cljc :noweb yes :mkdirp yes :padline no 308 | (ns thi.ng.dstruct.core) 309 | 310 | <> 311 | 312 | <> 313 | 314 | <> 315 | 316 | <> 317 | 318 | <> 319 | 320 | <> 321 | #+END_SRC 322 | -------------------------------------------------------------------------------- /src/heap.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructheap][Namespace: thi.ng.dstruct.heap]] 5 | - [[#todo-make-cljs-compatible][TODO make CLJS compatible]] 6 | - [[#type-definition][Type definition]] 7 | - [[#heap-operations][Heap operations]] 8 | - [[#constructors][Constructors]] 9 | - [[#complete-namespace-definition][Complete namespace definition]] 10 | 11 | * Namespace: thi.ng.dstruct.heap 12 | 13 | ** TODO make CLJS compatible 14 | 15 | This namespace is currently *not CLJS compatible*. 16 | 17 | ** Type definition 18 | 19 | #+BEGIN_SRC clojure :noweb-ref impl 20 | (deftype PersistentHeap 21 | [^clojure.lang.PersistentVector heap 22 | ^long n 23 | compare 24 | _meta] 25 | 26 | clojure.lang.IObj 27 | (meta [_] _meta) 28 | (withMeta [_ m] (PersistentHeap. heap n compare m)) 29 | 30 | clojure.lang.ILookup 31 | (valAt [_ k] (heap k)) 32 | (valAt [_ k not-found] (get heap k not-found)) 33 | 34 | clojure.lang.IFn 35 | (invoke [_ k] (heap k)) 36 | (invoke [_ k not-found] (get heap k not-found)) 37 | 38 | clojure.lang.IPersistentVector 39 | clojure.lang.ISeq 40 | (count [_] n) 41 | (first [_] (if (> n 0) (.nth heap 0))) 42 | (next [_] (if (> n 0) (pop _) nil)) 43 | (more [_] (if (> n 0) (pop _) '())) 44 | (entryAt [_ k] (clojure.lang.MapEntry. k (heap k))) 45 | (nth [_ k] (heap k)) 46 | (nth [_ k not-found] (get heap k not-found)) 47 | (equiv [_ o] (= heap o)) 48 | (hashCode [_] (.hashCode heap)) 49 | 50 | (assocN [_ k v] 51 | (PersistentHeap. 52 | (rebalance (assoc heap k v) compare) 53 | (if (== k n) (inc n) n) 54 | compare _meta)) 55 | (assoc [_ k v] 56 | (PersistentHeap. 57 | (rebalance (assoc heap k v) compare) 58 | (if (== k n) (inc n) n) 59 | compare _meta)) 60 | (cons [_ v] 61 | (PersistentHeap. 62 | (percolate+ (.cons heap v) compare n) (inc n) compare _meta)) 63 | 64 | clojure.lang.Seqable 65 | (seq [_] (ordered heap compare)) 66 | 67 | clojure.lang.IPersistentStack 68 | (peek [_] (.nth heap 0)) 69 | (pop [_] 70 | (condp = n 71 | 0 (throw (UnsupportedOperationException.)) 72 | 1 (PersistentHeap. [] 0 compare _meta) 73 | (PersistentHeap. 74 | (percolate- (assoc (pop heap) 0 (peek heap)) (dec n) compare 0) 75 | (dec n) compare _meta))) 76 | 77 | clojure.lang.Reversible 78 | (rseq [_] 79 | (rseq (vec (.seq _)))) 80 | 81 | Object 82 | (toString [_] (str heap))) 83 | #+END_SRC 84 | 85 | ** Heap operations 86 | 87 | #+BEGIN_SRC clojure :noweb-ref ops 88 | (defn- percolate+ 89 | [heap compare ^long k] 90 | (let [v (heap k)] 91 | (loop [heap (transient heap), k k] 92 | (if (> k 0) 93 | (let [parent-idx (bit-shift-right (dec k) 1) 94 | parent (heap parent-idx)] 95 | (if (> (compare parent v) 0) 96 | (recur (assoc! heap k parent) parent-idx) 97 | (persistent! (assoc! heap k v)))) 98 | (persistent! (assoc! heap k v)))))) 99 | 100 | (defn- percolate- 101 | [heap n compare ^long k] 102 | (let [n2 (bit-shift-right n 1) 103 | v (heap k)] 104 | (loop [heap (transient heap), k k] 105 | (if (< k n2) 106 | (let [left (inc (bit-shift-left k 1)) 107 | right (inc left) 108 | child (if (< right n) 109 | (if (< (compare (heap right) (heap left)) 0) right left) 110 | left) 111 | cval (heap child)] 112 | (if (> (compare cval v) 0) 113 | (persistent! (assoc! heap k v)) 114 | (recur (assoc! heap k cval) child))) 115 | (persistent! (assoc! heap k v)))))) 116 | 117 | (defn- rebalance 118 | [heap compare] 119 | (let [n (count heap)] 120 | (loop [heap heap, k (bit-shift-right n 1)] 121 | (if (>= k 0) 122 | (recur (percolate- heap n compare k) (dec k)) 123 | heap)))) 124 | 125 | (defn- delete-head 126 | [heap compare] 127 | (let [n (count heap)] 128 | (condp = n 129 | 0 nil 130 | 1 [] 131 | (percolate- (assoc (pop heap) 0 (peek heap)) (dec n) compare 0)))) 132 | 133 | (defn delete-at 134 | [heap compare k] 135 | (rebalance (into (subvec heap 0 k) (subvec heap (inc k))) compare)) 136 | 137 | (defn- ordered 138 | [heap compare] 139 | (loop [acc [], h heap] 140 | (if (seq h) 141 | (recur (conj acc (first h)) (delete-head h compare)) 142 | (seq acc)))) 143 | #+END_SRC 144 | 145 | ** Constructors 146 | 147 | #+BEGIN_SRC clojure :noweb-ref ctor 148 | (defn heap 149 | [& coll] 150 | (if (fn? (first coll)) 151 | (reduce conj (PersistentHeap. [] 0 (first coll) nil) (rest coll)) 152 | (reduce conj (PersistentHeap. [] 0 compare nil) coll))) 153 | #+END_SRC 154 | 155 | ** Complete namespace definition 156 | 157 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/heap.clj :noweb yes :mkdirp yes :padline no 158 | (ns thi.ng.dstruct.heap) 159 | 160 | (declare percolate+ percolate- rebalance ordered) 161 | 162 | <> 163 | 164 | <> 165 | 166 | <> 167 | #+END_SRC 168 | -------------------------------------------------------------------------------- /src/intervaltree.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructintervaltree][Namespace: thi.ng.dstruct.intervaltree]] 5 | - [[#type-definitions][Type definitions]] 6 | - [[#todo-transducers][TODO transducers]] 7 | - [[#constructor][Constructor]] 8 | - [[#complete-namespace-definition][Complete namespace definition]] 9 | 10 | * Namespace: thi.ng.dstruct.intervaltree 11 | 12 | This namespace contains an implementation of centered interval trees 13 | based on the related [[http://en.wikipedia.org/wiki/Interval_tree#Centered_interval_tree][Wikipedia article]]. This implementation is using 14 | mutable fields and is *not* thread safe. 15 | 16 | The tree maps intervals to values and can be queried for a given point 17 | (number), for which it returns values of all matching intervals. 18 | Multiple values can be mapped to the same interval, but adding values 19 | is idempotent (provided a value is always associated with the same 20 | interval). 21 | 22 | ** Type definitions 23 | 24 | *** TODO transducers 25 | 26 | #+BEGIN_SRC clojure :noweb-ref impl 27 | (defprotocol PIntervalTree 28 | (add-interval [_ i x]) 29 | (query-point [_ x acc]) 30 | (query-interval [_ i acc])) 31 | 32 | (defn sort-min 33 | [a b] 34 | (let [c (compare (nth a 0) (nth b 0))] 35 | (if (zero? c) (compare a b) c))) 36 | 37 | (defn sort-max 38 | [a b] 39 | (let [c (compare (nth b 1) (nth a 1))] 40 | (if (zero? c) (compare b a) c))) 41 | 42 | (deftype IntervalNode 43 | #?(:clj 44 | [median 45 | ^:unsynchronized-mutable left 46 | ^:unsynchronized-mutable right 47 | ^:unsynchronized-mutable c-left 48 | ^:unsynchronized-mutable c-right] 49 | :cljs 50 | [median 51 | ^:mutable left 52 | ^:mutable right 53 | ^:mutable c-left 54 | ^:mutable c-right]) 55 | PIntervalTree 56 | (add-interval [_ [il ih :as i] val] 57 | (cond 58 | (< ih median) 59 | (if left 60 | (add-interval left i val) 61 | (let [val #{val}] 62 | (set! left (IntervalNode. (mm/addm il ih 0.5) nil nil 63 | (sorted-map-by sort-min i val) 64 | (sorted-map-by sort-max i val))))) 65 | 66 | (> il median) 67 | (if right 68 | (add-interval right i val) 69 | (let [val #{val}] 70 | (set! right (IntervalNode. (mm/addm il ih 0.5) nil nil 71 | (sorted-map-by sort-min i val) 72 | (sorted-map-by sort-max i val))))) 73 | 74 | :else (do 75 | (set! c-left (update-in c-left [i] (fnil conj #{}) val)) 76 | (set! c-right (update-in c-right [i] (fnil conj #{}) val)))) 77 | _) 78 | (query-point 79 | [_ x acc] 80 | (let [acc (if (m/delta= x median) 81 | (into acc (mapcat val c-left)) 82 | (if (< x median) 83 | (->> c-left (r/take-while #(<= (nth (key %) 0) x)) (r/mapcat val) (into acc)) 84 | (->> c-right (r/take-while #(>= (nth (key %) 1) x)) (r/mapcat val) (into acc)))) 85 | acc (if (and left (< x median)) 86 | (query-point left x acc) 87 | acc) 88 | acc (if (and right (> x median)) 89 | (query-point right x acc) 90 | acc)] 91 | acc)) 92 | (query-interval 93 | [_ [a b :as i] acc] 94 | (let [acc (->> c-left 95 | (r/filter #(let [k (key %)] (and (<= (nth k 0) b) (>= (nth k 1) a)))) 96 | (r/mapcat val) 97 | (into acc)) 98 | acc (if (and left (< a median)) 99 | (query-interval left i acc) 100 | acc) 101 | acc (if (and right (> b median)) 102 | (query-interval right i acc) 103 | acc)] 104 | acc)) 105 | Object 106 | (toString 107 | [_] 108 | (str ":m " median 109 | ", :l " (pr-str left) 110 | ", :r " (pr-str right) 111 | ", :cl " (pr-str c-left) 112 | ", :cr " (pr-str c-right) 113 | ))) 114 | #+END_SRC 115 | 116 | ** Constructor 117 | 118 | #+BEGIN_SRC clojure :noweb-ref ctor 119 | (defn interval-tree 120 | ([x] 121 | (IntervalNode. x nil nil (sorted-map-by sort-min) (sorted-map-by sort-max))) 122 | ([x coll] 123 | (reduce (fn [t [k v]] (add-interval t k v)) (interval-tree x) coll))) 124 | #+END_SRC 125 | 126 | ** Complete namespace definition 127 | 128 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/intervaltree.cljc :noweb yes :mkdirp yes :padline no 129 | (ns thi.ng.dstruct.intervaltree 130 | #?(:cljs (:require-macros [thi.ng.math.macros :as mm])) 131 | (:require 132 | [thi.ng.math.core :as m] 133 | [clojure.core.reducers :as r] 134 | #?(:clj [thi.ng.math.macros :as mm]))) 135 | 136 | <> 137 | 138 | <> 139 | #+END_SRC 140 | -------------------------------------------------------------------------------- /src/setup.org: -------------------------------------------------------------------------------- 1 | #+SEQ_TODO: TODO(t) INPROGRESS(i) WAITING(w@) | DONE(d) CANCELED(c@) 2 | #+TAGS: write(w) fix(f) verify(v) noexport(n) template(t) usetemplate(u) 3 | #+EXPORT_EXCLUDE_TAGS: noexport 4 | #+AUTHOR: Karsten Schmidt 5 | #+EMAIL: k@thi.ng 6 | #+LANGUAGE: en 7 | #+OPTIONS: toc:3 h:4 html-postamble:auto html-preamble:t tex:t 8 | #+HTML_CONTAINER: div 9 | #+HTML_DOCTYPE: 10 | #+HTML_HEAD: 11 | #+HTML_HEAD: 12 | -------------------------------------------------------------------------------- /src/streams.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructstreams][Namespace: thi.ng.dstruct.streams]] 5 | - [[#protocols][Protocols]] 6 | - [[#iinputstream][IInputStream]] 7 | - [[#ioutputstream][IOutputStream]] 8 | - [[#istreamposition][IStreamPosition]] 9 | - [[#ibuffer--iintobuffer][IBuffer & IIntoBuffer]] 10 | - [[#input-stream][Input stream]] 11 | - [[#constructor][Constructor]] 12 | - [[#output-stream][Output stream]] 13 | - [[#constructor][Constructor]] 14 | - [[#data-url-conversion][Data URL conversion]] 15 | - [[#helpers][Helpers]] 16 | - [[#complete-namespace-definition][Complete namespace definition]] 17 | 18 | * Namespace: thi.ng.dstruct.streams 19 | 20 | This namespace provides unified CLJ/CLJS I/O stream abstractions to 21 | read & write binary data. In Clojure, the stream wrappers are simply 22 | around the standard =java.io.InputStream= / =java.io.OutputStream=. In 23 | Clojurescript, the implementation works with a backing =ArrayBuffer= 24 | and =DataView=. 25 | 26 | - Ints, floats & doubles can be read and written both in little or big 27 | endian order. 28 | - Streams are skippable in both CLJ/CLJS, but stream position can only 29 | be obtained in CLJS 30 | - To access a stream's underlying native buffer (in CLJS), use the 31 | =get-buffer= function of the =IBuffer= protocol defined below 32 | 33 | ** Protocols 34 | *** IInputStream 35 | #+BEGIN_SRC clojure :noweb-ref protocols 36 | (defprotocol IInputStream 37 | (read-utf8-line [_]) 38 | (read-uint8 [_]) 39 | (read-uint16-le [_]) 40 | (read-uint16-be [_]) 41 | (read-uint32-le [_]) 42 | (read-uint32-be [_]) 43 | (read-float-le [_]) 44 | (read-float-be [_]) 45 | (read-double-le [_]) 46 | (read-double-be [_]) 47 | (read-vec2f-le [_]) 48 | (read-vec2f-be [_]) 49 | (read-vec3f-le [_]) 50 | (read-vec3f-be [_])) 51 | #+END_SRC 52 | 53 | *** IOutputStream 54 | #+BEGIN_SRC clojure :noweb-ref protocols 55 | (defprotocol IOutputStream 56 | (write-utf8-bytes [_ str]) 57 | (write-uint8 [_ x]) 58 | (write-uint16-le [_ x]) 59 | (write-uint16-be [_ x]) 60 | (write-uint32-le [_ x]) 61 | (write-uint32-be [_ x]) 62 | (write-float-le [_ x]) 63 | (write-float-be [_ x]) 64 | (write-double-le [_ x]) 65 | (write-double-be [_ x]) 66 | (write-vec2f-le [_ v]) 67 | (write-vec2f-be [_ v]) 68 | (write-vec3f-le [_ v]) 69 | (write-vec3f-be [_ v])) 70 | #+END_SRC 71 | 72 | *** IStreamPosition 73 | #+BEGIN_SRC clojure :noweb-ref protocols 74 | (defprotocol IStreamPosition 75 | (skip [_ x]) 76 | (get-position [_])) 77 | #+END_SRC 78 | 79 | *** IBuffer & IIntoBuffer 80 | 81 | The =IBuffer= and =IIntoBuffer= protocols provide access to a type's 82 | (not necessarily a stream) underlying native buffer and provide 83 | potentially optimized implementations to move a type's internal data 84 | into a native buffer. For Clojure this is intended to be used with 85 | buffers from the =java.nio= package, or JS [[http://thi.ng/typedarrays][typed arrays]] in 86 | Clojurescript. 87 | 88 | Furthermore, in Clojurescript, implementations are expected to deal 89 | with *unsigned* data buffers (for byte, short, int versions). 90 | 91 | These protocols are currently mainly used by the following projects: 92 | 93 | - http://thi.ng/geom (vectors, matrices, meshes for OpenGL, mesh I/O) 94 | - http://thi.ng/color (color types) 95 | 96 | #+BEGIN_SRC clojure :noweb-ref protocols 97 | (defprotocol IBuffer 98 | (get-byte-buffer [_]) 99 | (get-float-buffer [_]) 100 | (get-double-buffer [_]) 101 | (get-short-buffer [_]) 102 | (get-int-buffer [_])) 103 | 104 | (defprotocol IIntoBuffer 105 | (into-byte-buffer [_ dest stride idx]) 106 | (into-float-buffer [_ dest stride idx]) 107 | (into-double-buffer [_ dest stride idx]) 108 | (into-short-buffer [_ dest stride idx]) 109 | (into-int-buffer [_ dest stride idx])) 110 | #+END_SRC 111 | 112 | ** Input stream 113 | 114 | #+BEGIN_SRC clojure :noweb-ref input 115 | #?(:clj 116 | (deftype InputStreamWrapper [^InputStream in ^bytes buf] 117 | IInputStream 118 | (read-uint8 119 | [_] 120 | (byte->int (.read in))) 121 | (read-uint16-le 122 | [_] 123 | (.read in buf 0 2) 124 | (bit-or (byte->int (aget buf 0)) (bit-shift-left (byte->int (aget buf 1)) 8))) 125 | (read-uint16-be 126 | [_] 127 | (.read in buf 0 2) 128 | (bit-or (byte->int (aget buf 1)) (bit-shift-left (byte->int (aget buf 0)) 8))) 129 | (read-uint32-le 130 | [_] 131 | (.read in buf 0 4) 132 | (bit-or 133 | (byte->int (aget buf 0)) 134 | (bit-shift-left (byte->int (aget buf 1)) 8) 135 | (bit-shift-left (byte->int (aget buf 2)) 16) 136 | (bit-shift-left (byte->int (aget buf 3)) 24))) 137 | (read-uint32-be 138 | [_] 139 | (.read in buf 0 4) 140 | (bit-or 141 | (byte->int (aget buf 3)) 142 | (bit-shift-left (byte->int (aget buf 2)) 8) 143 | (bit-shift-left (byte->int (aget buf 1)) 16) 144 | (bit-shift-left (byte->int (aget buf 0)) 24))) 145 | (read-float-le 146 | [_] (Float/intBitsToFloat (unchecked-int (read-uint32-le _)))) 147 | (read-float-be 148 | [_] (Float/intBitsToFloat (unchecked-int (read-uint32-be _)))) 149 | (read-double-le 150 | [_] 151 | (Double/longBitsToDouble 152 | (unchecked-long 153 | (bit-or 154 | (read-uint32-le _) 155 | (bit-shift-left (read-uint32-le _) 32))))) 156 | (read-double-be 157 | [_] 158 | (Double/longBitsToDouble 159 | (unchecked-long 160 | (bit-or 161 | (bit-shift-left (read-uint32-be _) 32) 162 | (read-uint32-be _))))) 163 | (read-vec2f-le 164 | [_] [(read-float-le _) (read-float-le _)]) 165 | (read-vec2f-be 166 | [_] [(read-float-be _) (read-float-be _)]) 167 | (read-vec3f-le 168 | [_] [(read-float-le _) (read-float-le _) (read-float-le _)]) 169 | (read-vec3f-be 170 | [_] [(read-float-be _) (read-float-be _) (read-float-be _)]) 171 | IStreamPosition 172 | (skip 173 | [_ x] (.skip in x) _) 174 | (get-position 175 | [_] (throw (UnsupportedOperationException.)))) 176 | 177 | :cljs 178 | (deftype InputStreamWrapper [^js/ArrayBuffer buf ^js/DataView dv ^:mutable pos] 179 | IInputStream 180 | (read-uint8 181 | [_] 182 | (ensure-readable _ 1) 183 | (let [x (.getUint8 dv pos)] 184 | (set! pos (inc pos)) 185 | x)) 186 | (read-uint16-le 187 | [_] 188 | (ensure-readable _ 2) 189 | (let [x (.getUint16 dv pos true)] 190 | (set! pos (+ pos 2)) 191 | x)) 192 | (read-uint16-be 193 | [_] 194 | (ensure-readable _ 2) 195 | (let [x (.getUint16 dv pos)] 196 | (set! pos (+ pos 2)) 197 | x)) 198 | (read-uint32-le 199 | [_] 200 | (ensure-readable _ 4) 201 | (let [x (.getUint32 dv pos true)] 202 | (set! pos (+ pos 4)) 203 | x)) 204 | (read-uint32-be 205 | [_] 206 | (ensure-readable _ 4) 207 | (let [x (.getUint32 dv pos)] 208 | (set! pos (+ pos 4)) 209 | x)) 210 | (read-float-le 211 | [_] 212 | (ensure-readable _ 4) 213 | (let [x (.getFloat32 dv pos true)] 214 | (set! pos (+ pos 4)) 215 | x)) 216 | (read-float-be 217 | [_] 218 | (ensure-readable _ 4) 219 | (let [x (.getFloat32 dv pos)] 220 | (set! pos (+ pos 4)) 221 | x)) 222 | (read-double-le 223 | [_] 224 | (ensure-readable _ 8) 225 | (let [x (.getFloat64 dv pos true)] 226 | (set! pos (+ pos 8)) 227 | x)) 228 | (read-double-be 229 | [_] 230 | (ensure-readable _ 8) 231 | (let [x (.getFloat64 dv pos)] 232 | (set! pos (+ pos 8)) 233 | x)) 234 | (read-vec2f-le 235 | [_] [(read-float-le _) (read-float-le _)]) 236 | (read-vec2f-be 237 | [_] [(read-float-be _) (read-float-be _)]) 238 | (read-vec3f-le 239 | [_] [(read-float-le _) (read-float-le _) (read-float-le _)]) 240 | (read-vec3f-be 241 | [_] [(read-float-be _) (read-float-be _) (read-float-be _)]) 242 | IStreamPosition 243 | (skip 244 | [_ x] 245 | (ensure-readable _ x) 246 | (set! pos (+ pos x)) 247 | _) 248 | (get-position 249 | [_] pos) 250 | IBuffer 251 | (get-byte-buffer 252 | [_] (js/Uint8Array. buf)) 253 | (get-float-buffer 254 | [_] (js/Float32Array. buf)) 255 | (get-double-buffer 256 | [_] (js/Float64Array. buf)) 257 | (get-short-buffer 258 | [_] (js/Uint16Array. buf)) 259 | (get-int-buffer 260 | [_] (js/Uint32Array. buf)))) 261 | #+END_SRC 262 | 263 | *** Constructor 264 | 265 | #+BEGIN_SRC clojure :noweb-ref ctors 266 | #?(:clj 267 | (defn input-stream 268 | [^InputStream in] 269 | (InputStreamWrapper. in (byte-array 12))) 270 | :cljs 271 | (defn input-stream 272 | ([^js/ArrayBuffer buf] 273 | (input-stream buf 0)) 274 | ([^js/ArrayBuffer buf pos] 275 | (InputStreamWrapper. buf (js/DataView. buf) pos)))) 276 | #+END_SRC 277 | 278 | ** Output stream 279 | 280 | The CLJS version of =ByteArrayOutputStreamWrapper= implements the 281 | =IBuffer= protocol and the implementation returns an =Uint8= view of 282 | the backing buffer up until the current write position. 283 | 284 | #+BEGIN_SRC clojure :noweb-ref output 285 | #?(:clj 286 | (deftype OutputStreamWrapper [^OutputStream out ^bytes buf] 287 | IOutputStream 288 | (write-utf8-bytes 289 | [_ str] 290 | (.write out (.getBytes ^String str "UTF-8")) _) 291 | (write-uint8 292 | [_ x] (.write out (unchecked-byte (bit-and x 0xff))) _) 293 | (write-uint16-le 294 | [_ x] 295 | (aset-byte buf 0 (unchecked-byte (bit-and x 0xff))) 296 | (aset-byte buf 1 (unchecked-byte (bit-and (unsigned-bit-shift-right x 8) 0xff))) 297 | (.write out buf 0 2) 298 | _) 299 | (write-uint16-be 300 | [_ x] 301 | (aset-byte buf 1 (unchecked-byte (bit-and x 0xff))) 302 | (aset-byte buf 0 (unchecked-byte (bit-and (unsigned-bit-shift-right x 8) 0xff))) 303 | (.write out buf 0 2) 304 | _) 305 | (write-uint32-le 306 | [_ x] 307 | (aset-byte buf 0 (unchecked-byte (bit-and x 0xff))) 308 | (aset-byte buf 1 (unchecked-byte (bit-and (unsigned-bit-shift-right x 8) 0xff))) 309 | (aset-byte buf 2 (unchecked-byte (bit-and (unsigned-bit-shift-right x 16) 0xff))) 310 | (aset-byte buf 3 (unchecked-byte (unsigned-bit-shift-right x 24))) 311 | (.write out buf 0 4) 312 | _) 313 | (write-uint32-be 314 | [_ x] 315 | (aset-byte buf 3 (unchecked-byte (bit-and x 0xff))) 316 | (aset-byte buf 2 (unchecked-byte (bit-and (unsigned-bit-shift-right x 8) 0xff))) 317 | (aset-byte buf 1 (unchecked-byte (bit-and (unsigned-bit-shift-right x 16) 0xff))) 318 | (aset-byte buf 0 (unchecked-byte (unsigned-bit-shift-right x 24))) 319 | (.write out buf 0 4) 320 | _) 321 | (write-float-le 322 | [_ x] 323 | (write-uint32-le _ (Float/floatToRawIntBits (float x)))) 324 | (write-float-be 325 | [_ x] 326 | (write-uint32-be _ (Float/floatToRawIntBits (float x)))) 327 | (write-double-le 328 | [_ x] 329 | (let [x (Double/doubleToRawLongBits (double x))] 330 | (write-uint32-le _ (unchecked-int (bit-and x 0xffffffff))) 331 | (write-uint32-le _ (unchecked-int (bit-and (unsigned-bit-shift-right x 32) 0xffffffff))) 332 | _)) 333 | (write-double-be 334 | [_ x] 335 | (let [x (Double/doubleToRawLongBits (double x))] 336 | (write-uint32-be _ (unchecked-int (bit-and (unsigned-bit-shift-right x 32) 0xffffffff))) 337 | (write-uint32-be _ (unchecked-int (bit-and x 0xffffffff))) 338 | _)) 339 | (write-vec2f-le 340 | [_ v] 341 | (write-float-le _ (first v)) 342 | (write-float-le _ (nth v 1)) 343 | _) 344 | (write-vec2f-be 345 | [_ v] 346 | (write-float-be _ (first v)) 347 | (write-float-be _ (nth v 1)) 348 | _) 349 | (write-vec3f-le 350 | [_ v] 351 | (write-float-le _ (first v)) 352 | (write-float-le _ (nth v 1)) 353 | (write-float-le _ (nth v 2)) 354 | _) 355 | (write-vec3f-be 356 | [_ v] 357 | (write-float-be _ (first v)) 358 | (write-float-be _ (nth v 1)) 359 | (write-float-be _ (nth v 2)) 360 | _) 361 | IStreamPosition 362 | (skip 363 | [_ x] (.write out (byte-array x)) _) 364 | (get-position 365 | [_] (throw (UnsupportedOperationException.)))) 366 | 367 | :cljs 368 | (deftype OutputStreamWrapper 369 | [^{:tag js/ArrayBuffer :mutable true} buf 370 | ^{:tag js/DataView :mutable true} dv 371 | ^:mutable pos] 372 | IOutputStream 373 | (write-utf8-bytes 374 | [_ str] 375 | (let [utf8 (utf8-str str) 376 | len (count utf8)] 377 | (ensure-size _ (count utf8)) 378 | (loop [i 0, p pos] 379 | (if (< i len) 380 | (do (.setUint8 dv p (.charCodeAt utf8 i)) 381 | (recur (inc i) (inc p))) 382 | (set! pos p)))) 383 | _) 384 | (write-uint8 385 | [_ x] 386 | (ensure-size _ 1) 387 | (.setUint8 dv pos x) 388 | (set! pos (inc pos)) 389 | _) 390 | (write-uint16-le 391 | [_ x] 392 | (ensure-size _ 2) 393 | (.setUint16 dv pos x true) 394 | (set! pos (+ pos 2)) 395 | _) 396 | (write-uint16-be 397 | [_ x] 398 | (ensure-size _ 2) 399 | (.setUint16 dv pos x) 400 | (set! pos (+ pos 2)) 401 | _) 402 | (write-uint32-le 403 | [_ x] 404 | (ensure-size _ 4) 405 | (.setUint32 dv pos x true) 406 | (set! pos (+ pos 4)) 407 | _) 408 | (write-uint32-be 409 | [_ x] 410 | (ensure-size _ 4) 411 | (.setUint32 dv pos x) 412 | (set! pos (+ pos 4)) 413 | _) 414 | (write-float-le 415 | [_ x] 416 | (ensure-size _ 4) 417 | (.setFloat32 dv pos x true) 418 | (set! pos (+ pos 4)) 419 | _) 420 | (write-float-be 421 | [_ x] 422 | (ensure-size _ 4) 423 | (.setFloat32 dv pos x) 424 | (set! pos (+ pos 4)) 425 | _) 426 | (write-double-le 427 | [_ x] 428 | (ensure-size _ 8) 429 | (.setFloat64 dv pos x true) 430 | (set! pos (+ pos 8)) 431 | _) 432 | (write-double-be 433 | [_ x] 434 | (ensure-size _ 8) 435 | (.setFloat64 dv pos x) 436 | (set! pos (+ pos 8)) 437 | _) 438 | (write-vec2f-le 439 | [_ v] 440 | (ensure-size _ 8) 441 | (.setFloat32 dv pos (first v) true) 442 | (.setFloat32 dv (+ pos 4) (nth v 1) true) 443 | (set! pos (+ pos 8)) 444 | _) 445 | (write-vec2f-be 446 | [_ v] 447 | (ensure-size _ 8) 448 | (.setFloat32 dv pos (first v)) 449 | (.setFloat32 dv (+ pos 4) (nth v 1)) 450 | (set! pos (+ pos 8)) 451 | _) 452 | (write-vec3f-le 453 | [_ v] 454 | (ensure-size _ 12) 455 | (.setFloat32 dv pos (first v) true) 456 | (.setFloat32 dv (+ pos 4) (nth v 1) true) 457 | (.setFloat32 dv (+ pos 8) (nth v 2) true) 458 | (set! pos (+ pos 12)) 459 | _) 460 | (write-vec3f-be 461 | [_ v] 462 | (ensure-size _ 12) 463 | (.setFloat32 dv pos (first v)) 464 | (.setFloat32 dv (+ pos 4) (nth v 1)) 465 | (.setFloat32 dv (+ pos 8) (nth v 2)) 466 | (set! pos (+ pos 12)) 467 | _) 468 | IStreamPosition 469 | (skip 470 | [_ x] (ensure-size _ x) (set! pos (+ pos x)) _) 471 | (get-position 472 | [_] pos) 473 | IBuffer 474 | (get-byte-buffer 475 | [_] (js/Uint8Array. buf 0 pos)) 476 | (get-float-buffer 477 | [_] (js/Float32Array. buf 0 (unsigned-bit-shift-right pos 2))) 478 | (get-double-buffer 479 | [_] (js/Float64Array. buf 0 (unsigned-bit-shift-right pos 3))) 480 | (get-short-buffer 481 | [_] (js/Uint16Array. buf 0 (unsigned-bit-shift-right pos 1))) 482 | (get-int-buffer 483 | [_] (js/Uint32Array. buf 0 (unsigned-bit-shift-right pos 2))))) 484 | #+END_SRC 485 | 486 | *** Constructor 487 | 488 | #+BEGIN_SRC clojure :noweb-ref ctors 489 | #?(:clj 490 | (defn output-stream 491 | [^OutputStream out] 492 | (OutputStreamWrapper. out (byte-array 12))) 493 | :cljs 494 | (defn output-stream 495 | ([] 496 | (output-stream 0x1000)) 497 | ([size] 498 | (output-stream (js/ArrayBuffer. size) 0)) 499 | ([^js/ArrayBuffer buf pos] 500 | (OutputStreamWrapper. buf (js/DataView. buf) pos)))) 501 | #+END_SRC 502 | 503 | ** Data URL conversion 504 | 505 | #+BEGIN_SRC clojure :noweb-ref dataurl 506 | #?(:cljs 507 | (defn as-data-url 508 | "Takes an input or outputstream and optional mime type, returns 509 | contents as data url wrapped in a volatile. The volatile's value is 510 | initially nil and will only become realized after the function 511 | returned." 512 | ([stream] 513 | (as-data-url stream "application/octet-stream")) 514 | ([stream mime] 515 | (let [fr (js/FileReader.) 516 | uri (volatile! nil)] 517 | (set! (.-onload fr) (fn [e] (vreset! uri (-> e .-target .-result)))) 518 | (.readAsDataURL fr (js/Blob. #js [(get-byte-buffer stream)] #js {"type" mime})) 519 | uri)))) 520 | 521 | #?(:cljs 522 | (defn as-data-url-async 523 | "Takes an input or outputstream, callback fn and optional mime 524 | type, calls fn with data url string, returns nil." 525 | ([stream cb] 526 | (as-data-url-async stream cb "application/octet-stream")) 527 | ([stream cb mime] 528 | (let [fr (js/FileReader.)] 529 | (set! (.-onload fr) #(cb (-> % .-target .-result))) 530 | (.readAsDataURL fr (js/Blob. #js [(get-byte-buffer stream)] #js {"type" mime})) 531 | nil)))) 532 | #+END_SRC 533 | 534 | ** Helpers 535 | 536 | #+BEGIN_SRC clojure :noweb-ref helpers 537 | #?(:clj (defn int->byte [x] (if (> x 0x7f) (- x 0x100) x))) 538 | #?(:clj (defn byte->int [x] (if (neg? x) (+ x 0x100) x))) 539 | 540 | ;; http://stackoverflow.com/a/18729536/294515 541 | #?(:cljs (defn utf8-str [str] (-> str js/encodeURIComponent js/unescape))) 542 | #+END_SRC 543 | 544 | #+BEGIN_SRC clojure :noweb-ref cljs-helpers 545 | #?(:cljs 546 | (defn ^:private ensure-readable 547 | [^InputStreamWrapper in size] 548 | (if (> (+ (.-pos in) size) (.-byteLength (.-buf in))) 549 | (throw 550 | (js/Error. 551 | (str "EOF overrun, current pos: " (.-pos in) 552 | ", requested read length: " size 553 | ", but length: " (.-byteLength (.-buf in)))))))) 554 | 555 | #?(:cljs 556 | (defn ^:private ensure-size 557 | [^OutputStreamWrapper out size] 558 | (let [len (.-byteLength (.-buf out))] 559 | (if (> (+ (.-pos out) size) len) 560 | (let [buf' (js/ArrayBuffer. (+ len 0x4000))] 561 | (.set (js/Uint8Array. buf') (js/Uint8Array. (.-buf out) 0 (.-pos out))) 562 | (set! (.-buf out) buf') 563 | (set! (.-dv out) (js/DataView. buf'))))))) 564 | #+END_SRC 565 | 566 | ** Complete namespace definition 567 | 568 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/streams.cljc :noweb yes :mkdirp yes :padline no 569 | (ns thi.ng.dstruct.streams 570 | (:require 571 | [thi.ng.xerror.core :as err]) 572 | #?(:clj 573 | (:import 574 | [java.io OutputStream InputStream]))) 575 | 576 | (declare ensure-readable ensure-size) 577 | 578 | <> 579 | 580 | <> 581 | 582 | <> 583 | 584 | <> 585 | 586 | <> 587 | 588 | <> 589 | 590 | <> 591 | #+END_SRC 592 | -------------------------------------------------------------------------------- /src/unionfind.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#namespace-thingdstructunionfind][Namespace: thi.ng.dstruct.unionfind]] 5 | - [[#protocol-definition][Protocol definition]] 6 | - [[#disjoint-set][Disjoint Set]] 7 | - [[#complete-namespace-definition][Complete namespace definition]] 8 | 9 | * Namespace: thi.ng.dstruct.unionfind 10 | 11 | ** Protocol definition 12 | 13 | #+BEGIN_SRC clojure :noweb-ref protos 14 | (defprotocol PUnionFind 15 | (register [_ p]) 16 | (unregister [_ p]) 17 | (canonical [_ p]) 18 | (canonical? [_ p]) 19 | (set-canonical [_ p q]) 20 | (disjoint-components [_]) 21 | (component [_ p]) 22 | (union [_ [p q]] [_ p q]) 23 | (unified? [_ p q])) 24 | #+END_SRC 25 | 26 | ** Disjoint Set 27 | 28 | #+BEGIN_SRC clojure :noweb-ref disj-set 29 | (deftype DisjointSet [index components] 30 | PUnionFind 31 | (canonical [_ p] 32 | (if (get components p) p (get index p))) 33 | (canonical? [_ p] (get components p)) 34 | (set-canonical 35 | [_ p q] 36 | (let [canon (canonical _ p) 37 | comp (get components canon)] 38 | (if (comp q) 39 | (DisjointSet. 40 | (reduce #(assoc %1 %2 q) (dissoc index q) (disj comp q)) 41 | (-> components (dissoc canon) (assoc q comp))) 42 | (throw 43 | (new #?(:clj IllegalArgumentException :cljs js/Error) 44 | (str p " not unified with " q)))))) 45 | (unified? [_ p q] 46 | (= (get index p p) (get index q q))) 47 | (component [_ p] 48 | (get components (canonical _ p))) 49 | (disjoint-components [_] 50 | (vals components)) 51 | (register 52 | [_ p] 53 | (if (canonical _ p) _ 54 | (DisjointSet. (assoc index p p) (assoc components p #{p})))) 55 | (unregister [_ p] 56 | (if (canonical _ p) 57 | (if-let [comp (get components p)] 58 | (let [comp (disj comp p)] 59 | (if-let [q (first comp)] 60 | (DisjointSet. 61 | (reduce #(assoc % %2 q) (dissoc index p q) (disj comp q)) 62 | (-> components (dissoc p) (assoc q comp))) 63 | (DisjointSet. (dissoc index p) (dissoc components p)))) 64 | (DisjointSet. (dissoc index p) (update components (get index p) disj p))) 65 | _)) 66 | (union [_ p q] 67 | (let [canonp (get index p p) 68 | canonq (get index q q)] 69 | (if (= canonp canonq) _ 70 | (let [compp (or (get components canonp) #{canonp}) 71 | compq (or (get components canonq) #{canonq}) 72 | [canonp canonq compp compq] (if (<= (count compp) (count compq)) 73 | [canonp canonq compp compq] 74 | [canonq canonp compq compp])] 75 | (DisjointSet. 76 | (loop [idx (transient index), i compp] 77 | (if i 78 | (recur (conj! idx [(first i) canonq]) (next i)) 79 | (persistent! idx))) 80 | (-> components 81 | (dissoc canonp) 82 | (assoc canonq (into compq compp)))))))) 83 | Object 84 | (toString [_] (pr-str {:index index :components components}))) 85 | 86 | (defn disjoint-set 87 | ([] (DisjointSet. {} {})) 88 | ([xs] (reduce #(apply union % %2) (DisjointSet. {} {}) xs))) 89 | #+END_SRC 90 | 91 | ** Complete namespace definition 92 | 93 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/dstruct/unionfind.cljc :noweb yes :mkdirp yes :padline no 94 | (ns thi.ng.dstruct.unionfind) 95 | 96 | <> 97 | 98 | <> 99 | #+END_SRC 100 | -------------------------------------------------------------------------------- /tangle-all.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | FILES="README.org" 4 | 5 | SRC="README.org src/*.org test/*.org" 6 | rm -rf babel/src babel/test 7 | for f in `ls $SRC`; do 8 | FILES="$FILES $f" 9 | done 10 | 11 | ./tangle.sh $FILES 12 | -------------------------------------------------------------------------------- /tangle.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | DIR=`pwd` 4 | FILES="" 5 | 6 | # wrap each argument in the code required to call tangle on it 7 | for i in $@; do 8 | FILES="$FILES \"$i\"" 9 | done 10 | 11 | emacs -Q --batch \ 12 | --eval \ 13 | "(progn 14 | (require 'org)(require 'ob)(require 'ob-tangle)(require 'ob-lob) 15 | (org-babel-lob-ingest \"src/library-of-babel.org\") 16 | (org-babel-lob-ingest \"src/config.org\") 17 | (setq org-confirm-babel-evaluate nil) 18 | (mapc (lambda (file) 19 | (find-file (expand-file-name file \"$DIR\")) 20 | (org-babel-tangle) 21 | (kill-buffer)) '($FILES)))" \ 22 | #2>&1 | grep Tangled 23 | -------------------------------------------------------------------------------- /test/core.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: ../src/setup.org 2 | 3 | * Contents :toc_4_gh: 4 | - [[#thingdstructtestcore][thi.ng.dstruct.test.core]] 5 | - [[#main-tests][Main tests]] 6 | - [[#complete-namespace-definition][Complete namespace definition]] 7 | 8 | * thi.ng.dstruct.test.core 9 | 10 | ** Main tests 11 | 12 | #+BEGIN_SRC clojure :noweb-ref test 13 | (deftest test-it 14 | (is true)) 15 | #+END_SRC 16 | 17 | ** Complete namespace definition 18 | 19 | #+BEGIN_SRC clojure :tangle ../babel/test/thi/ng/dstruct/test/core.cljc :noweb yes :mkdirp yes :padline no 20 | (ns thi.ng.dstruct.test.core 21 | (:require 22 | [thi.ng.dstruct.core :as d] 23 | [thi.ng.dstruct.intervaltree :as i] 24 | [thi.ng.dstruct.unionfind :as u] 25 | [thi.ng.dstruct.streams :as str] 26 | #?@(:clj 27 | [[thi.ng.dstruct.heap :as h] 28 | [clojure.test :refer :all]] 29 | :cljs 30 | [[cemerick.cljs.test :refer-macros [is deftest]]]))) 31 | 32 | <> 33 | #+END_SRC 34 | --------------------------------------------------------------------------------