├── .gitignore ├── .travis.yml ├── README.md ├── bb.edn ├── bin └── kaocha ├── build.clj ├── deps.edn ├── dev └── user.clj ├── package.json ├── src └── net │ └── cgrand │ ├── xforms.cljc │ └── xforms │ ├── io.clj │ ├── nodejs │ └── stream.cljs │ └── rfs.cljc ├── test └── net │ └── cgrand │ └── xforms_test.cljc └── tests.edn /.gitignore: -------------------------------------------------------------------------------- 1 | # Created by https://www.toptal.com/developers/gitignore/api/clojure 2 | # Edit at https://www.toptal.com/developers/gitignore?templates=clojure 3 | 4 | ### Clojure ### 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /lib/ 10 | /classes/ 11 | /bin/ 12 | /node_modules/ 13 | /.lumo_cache/ 14 | /target/ 15 | /checkouts/ 16 | .lein-deps-sum 17 | .lein-repl-history 18 | .lein-plugins/ 19 | .lein-failures 20 | .nrepl-port 21 | .cpcache/ 22 | .clj-kondo/*/ 23 | /cljs-test-runner-out/ 24 | 25 | # End of https://www.toptal.com/developers/gitignore/api/clojure 26 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein 3 | script: lein test 4 | jdk: 5 | - openjdk6 6 | - openjdk7 7 | - oraclejdk7 8 | - oraclejdk8 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # xforms 2 | 3 | More transducers and reducing functions for Clojure(script)! 4 | 5 | *Transducers* can be classified in three groups: regular ones, higher-order ones 6 | (which accept other transducers as arguments) and aggregators (transducers which emit only 1 item out no matter how many went in). 7 | Aggregators generally only make sense in the context of a higher-order transducer. 8 | 9 | In `net.cgrand.xforms`: 10 | 11 | * regular ones: `partition` (1 arg), `reductions`, `for`, `take-last`, `drop-last`, `sort`, `sort-by`, `wrap`, `window` and `window-by-time` 12 | * higher-order ones: `by-key`, `into-by-key`, `multiplex`, `transjuxt`, `partition` (2+ args), `time` 13 | * aggregators: `reduce`, `into`, `without`, `transjuxt`, `last`, `count`, `avg`, `sd`, `min`, `minimum`, `max`, `maximum`, `str` 14 | 15 | In `net.cgrand.xforms.io`: 16 | * `sh` to use any process as a reducible collection (of stdout lines) or as a transducers (input as stdin lines, stdout lines as output). 17 | 18 | 19 | *Reducing functions* 20 | 21 | * in `net.cgrand.xforms.rfs`: `min`, `minimum`, `max`, `maximum`, `str`, `str!`, `avg`, `sd`, `last` and `some`. 22 | * in `net.cgrand.xforms.io`: `line-out` and `edn-out`. 23 | 24 | (in `net.cgrand.xforms`) 25 | 26 | *Transducing contexts*: 27 | 28 | * in `net.cgrand.xforms`: `transjuxt` (for performing several transductions in a single pass), `iterator` (clojure only), `into`, `without`, `count`, `str` (2 args) and `some`. 29 | * in `net.cgrand.xforms.io`: `line-out` (3+ args) and `edn-out` (3+ args). 30 | * in `net.cgrand.xforms.nodejs.stream`: `transformer`. 31 | 32 | *Reducible views* (in `net.cgrand.xforms.io`): `lines-in` and `edn-in`. 33 | 34 | **Note:** it should always be safe to update to the latest xforms version; short of bugfixes, breaking changes are avoided. 35 | 36 | ## Add as a dependency 37 | 38 | For specific coordinates see the [Releases](https://github.com/cgrand/xforms/releases) page. 39 | 40 | ## Usage 41 | 42 | ```clj 43 | => (require '[net.cgrand.xforms :as x]) 44 | ``` 45 | 46 | `str` and `str!` are two reducing functions to build Strings and StringBuilders in linear time. 47 | 48 | ```clj 49 | => (quick-bench (reduce str (range 256))) 50 | Execution time mean : 58,714946 µs 51 | => (quick-bench (reduce rf/str (range 256))) 52 | Execution time mean : 11,609631 µs 53 | ``` 54 | 55 | `for` is the transducing cousin of `clojure.core/for`: 56 | 57 | ```clj 58 | => (quick-bench (reduce + (for [i (range 128) j (range i)] (* i j)))) 59 | Execution time mean : 514,932029 µs 60 | => (quick-bench (transduce (x/for [i % j (range i)] (* i j)) + 0 (range 128))) 61 | Execution time mean : 373,814060 µs 62 | ``` 63 | 64 | You can also use `for` like `clojure.core/for`: `(x/for [i (range 128) j (range i)] (* i j))` expands to `(eduction (x/for [i % j (range i)] (* i j)) (range 128))`. 65 | 66 | `by-key` and `reduce` are two new transducers. Here is an example usage: 67 | 68 | ```clj 69 | ;; reimplementing group-by 70 | (defn my-group-by [kfn coll] 71 | (into {} (x/by-key kfn (x/reduce conj)) coll)) 72 | 73 | ;; let's go transient! 74 | (defn my-group-by [kfn coll] 75 | (into {} (x/by-key kfn (x/into [])) coll)) 76 | 77 | => (quick-bench (group-by odd? (range 256))) 78 | Execution time mean : 29,356531 µs 79 | => (quick-bench (my-group-by odd? (range 256))) 80 | Execution time mean : 20,604297 µs 81 | ``` 82 | 83 | Like `by-key`, `partition` also takes a transducer as last argument to allow further computation on the partition. 84 | 85 | ```clj 86 | => (sequence (x/partition 4 (x/reduce +)) (range 16)) 87 | (6 22 38 54) 88 | ``` 89 | 90 | Padding is achieved as usual: 91 | 92 | ```clj 93 | => (sequence (x/partition 4 4 (repeat :pad) (x/into [])) (range 9)) 94 | ([0 1 2 3] [4 5 6 7] [8 :pad :pad :pad]) 95 | ``` 96 | 97 | 98 | `avg` is a transducer to compute the arithmetic mean. `transjuxt` is used to perform several transductions at once. 99 | 100 | ```clj 101 | => (into {} (x/by-key odd? (x/transjuxt [(x/reduce +) x/avg])) (range 256)) 102 | {false [16256 127], true [16384 128]} 103 | => (into {} (x/by-key odd? (x/transjuxt {:sum (x/reduce +) :mean x/avg :count x/count})) (range 256)) 104 | {false {:sum 16256, :mean 127, :count 128}, true {:sum 16384, :mean 128, :count 128}} 105 | ``` 106 | 107 | `window` is a new transducer to efficiently compute a windowed accumulator: 108 | 109 | ```clj 110 | ;; sum of last 3 items 111 | => (sequence (x/window 3 + -) (range 16)) 112 | (0 1 3 6 9 12 15 18 21 24 27 30 33 36 39 42) 113 | 114 | => (def nums (repeatedly 8 #(rand-int 42))) 115 | #'user/nums 116 | => nums 117 | (11 8 32 26 6 10 37 24) 118 | 119 | ;; avg of last 4 items 120 | => (sequence 121 | (x/window 4 rf/avg #(rf/avg %1 %2 -1)) 122 | nums) 123 | (11 19/2 17 77/4 18 37/2 79/4 77/4) 124 | 125 | ;; min of last 3 items 126 | => (sequence 127 | (x/window 3 128 | (fn 129 | ([] (sorted-map)) 130 | ([m] (key (first m))) 131 | ([m x] (update m x (fnil inc 0)))) 132 | (fn [m x] 133 | (let [n (dec (m x))] 134 | (if (zero? n) 135 | (dissoc m x) 136 | (assoc m x (dec n)))))) 137 | nums) 138 | (11 8 8 8 6 6 6 10) 139 | ``` 140 | 141 | ## On Partitioning 142 | 143 | Both `by-key` and `partition` takes a transducer as parameter. This transducer is used to further process each partition. 144 | 145 | It's worth noting that all transformed outputs are subsequently interleaved. See: 146 | 147 | ```clj 148 | => (sequence (x/partition 2 1 identity) (range 8)) 149 | (0 1 1 2 2 3 3 4 4 5 5 6 6 7) 150 | => (sequence (x/by-key odd? identity) (range 8)) 151 | ([false 0] [true 1] [false 2] [true 3] [false 4] [true 5] [false 6] [true 7]) 152 | ``` 153 | 154 | That's why most of the time the last stage of the sub-transducer will be an aggregator like `x/reduce` or `x/into`: 155 | 156 | ```clj 157 | => (sequence (x/partition 2 1 (x/into [])) (range 8)) 158 | ([0 1] [1 2] [2 3] [3 4] [4 5] [5 6] [6 7]) 159 | => (sequence (x/by-key odd? (x/into [])) (range 8)) 160 | ([false [0 2 4 6]] [true [1 3 5 7]]) 161 | ``` 162 | 163 | ## Simple examples 164 | 165 | `(group-by kf coll)` is `(into {} (x/by-key kf (x/into []) coll))`. 166 | 167 | `(plumbing/map-vals f m)` is `(into {} (x/by-key (map f)) m)`. 168 | 169 | My faithful `(reduce-by kf f init coll)` is now `(into {} (x/by-key kf (x/reduce f init)))`. 170 | 171 | `(frequencies coll)` is `(into {} (x/by-key identity x/count) coll)`. 172 | 173 | ## On key-value pairs 174 | 175 | Clojure `reduce-kv` is able to reduce key value pairs without allocating vectors or map entries: the key and value 176 | are passed as second and third arguments of the reducing function. 177 | 178 | Xforms allows a reducing function to advertise its support for key value pairs (3-arg arity) by implementing the `KvRfable` protocol (in practice using the `kvrf` macro). 179 | 180 | Several xforms transducers and transducing contexts leverage `reduce-kv` and `kvrf`. When these functions are used together, pairs can be transformed without being allocated. 181 | 182 | 183 | 184 | 186 | 187 | 194 |
fnkvs in?kvs out? 185 |
`for`when first binding is a pairwhen `body-expr` is a pair 188 |
`reduce`when is `f` is a kvrfno 189 |
1-arg `into`
(transducer)		when `to` is a mapno 190 |
3-arg `into`
(transducing context)		when `from` is a mapwhen `to` is a map 191 |
`by-key`
(as a transducer)		when is `kfn` and `vfn` are unspecified or `nil`when `pair` is `vector` or unspecified 192 |
`by-key`
(as a transducing context on values)		nono 193 |
195 | 196 | ```clj 197 | ;; plain old sequences 198 | => (let [m (zipmap (range 1e5) (range 1e5))] 199 | (crit/quick-bench 200 | (into {} 201 | (for [[k v] m] 202 | [k (inc v)])))) 203 | Evaluation count : 12 in 6 samples of 2 calls. 204 | Execution time mean : 55,150081 ms 205 | Execution time std-deviation : 1,397185 ms 206 | 207 | ;; x/for but pairs are allocated (because of into) 208 | => (let [m (zipmap (range 1e5) (range 1e5))] 209 | (crit/quick-bench 210 | (into {} 211 | (x/for [[k v] _] 212 | [k (inc v)]) 213 | m))) 214 | Evaluation count : 18 in 6 samples of 3 calls. 215 | Execution time mean : 39,119387 ms 216 | Execution time std-deviation : 1,456902 ms 217 | 218 | ;; x/for but no pairs are allocated (thanks to x/into) 219 | => (let [m (zipmap (range 1e5) (range 1e5))] 220 | (crit/quick-bench (x/into {} 221 | (x/for [[k v] %] 222 | [k (inc v)]) 223 | m))) 224 | Evaluation count : 24 in 6 samples of 4 calls. 225 | Execution time mean : 24,276790 ms 226 | Execution time std-deviation : 364,932996 µs 227 | ``` 228 | 229 | ## Changelog 230 | 231 | ### 0.19.6 232 | 233 | * Fix regression in 0.19.5 #54 234 | 235 | ### 0.19.5 236 | 237 | * Support ClojureDart 238 | 239 | ### 0.19.4 240 | 241 | * Fix ClojureScript compilation broken in `0.19.3` #49 242 | * Fix `x/sort` and `x/sort-by` for ClojureScript #40 243 | 244 | ### 0.19.3 245 | 246 | * Add `deps.edn` to enable usage as a [git library](https://clojure.org/guides/deps_and_cli#_using_git_libraries) 247 | * Bump `macrovich` to make Clojure and ClojureScript provided dependencies #34 248 | * Fix reflection warnings in `xforms.io` #35 #36 249 | * Add compatibility with [babashka](https://github.com/babashka/babashka) #42 250 | * Fix `x/destructuring-pair?` #44 #45 251 | * Fix `x/into` performance hit with small maps #46 #47 252 | * Fix reflection and shadowing warnings in tests 253 | 254 | ### 0.19.2 255 | 256 | * Fix infinity symbol causing issues with ClojureScript #31 257 | 258 | ### 0.19.0 259 | 260 | `time` allows to measure time spent in one transducer (excluding time spent downstream). 261 | 262 | ```clj 263 | => (time ; good old Clojure time 264 | (count (into [] (comp 265 | (x/time "mapinc" (map inc)) 266 | (x/time "filterodd" (filter odd?))) (range 1e6)))) 267 | filterodd: 61.771738 msecs 268 | mapinc: 143.895317 msecs 269 | "Elapsed time: 438.34291 msecs" 270 | 500000 271 | ``` 272 | 273 | First argument can be a function that gets passed the time (in ms), 274 | this allows for example to log time instead of printing it. 275 | 276 | ### 0.9.5 277 | 278 | * Short (up to 4) literal collections (or literal collections with `:unroll` metadata) in collection positions in `x/for` are unrolled. 279 | This means that the collection is not allocated. 280 | If it's a collection of pairs (e.g. maps), pairs themselves won't be allocated. 281 | 282 | ### 0.9.4 283 | 284 | * Add `x/into-by-key` short hand 285 | 286 | ### 0.7.2 287 | 288 | * Fix transients perf issue in Clojurescript 289 | 290 | ### 0.7.1 291 | 292 | * Works with Clojurescript (even self-hosted). 293 | 294 | ### 0.7.0 295 | 296 | * Added 2-arg arity to `x/count` where it acts as a transducing context e.g. `(x/count (filter odd?) (range 10))` 297 | * Preserve type hints in `x/for` (and generally with `kvrf`). 298 | 299 | ### 0.6.0 300 | 301 | * Added `x/reductions` 302 | * Now if the first collection expression in `x/for` is not a placeholder then `x/for` works like `x/for` but returns an eduction and performs all iterations using reduce. 303 | 304 | ## Troubleshooting xforms in a Clojurescript dev environment 305 | 306 | If you use xforms with Clojurescript and the Emacs editor to start your figwheel REPL be sure to include the `cider.nrepl/cider-middleware` to your figwheel's nrepl-middleware. 307 | ``` 308 | :figwheel {... 309 | :nrepl-middleware [cider.nrepl/cider-middleware;;<= that middleware 310 | refactor-nrepl.middleware/wrap-refactor 311 | cemerick.piggieback/wrap-cljs-repl] 312 | ...} 313 | ``` 314 | Otherwise a strange interaction occurs and every results from your REPL evaluation would be returned as a String. Eg.: 315 | ``` 316 | cljs.user> 1 317 | "1" 318 | cljs.user> 319 | ``` 320 | instead of: 321 | ``` 322 | cljs.user> 1 323 | 1 324 | cljs.user> 325 | ``` 326 | 327 | 328 | ## License 329 | 330 | Copyright © 2015-2016 Christophe Grand 331 | 332 | Distributed under the Eclipse Public License either version 1.0 or (at 333 | your option) any later version. 334 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:deps {local/deps {:local/root "."}} 2 | :paths ["src" "test"] 3 | 4 | :tasks 5 | {:requires ([clojure.string :as str]) 6 | 7 | :init 8 | (do 9 | (defn kaocha [alias args] 10 | (apply shell "bin/kaocha" alias args)) 11 | 12 | (defn test-cljs [alias args] 13 | (apply clojure (str/join ["-M:test:cljs-test-runner" alias]) args))) 14 | 15 | test-clj-9 16 | {:task (kaocha :clj-1-9 *command-line-args*)} 17 | 18 | test-clj-10 19 | {:task (kaocha :clj-1-10 *command-line-args*)} 20 | 21 | test-clj-11 22 | {:task (kaocha :clj-1-11 *command-line-args*)} 23 | 24 | test-clj 25 | {:depends [test-clj-9 test-clj-10 test-clj-11]} 26 | 27 | test-cljs-9 28 | {:task (test-cljs :clj-1-9 *command-line-args*)} 29 | 30 | test-cljs-10 31 | {:task (test-cljs :clj-1-10 *command-line-args*)} 32 | 33 | test-cljs-11 34 | {:task (test-cljs :clj-1-11 *command-line-args*)} 35 | 36 | test-cljs 37 | {:depends [#_test-cljs-9 test-cljs-10 test-cljs-11]} 38 | 39 | test-bb 40 | {:requires ([clojure.test :as t] 41 | [net.cgrand.xforms-test]) 42 | :task (t/run-tests 'net.cgrand.xforms-test)} 43 | 44 | test-all 45 | {:depends [test-bb test-clj test-cljs]} 46 | 47 | perf-bb 48 | {:requires ([net.cgrand.xforms :as x]) 49 | :task 50 | (let [n 10000 51 | m (zipmap (range 100) (range)) 52 | mapping (map (fn [[k v]] [k (inc v)])) 53 | xforing (x/for [[k v] _] [k (inc v)])] 54 | (time (dotimes [_ n] (into {} mapping m))) 55 | (time (dotimes [_ n] (into {} xforing m))) 56 | (time (dotimes [_ n] (x/into {} xforing m))))}}} 57 | -------------------------------------------------------------------------------- /bin/kaocha: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -x 3 | clojure -Srepro -M:kaocha:test"$1" "${@:2}" 4 | -------------------------------------------------------------------------------- /build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [clojure.tools.build.api :as b] 3 | [clojure.java.shell :as sh])) 4 | 5 | (def lib 'net.cgrand/xforms) 6 | (def version "0.19.6" #_(format "0.0.%s" (b/git-count-revs nil))) 7 | (def class-dir "target/classes") 8 | (def basis (b/create-basis {:project "deps.edn"})) 9 | (def jar-file (format "target/%s-%s.jar" (name lib) version)) 10 | (def scm {:connection "scm:git:git://github.com/cgrand/xforms.git" 11 | :developerConnection "scm:git:git://github.com/cgrand/xforms.git" 12 | :url "https://github.com/cgrand/xforms"}) 13 | (def extra-pom-data 14 | [[:licenses 15 | [:license 16 | [:name "Eclipse Public License 1.0"] 17 | [:url "https://opensource.org/license/epl-1-0/"] 18 | [:distribution "repo"]] 19 | [:license 20 | [:name "Eclipse Public License 2.0"] 21 | [:url "https://opensource.org/license/epl-2-0/"] 22 | [:distribution "repo"]]]]) 23 | 24 | (defn clean [_] 25 | (b/delete {:path "target"})) 26 | 27 | (defn jar [_] 28 | (b/write-pom {:class-dir class-dir 29 | :lib lib 30 | :version version 31 | :basis basis 32 | :src-dirs ["src"] 33 | :scm (assoc scm :tag (str "v" version)) 34 | :pom-data extra-pom-data}) 35 | (b/copy-dir {:src-dirs ["src" "resources"] 36 | :target-dir class-dir}) 37 | (b/jar {:class-dir class-dir 38 | :jar-file jar-file})) 39 | 40 | (defn clojars [_] 41 | (sh/sh 42 | "mvn" "deploy:deploy-file" (str "-Dfile=" jar-file) 43 | ;target/classes/META-INF/maven/net.cgrand/xforms/pom.xml 44 | (format "-DpomFile=%s/META-INF/maven/%s/%s/pom.xml" 45 | class-dir (namespace lib) (name lib)) 46 | "-DrepositoryId=clojars" "-Durl=https://clojars.org/repo/")) 47 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {net.cgrand/macrovich {:mvn/version "0.2.2"}} 2 | :paths ["src"] 3 | 4 | :aliases 5 | {:dev 6 | {:extra-paths ["dev"]} 7 | 8 | :cljd 9 | {:extra-deps 10 | {tensegritics/clojuredart 11 | {:git/url "https://github.com/tensegritics/ClojureDart.git" 12 | :sha "ae1b485e84ccc35b122f776dfc7cc62198274701"}}} 13 | 14 | :clj-1-9 15 | {:extra-deps 16 | {org.clojure/clojure {:mvn/version "1.9.0"} 17 | org.clojure/clojurescript {:mvn/version "1.9.293"}}} 18 | 19 | :clj-1-10 20 | {:extra-deps 21 | {org.clojure/clojure {:mvn/version "1.10.3"} 22 | org.clojure/clojurescript {:mvn/version "1.10.914"}}} 23 | 24 | :clj-1-11 25 | {:extra-deps 26 | {org.clojure/clojure {:mvn/version "1.11.1"} 27 | org.clojure/clojurescript {:mvn/version "1.11.60"}}} 28 | 29 | :test 30 | {:extra-paths ["test"]} 31 | 32 | :kaocha 33 | {:extra-paths ["test"] 34 | :extra-deps {lambdaisland/kaocha {:mvn/version "1.69.1069"}} 35 | :main-opts ["-m" "kaocha.runner"]} 36 | 37 | :cljs-test-runner 38 | {:extra-paths ["test"] 39 | :extra-deps {olical/cljs-test-runner {:mvn/version "3.8.0"}} 40 | :main-opts ["-m" "cljs-test-runner.main"]} 41 | 42 | :build 43 | {:paths ["."] 44 | :deps {io.github.clojure/tools.build {:git/tag "v0.9.6" :git/sha "8e78bcc"}} 45 | :ns-default build}}} 46 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user) 2 | 3 | (set! *warn-on-reflection* true) 4 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "xforms", 3 | "version": "0.16.0", 4 | "description": "Extra transducers for Clojurescript", 5 | "repository": "https://github.com/cgrand/xforms.git", 6 | "author": "Christophe Grand ", 7 | "license": "EPL-1.0", 8 | "directories": { 9 | "lib": "src", 10 | "cache": "./lumo-cache" 11 | }, 12 | "keywords": [ 13 | "cljs", 14 | "cljc", 15 | "self-host", 16 | "transducer" 17 | ], 18 | "dependencies": { 19 | "macrovich": "^0.2.1-SNAPSHOT" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /src/net/cgrand/xforms.cljc: -------------------------------------------------------------------------------- 1 | (ns net.cgrand.xforms 2 | "Extra transducers for Clojure" 3 | {:author "Christophe Grand"} 4 | #?(:cljs (:require-macros 5 | [net.cgrand.macrovich :as macros] 6 | [net.cgrand.xforms :refer [for kvrf let-complete]]) 7 | :default (:require [net.cgrand.macrovich :as macros])) 8 | (:refer-clojure :exclude [some reduce reductions into count for partition 9 | str last keys vals min max drop-last take-last 10 | sort sort-by time #?@(:bb [] :cljd/clj-host [] :clj [satisfies?])]) 11 | (:require [#?(:cljd cljd.core :clj clojure.core :cljs cljs.core) :as core] 12 | [net.cgrand.xforms.rfs :as rf] 13 | #?@(:cljd [["dart:collection" :as dart:coll]] :clj [[clojure.core.protocols]] :cljs [])) 14 | #?(:cljd/clj-host 15 | ; customize the clj/jvm ns used for macroexpansion 16 | (:host-ns (:require [clojure.core :as core] 17 | [net.cgrand.macrovich :as macros]))) 18 | #?(:cljs (:import [goog.structs Queue]))) 19 | 20 | (defn- ^:macro-support pair? [x] (and (vector? x) (= 2 (core/count x)))) 21 | (def ^:macro-support destructuring-pair? 22 | (let [kw-or-& #(or (keyword? %) (= '& %))] 23 | (fn [x] 24 | (and (pair? x) 25 | (not (kw-or-& (first x))))))) 26 | 27 | 28 | 29 | (macros/deftime 30 | 31 | (defn- ^:macro-support no-user-meta? [x] 32 | (= {} (dissoc (or (meta x) {}) :file :line :column :end-line :end-column))) 33 | 34 | (defmacro unreduced-> 35 | "Thread first while threaded value is not reduced. 36 | Doesn't unreduce the final value." 37 | ([x] x) 38 | ([x expr & exprs] 39 | `(let [x# ~x] 40 | (if (reduced? x#) 41 | x# 42 | (unreduced-> (-> x# ~expr) ~@exprs))))) 43 | 44 | (defmacro for 45 | "Like clojure.core/for with the first expression being replaced by % (or _). Returns a transducer. 46 | When the first expression is not % (or _) returns an eduction." 47 | [[binding %or_ & seq-exprs] body-expr] 48 | (if-not (and (symbol? %or_) (#{"%" "_"} (name %or_))) 49 | `(eduction (for [~binding ~'% ~@seq-exprs] ~body-expr) ~%or_) 50 | (let [rf (gensym 'rf) 51 | acc (gensym 'acc) 52 | rpairs (core/partition 2 (rseq (vec seq-exprs))) 53 | build (fn [init] 54 | (core/reduce (fn [body [expr binding]] 55 | (case binding 56 | :let `(let ~expr ~body) 57 | :when `(if ~expr ~body ~acc) 58 | :while `(if ~expr ~body (reduced ~acc)) 59 | (if (and (coll? expr) (not (seq? expr)) 60 | (or (<= (core/count expr) 4) (:unroll (meta expr)))) 61 | (let [body-rf (gensym 'body-rf)] 62 | (if (and (destructuring-pair? binding) (every? vector? expr)) 63 | `(let [~body-rf (fn [~acc ~@binding] ~body)] 64 | (unreduced (unreduced-> ~acc 65 | ~@(map (fn [[k v]] `(~body-rf ~k ~v)) expr)))) 66 | `(let [~body-rf (fn [~acc ~binding] ~body)] 67 | (unreduced (unreduced-> ~acc 68 | ~@(map (fn [v] `(~body-rf ~v)) expr)))))) 69 | (if (destructuring-pair? binding) 70 | `(let [expr# ~expr] 71 | (if (and (map? expr#) (kvreducible? expr#)) 72 | (core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#) 73 | (core/reduce (fn [~acc ~binding] ~body) ~acc expr#))) 74 | `(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr))))) 75 | init rpairs)) 76 | nested-reduceds (core/for [[expr binding] rpairs 77 | :when (not (keyword? binding))] 78 | `reduced) 79 | body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (no-user-meta? body-expr)) 80 | body-expr 81 | [body-expr]))] 82 | (if (reduced? acc#) 83 | (-> acc# ~@nested-reduceds) 84 | acc#)))] 85 | `(fn [~rf] 86 | (let [~rf (ensure-kvrf ~rf)] 87 | (kvrf 88 | ([] (~rf)) 89 | ([~acc] (~rf ~acc)) 90 | ([~acc ~binding] ~body))))))) 91 | 92 | (defn- ^:macro-support arity [[arglist & body :as fn-body]] 93 | (let [[fixargs varargs] (split-with (complement #{'&}) arglist)] 94 | (if (seq varargs) (zipmap (range (core/count fixargs) 4) (repeat fn-body))) 95 | {(core/count fixargs) fn-body})) 96 | 97 | (defmacro kvrf [name? & fn-bodies] 98 | (let [name (if (symbol? name?) name? (gensym '_)) 99 | fn-bodies (if (symbol? name?) fn-bodies (cons name? fn-bodies)) 100 | fn-bodies (if (vector? (first fn-bodies)) (list fn-bodies) fn-bodies) 101 | arities (core/into {} (mapcat arity) fn-bodies) 102 | _ (when-not (core/some arities [2 3]) (throw (ex-info "Either arity 2 or 3 should be defined in kvrf." {:form &form}))) 103 | fn-bodies (cond-> fn-bodies 104 | (not (arities 3)) (conj (let [[[acc arg] & body] (arities 2)] 105 | (if (destructuring-pair? arg) 106 | (let [[karg varg] arg] 107 | `([~acc ~karg ~varg] ~@body)) 108 | (let [k (gensym "k__") 109 | v (gensym "v__") 110 | arg-value (macros/case 111 | :clj `(clojure.lang.MapEntry. ~k ~v) 112 | :cljs [k v] 113 | :cljd `(MapEntry ~k ~v))] 114 | `([~acc ~k ~v] (let [~arg ~arg-value] ~@body)))))) 115 | (not (arities 2)) (conj (let [[[acc karg varg] & body] (arities 3)] 116 | `([~acc [~karg ~varg]] ~@body))))] 117 | `(reify 118 | #?@(:bb [] ;; babashka currently only supports reify with one Java interface at a time 119 | :default [~@(macros/case :cljd '[cljd.core/Fn] :clj '[clojure.lang.Fn])]) 120 | KvRfable 121 | (~'some-kvrf [this#] this#) 122 | ~(macros/case :cljs `core/IFn :clj 'clojure.lang.IFn :cljd 'cljd.core/IFn) 123 | ~@(core/for [[args & body] fn-bodies] 124 | (let [nohint-args (map (fn [arg] (if (:tag (meta arg)) (gensym 'arg) arg)) args) 125 | rebind (mapcat (fn [arg nohint] 126 | (when-not (= arg nohint) [arg nohint])) args nohint-args)] 127 | `(~(macros/case :cljd '-invoke :cljs `core/-invoke :clj 'invoke) 128 | [~name ~@nohint-args] ~@(if (seq rebind) [`(let [~@rebind] ~@body)] body))))))) 129 | 130 | (defmacro ^:private let-complete [[binding volatile] & body] 131 | `(let [v# @~volatile] 132 | (when-not (identical? v# ~volatile) ; self reference as sentinel 133 | (vreset! ~volatile ~volatile) 134 | (let [~binding v#] 135 | ~@body)))) 136 | ) 137 | 138 | (declare into reduce multiplex by-key) 139 | 140 | (defprotocol KvRfable "Protocol for reducing fns that accept key and val as separate arguments." 141 | (some-kvrf [f] "Returns a kvrf or nil")) 142 | 143 | (macros/usetime 144 | 145 | ;; Workaround clojure.core/satisfies? being slow in Clojure 146 | ;; see https://ask.clojure.org/index.php/3304/make-satisfies-as-fast-as-a-protocol-method-call 147 | #?(:bb nil 148 | :cljd nil 149 | :clj 150 | (defn fast-satisfies?-fn 151 | "Ported from https://github.com/clj-commons/manifold/blob/37658e91f836047a630586a909a2e22debfbbfc6/src/manifold/utils.clj#L77-L89" 152 | [protocol-var] 153 | (let [^java.util.concurrent.ConcurrentHashMap classes 154 | (java.util.concurrent.ConcurrentHashMap.)] 155 | (add-watch protocol-var ::memoization (fn [& _] (.clear classes))) 156 | (fn [x] 157 | (let [cls (class x) 158 | val (.get classes cls)] 159 | (if (nil? val) 160 | (let [val (core/satisfies? @protocol-var x)] 161 | (.put classes cls val) 162 | val) 163 | val)))))) 164 | 165 | #?(:cljs 166 | (defn kvreducible? [coll] 167 | (satisfies? IKVReduce coll)) 168 | 169 | :cljd 170 | (defn kvreducible? [coll] 171 | (satisfies? cljd.core/IKVReduce coll)) 172 | 173 | :clj 174 | (let [satisfies-ikvreduce? #?(:bb #(satisfies? clojure.core.protocols/IKVReduce %) 175 | :default (fast-satisfies?-fn #'clojure.core.protocols/IKVReduce))] 176 | (if (satisfies-ikvreduce? (Object.)) 177 | (defn kvreducible? 178 | "Clojure 1.11 makes everything satisfy IKVReduce, so we can short-circuit" 179 | [_] true) 180 | (defn kvreducible? [coll] (satisfies-ikvreduce? coll))))) 181 | 182 | 183 | (extend-protocol KvRfable 184 | #?(:cljd fallback :clj Object :cljs default) (some-kvrf [_] nil) 185 | #?@(:clj [nil (some-kvrf [_] nil)])) 186 | 187 | (defn ensure-kvrf [rf] 188 | (or (some-kvrf rf) 189 | (kvrf 190 | ([] (rf)) 191 | ([acc] (rf acc)) 192 | ([acc x] (rf acc x))))) 193 | 194 | (defn reduce 195 | "A transducer that reduces a collection to a 1-item collection consisting of only the reduced result. 196 | Unlike reduce but like transduce it does call the completing arity (1) of the reducing fn." 197 | ([f] 198 | (fn [rf] 199 | (let [vacc (volatile! (f))] 200 | (let [f (ensure-kvrf f)] 201 | (kvrf 202 | ([] (rf)) 203 | ([acc] (let-complete [f-acc vacc] 204 | (rf (unreduced (rf acc (f (unreduced f-acc))))))) 205 | ([acc x] 206 | (if (reduced? (vswap! vacc f x)) 207 | (reduced acc) 208 | acc)) 209 | ([acc k v] 210 | (if (reduced? (vswap! vacc f k v)) 211 | (reduced acc) 212 | acc))))))) 213 | ([f init] 214 | (reduce (fn ([] init) ([acc] (f acc)) ([acc x] (f acc x)))))) 215 | 216 | (defn- into-rf [to] 217 | (cond 218 | #?(:cljd (satisfies? cljd.core/IEditableCollection to) 219 | :clj (instance? clojure.lang.IEditableCollection to) 220 | :cljs (satisfies? IEditableCollection to)) 221 | (if (map? to) 222 | (kvrf 223 | ([] (transient to)) 224 | ([acc] (persistent! acc)) 225 | ([acc x] (conj! acc x)) 226 | ([acc k v] (assoc! acc k v))) 227 | (fn 228 | ([] (transient to)) 229 | ([acc] (persistent! acc)) 230 | ([acc x] (conj! acc x)))) 231 | (map? to) 232 | (kvrf 233 | ([] to) 234 | ([acc] acc) 235 | ([acc x] (conj acc x)) 236 | ([acc k v] (assoc acc k v))) 237 | :else 238 | (fn 239 | ([] to) 240 | ([acc] acc) 241 | ([acc x] (conj acc x))))) 242 | 243 | (defn into 244 | "Like clojure.core/into but with a 1-arg arity returning a transducer which accumulate every input in a collection and outputs only the accumulated collection." 245 | ([to] 246 | (reduce (into-rf to))) 247 | ([to from] 248 | (into to identity from)) 249 | ([to xform from] 250 | (let [rf (xform (into-rf to))] 251 | (if-let [rf (and (map? from) (kvreducible? from) (some-kvrf rf))] 252 | (rf (core/reduce-kv rf (rf) from)) 253 | (rf (core/reduce rf (rf) from)))))) 254 | 255 | (defn- without-rf [from] 256 | (cond 257 | #?(:cljd (satisfies? cljd.core/IEditableCollection from) 258 | :clj (instance? clojure.lang.IEditableCollection from) 259 | :cljs (satisfies? IEditableCollection from)) 260 | (if (map? from) 261 | (fn 262 | ([] (transient from)) 263 | ([acc] (persistent! acc)) 264 | ([acc x] (dissoc! acc x))) 265 | (fn 266 | ([] (transient from)) 267 | ([acc] (persistent! acc)) 268 | ([acc x] (disj! acc x)))) 269 | (map? from) 270 | (fn 271 | ([] from) 272 | ([acc] acc) 273 | ([acc x] (dissoc acc x))) 274 | :else 275 | (fn 276 | ([] from) 277 | ([acc] acc) 278 | ([acc x] (disj acc x))))) 279 | 280 | (defn without 281 | "The opposite of x/into: dissociate or disjoin from the target." 282 | ([target] 283 | (reduce (without-rf target))) 284 | ([target keys] 285 | (without target identity keys)) 286 | ([target xform keys] 287 | (let [rf (xform (without-rf target))] 288 | (if-let [rf (and (map? keys) (kvreducible? keys) (some-kvrf rf))] 289 | (rf (core/reduce-kv rf (rf) keys)) 290 | (rf (core/reduce rf (rf) keys)))))) 291 | 292 | (defn minimum 293 | ([comparator] 294 | (minimum comparator nil)) 295 | ([comparator absolute-maximum] 296 | (reduce (rf/minimum comparator absolute-maximum)))) 297 | 298 | (defn maximum 299 | ([comparator] 300 | (maximum comparator nil)) 301 | ([comparator absolute-minimum] 302 | (reduce (rf/maximum comparator absolute-minimum)))) 303 | 304 | (def min (reduce rf/min)) 305 | 306 | (def max (reduce rf/max)) 307 | 308 | (defn str 309 | "When used as a value, it's an aggregating transducer that concatenates input values 310 | into a single output value. 311 | When used as a function of two args (xform and coll) it's a transducing context that 312 | concatenates all values in a string." 313 | {:arglists '([xform coll])} 314 | ([rf] ((reduce rf/str) rf)) 315 | ([xform coll] 316 | (transduce xform rf/str coll))) 317 | 318 | (defn wrap 319 | "Transducer. Adds open as the first item, and close as the last. Optionally inserts delim between each input item." 320 | ([open close] 321 | (fn [rf] 322 | (let [vrf (volatile! nil)] 323 | (vreset! vrf 324 | (fn [acc x] 325 | (let [acc (rf acc open)] 326 | (vreset! vrf rf) 327 | (if (reduced? acc) 328 | acc 329 | (rf acc x))))) 330 | (fn 331 | ([] (rf)) 332 | ([acc] (rf (unreduced (rf acc close)))) 333 | ([acc x] (@vrf acc x)))))) 334 | ([open close delim] 335 | (comp (interpose delim) (wrap open close)))) 336 | 337 | (defn vals [rf] 338 | (kvrf 339 | ([] (rf)) 340 | ([acc] (rf acc)) 341 | ([acc k v] (rf acc v)))) 342 | 343 | (defn keys [rf] 344 | (kvrf 345 | ([] (rf)) 346 | ([acc] (rf acc)) 347 | ([acc k v] (rf acc k)))) 348 | 349 | ;; for both map entries and vectors 350 | (defn- key' [kv] (nth kv 0)) 351 | (defn- val' [kv] (nth kv 1)) 352 | 353 | (defn- nop-rf "The noop reducing function" ([acc] acc) ([acc _] acc) ([acc _ _] acc)) 354 | 355 | (defn- multiplexable 356 | "Returns a multiplexable reducing function (doesn't init or complete the uderlying rf, wraps reduced -- like preserving-reduced)" 357 | [rf] 358 | (let [rf (ensure-kvrf rf)] 359 | (kvrf 360 | ([]) 361 | ([acc] acc) ; no init no complete rf 362 | ([acc x] 363 | (let [acc (rf acc x)] 364 | (if (reduced? acc) 365 | (reduced acc) 366 | acc))) 367 | ([acc k v] 368 | (let [acc (rf acc k v)] 369 | (if (reduced? acc) 370 | (reduced acc) 371 | acc)))))) 372 | 373 | (defn by-key 374 | "Returns a transducer which partitions items according to kfn. 375 | It applies the transform specified by xform to each partition. 376 | Partitions contain the \"value part\" (as returned by vfn) of each item. 377 | The resulting transformed items are wrapped back into a \"pair\" using the pair function. 378 | Default values for kfn, vfn and pair are first, second (or identity if kfn is specified) and vector." 379 | ([xform] (by-key nil nil vector xform)) 380 | ([kfn xform] (by-key kfn identity vector xform)) 381 | ([kfn vfn xform] (by-key kfn vfn vector xform)) 382 | ([kfn vfn pair xform] 383 | (let [pair (if (identical? vector pair) ::default pair)] 384 | (fn [rf] 385 | (let [mrf (multiplexable rf) 386 | make-rf (cond 387 | (nil? pair) (constantly mrf) 388 | (= ::default pair) 389 | (fn [k] (fn ([acc] acc) ([acc v] (mrf acc k v)))) 390 | :else (fn [k] (fn ([acc] acc) ([acc v] (mrf acc (pair k v)))))) 391 | m (volatile! (transient {}))] 392 | (if (and (nil? kfn) (nil? vfn)) 393 | (kvrf self 394 | ([] (rf)) 395 | ([acc] (let-complete [m m] (rf (core/reduce (fn [acc krf] (krf acc)) acc (core/vals (persistent! m)))))) 396 | ([acc k v] 397 | (let [krf (or (get @m k) (doto (xform (make-rf k)) (->> (vswap! m assoc! k)))) 398 | acc (krf acc v)] 399 | (if (reduced? acc) 400 | (if (reduced? @acc) 401 | (do 402 | (vreset! m (transient {})) ; no need to run completions 403 | @acc) ; downstream is done, propagate 404 | (do 405 | (vswap! m assoc! k nop-rf) 406 | (krf @acc))) ; TODO think again 407 | acc)))) 408 | (let [kfn (or kfn key') 409 | vfn (or vfn val')] 410 | (kvrf self 411 | ([] (rf)) 412 | ([acc] (let-complete [m m] (rf (core/reduce (fn [acc krf] (krf acc)) acc (core/vals (persistent! m)))))) 413 | ([acc x] 414 | (let [k (kfn x) 415 | krf (or (get @m k) (doto (xform (make-rf k)) (->> (vswap! m assoc! k)))) 416 | acc (krf acc (vfn x))] 417 | (if (reduced? acc) 418 | (if (reduced? @acc) 419 | (do 420 | (vreset! m (transient {})) ; no need to run completions 421 | @acc) ; downstream is done, propagate 422 | (do 423 | (vswap! m assoc! k nop-rf) 424 | (krf @acc))) 425 | acc))))))))))) 426 | 427 | (defn into-by-key 428 | "A shorthand for the common case (comp (x/by-key ...) (x/into coll))." 429 | [coll & by-key-args] 430 | (comp (apply by-key by-key-args) (into coll))) 431 | 432 | (macros/replace 433 | [#?(:cljd {(java.util.ArrayDeque. n) (dart:coll/Queue) 434 | .add .add 435 | .poll .removeFirst 436 | .size .-length}) 437 | #?(:cljs {(java.util.ArrayDeque. n) (Queue.) 438 | .add .enqueue 439 | .poll .dequeue 440 | .size .getCount}) 441 | #?(:clj {(.getValues dq) dq})] 442 | 443 | (defn partition 444 | "Returns a partitioning transducer. Each partition is independently transformed using the xform transducer." 445 | ([n] 446 | (partition n n (into []))) 447 | ([n step-or-xform] 448 | (if (fn? step-or-xform) 449 | (partition n n step-or-xform) 450 | (partition n step-or-xform (into [])))) 451 | ([#?(:cljd ^int n :default ^long n) step pad-or-xform] 452 | (if (fn? pad-or-xform) 453 | (let [xform pad-or-xform] 454 | (fn [rf] 455 | (let [mxrf (multiplexable rf) 456 | dq (java.util.ArrayDeque. n) 457 | barrier (volatile! n) 458 | xform (comp (map #(if (identical? dq %) nil %)) xform)] 459 | (fn 460 | ([] (rf)) 461 | ([acc] (.clear dq) (rf acc)) 462 | ([acc x] 463 | (let [b (vswap! barrier dec)] 464 | (when (< b n) (.add dq (if (nil? x) dq x))) 465 | (if (zero? b) 466 | ; this transduce may return a reduced because of mxrf wrapping reduceds coming from rf 467 | (let [acc (transduce xform mxrf acc (.getValues dq))] 468 | (dotimes [_ (core/min n step)] (.poll dq)) 469 | (vswap! barrier + step) 470 | acc) 471 | acc))))))) 472 | (partition n step pad-or-xform (into [])))) 473 | ([#?(:cljd ^int n :default ^long n) step pad xform] 474 | (fn [rf] 475 | (let [mxrf (multiplexable rf) 476 | dq (java.util.ArrayDeque. n) 477 | barrier (volatile! n) 478 | xform (comp (map #(if (identical? dq %) nil %)) xform)] 479 | (fn 480 | ([] (rf)) 481 | ([acc] (if (< @barrier n) 482 | (let [xform (comp cat (take n) xform) 483 | ; don't use mxrf for completion: we want completion and don't want reduced-wrapping 484 | acc (transduce xform rf acc [(.getValues dq) pad])] 485 | (vreset! barrier n) 486 | (.clear dq) 487 | acc) 488 | (rf acc))) 489 | ([acc x] 490 | (let [b (vswap! barrier dec)] 491 | (when (< b n) (.add dq (if (nil? x) dq x))) 492 | (if (zero? b) 493 | ; this transduce may return a reduced because of mxrf wrapping reduceds coming from rf 494 | (let [acc (core/transduce xform mxrf acc (.getValues dq))] 495 | (dotimes [_ (core/min n step)] (.poll dq)) 496 | (vswap! barrier + step) 497 | acc) 498 | acc)))))))) 499 | 500 | #_(defn zip [xform1 xform2] 501 | (fn [rf] 502 | (let ))) 503 | 504 | (defn take-last [#?(:cljd ^int n :default ^long n)] 505 | (fn [rf] 506 | (let [dq (java.util.ArrayDeque. n)] 507 | (fn 508 | ([] (rf)) 509 | ([acc] (transduce (map #(if (identical? dq %) nil %)) rf acc (.getValues dq))) 510 | ([acc x] 511 | (.add dq (if (nil? x) dq x)) 512 | (when (< n (.size dq)) (.poll dq)) 513 | acc))))) 514 | 515 | (defn drop-last 516 | ([] (drop-last 1)) 517 | ([#?(:cljd ^int n :default ^long n)] 518 | (fn [rf] 519 | (let [dq (java.util.ArrayDeque. n) 520 | xform (map #(if (identical? dq %) nil %)) 521 | rf (xform rf)] 522 | (fn 523 | ([] (rf)) 524 | ([acc] (rf acc)) 525 | ([acc x] 526 | (.add dq (if (nil? x) dq x)) 527 | (if (< n (.size dq)) 528 | (rf acc (.poll dq)) 529 | acc))))))) 530 | 531 | ) 532 | 533 | #?(:cljs 534 | (defn ^:private fn->comparator 535 | "Given a fn that might be boolean valued or a comparator, 536 | return a fn that is a comparator. 537 | 538 | Copied from cljs.core: https://github.com/clojure/clojurescript/blob/95c5cf384a128503b072b7b1916af1a1d5c8871c/src/main/cljs/cljs/core.cljs#L2459-L2471" 539 | [f] 540 | (if (= f compare) 541 | compare 542 | (fn [x y] 543 | (let [r (f x y)] 544 | (if (number? r) 545 | r 546 | (if r 547 | -1 548 | (if (f y x) 1 0)))))))) 549 | 550 | (defn sort 551 | ([] (sort compare)) 552 | ([cmp] 553 | (fn [rf] 554 | (let [buf #?(:cljd #dart [] :clj (java.util.ArrayList.) :cljs #js [])] 555 | (fn 556 | ([] (rf)) 557 | ([acc] (rf (core/reduce rf acc (doto buf #?(:cljd (.sort (dart-comparator cmp)) 558 | :clj (java.util.Collections/sort cmp) 559 | :cljs (.sort (fn->comparator cmp))))))) 560 | ([acc x] (#?(:cljd .add :clj .add :cljs .push) buf x) acc)))))) 561 | 562 | (defn sort-by 563 | ([kfn] (sort-by kfn compare)) 564 | ([kfn cmp] 565 | (sort (fn [a b] 566 | #?(:cljd (cmp (kfn a) (kfn b)) 567 | :clj (.compare ^java.util.Comparator cmp (kfn a) (kfn b)) 568 | :cljs (cmp (kfn a) (kfn b))))))) 569 | 570 | (defn reductions 571 | "Transducer version of reductions. There's a difference in behavior when init is not provided: (f) is used. 572 | So x/reductions works like x/reduce or transduce, not like reduce and reductions when no init and 1-item input." 573 | ([f] (reductions f (f))) 574 | ([f init] 575 | (fn [rf] 576 | (let [prev (volatile! nil)] 577 | (vreset! prev prev) ; cheap sentinel to detect the first call, this is done to avoid having a 1-item delay 578 | (fn 579 | ([] (rf)) ; no you can't emit init there since there's no guarantee that this arity is going to be called 580 | ([acc] (if (identical? @prev prev) 581 | (rf (unreduced (rf acc init))) 582 | (rf acc))) 583 | ([acc x] 584 | (if (identical? @prev prev) 585 | (let [acc (rf acc (vreset! prev init))] 586 | (if (reduced? acc) 587 | acc 588 | (recur acc x))) 589 | (let [curr (vswap! prev f x)] 590 | (if (reduced? curr) 591 | (ensure-reduced (rf acc @curr)) 592 | (rf acc curr)))))))))) 593 | 594 | (def avg (reduce rf/avg)) 595 | (def sd (reduce rf/sd)) 596 | 597 | (defn window 598 | "Returns a transducer which computes an accumulator over the last n items 599 | using two functions: f and its inverse invf. 600 | 601 | The accumulator is initialized with (f). 602 | It is updated to (f (invf acc out) in) where \"acc\" is the current value, 603 | \"in\" the new item entering the window, \"out\" the item exiting the window. 604 | The value passed to the dowstream reducing function is (f acc) enabling acc to be 605 | mutable and 1-arity f to project its state to a value. 606 | 607 | If you don't want to see the accumulator until the window is full then you need to 608 | use (drop (dec n)) to remove them. 609 | 610 | If you don't have an inverse function, consider using partition and reduce: 611 | (x/partition 4 (x/reduce rf))" 612 | [n f invf] 613 | (fn [rf] 614 | (let [ring (object-array n) 615 | vi (volatile! (- n)) 616 | vwacc (volatile! (f))] 617 | (fn 618 | ([] (rf)) 619 | ([acc] (rf acc)) 620 | ([acc x] 621 | (let [i @vi 622 | wacc @vwacc] ; window accumulator 623 | (if (neg? i) ; not full yet 624 | (do 625 | (aset ring (+ n i) x) 626 | (vreset! vi (inc i)) 627 | (rf acc (f (vreset! vwacc (f wacc x))))) 628 | (let [x' (aget ring i)] 629 | (aset ring i x) 630 | (vreset! vi (let [i (inc i)] (if (= n i) 0 i))) 631 | (rf acc (f (vreset! vwacc (f (invf wacc x') x)))))))))))) 632 | 633 | #?(:cljd nil 634 | :clj 635 | (defn iterator 636 | "Iterator transducing context, returns an iterator on the transformed data. 637 | Equivalent to (.iterator (eduction xform (iterator-seq src-iterator))) except there's is no buffering on values (as in iterator-seq), 638 | This buffering may cause problems when mutable objects are returned by the src-iterator." 639 | ^java.util.Iterator [xform ^java.util.Iterator src-iterator] 640 | (let [NULL (Object.) 641 | dq (java.util.ArrayDeque. 32) 642 | rf (xform (fn ([acc] acc) ([acc x] (.push dq (if (some? x) x NULL)) acc))) 643 | vopen (volatile! true) 644 | ensure-next #(or (some? (.peek dq)) 645 | (and @vopen 646 | (if (.hasNext src-iterator) 647 | (let [acc (rf nil (.next src-iterator))] 648 | (when (reduced? acc) 649 | (rf nil) 650 | (vreset! vopen false)) 651 | (recur)) 652 | (do 653 | (rf nil) 654 | (vreset! vopen false) 655 | (recur)))))] 656 | (reify java.util.Iterator 657 | (hasNext [_] 658 | (ensure-next)) 659 | (next [_] 660 | (if (ensure-next) 661 | (let [x (.poll dq)] 662 | (if (identical? NULL x) nil x)) 663 | (throw (java.util.NoSuchElementException.)))))))) 664 | 665 | #?(:cljd nil 666 | :clj 667 | (defn window-by-time 668 | "ALPHA 669 | Returns a transducer which computes a windowed accumulator over chronologically sorted items. 670 | 671 | timef is a function from one item to its scaled timestamp (as a double). The window length is always 1.0 672 | so timef must normalize timestamps. For example if timestamps are in seconds (and under the :ts key), 673 | to get a 1-hour window you have to use (fn [x] (/ (:ts x) 3600.0)) as timef. 674 | 675 | n is the integral number of steps by which the window slides. With a 1-hour window, 4 means that the window slides every 15 minutes. 676 | 677 | f and invf work like in #'window." 678 | ([timef n f] 679 | (window-by-time timef n 680 | (fn 681 | ([] clojure.lang.PersistentQueue/EMPTY) 682 | ([q] (f (core/reduce f (f) q))) 683 | ([q x] (conj q x))) 684 | (fn [q _] (pop q)))) 685 | ([timef n f invf] 686 | (let [timef (fn [x] (long (Math/floor (* n (timef x)))))] 687 | (fn [rf] 688 | (let [dq (java.util.ArrayDeque.) 689 | vwacc (volatile! (f)) 690 | flush! 691 | (fn [acc ^long from-ts ^long to-ts] 692 | (loop [ts from-ts acc acc wacc @vwacc] 693 | (let [x (.peekFirst dq)] 694 | (cond 695 | (= ts (timef x)) 696 | (do 697 | (.pollFirst dq) 698 | (recur ts acc (invf wacc x))) 699 | (= ts to-ts) 700 | (do 701 | (vreset! vwacc wacc) 702 | acc) 703 | :else 704 | (let [acc (rf acc (f wacc))] 705 | (if (reduced? acc) 706 | (do 707 | (vreset! vwacc wacc) 708 | acc) 709 | (recur (inc ts) acc wacc)))))))] 710 | (fn 711 | ([] (rf)) 712 | ([acc] 713 | (let [acc (if-not (.isEmpty dq) 714 | (unreduced (rf acc (f @vwacc))) 715 | acc)] 716 | (rf acc))) 717 | ([acc x] 718 | (let [limit (- (timef x) n) 719 | prev-limit (if-some [prev-x (.peekLast dq)] 720 | (- (timef prev-x) n) 721 | limit) 722 | _ (.addLast dq x) ; so dq is never empty for flush! 723 | acc (flush! acc prev-limit limit)] 724 | (when-not (reduced? acc) 725 | (vswap! vwacc f x)) 726 | acc))))))))) 727 | 728 | (defn count 729 | "Count the number of items. Either used directly as a transducer or invoked with two args 730 | as a transducing context." 731 | ([rf] 732 | (let [n #?(:cljd (volatile! 0) :clj (java.util.concurrent.atomic.AtomicLong.) :cljs (volatile! 0))] 733 | (fn 734 | ([] (rf)) 735 | ([acc] (rf (unreduced (rf acc #?(:cljd @n :clj (.get n) :cljs @n))))) 736 | ([acc _] #?(:cljd (vswap! n inc) :clj (.incrementAndGet n) :cljs (vswap! n inc)) acc)))) 737 | ([xform coll] 738 | (transduce (comp xform count) rf/last coll))) 739 | 740 | (defn multiplex 741 | "Returns a transducer that runs several transducers (sepcified by xforms) in parallel. 742 | If xforms is a map, values of the map are transducers and keys are used to tag each 743 | transducer output: 744 | => (into [] (x/multiplex [(map inc) (map dec)]) (range 3)) 745 | [1 -1 2 0 3 1] ; no map, no tag 746 | => (into [] (x/multiplex {:up (map inc) :down (map dec)}) (range 3)) 747 | [[:up 1] [:down -1] [:up 2] [:down 0] [:up 3] [:down 1]]" 748 | [xforms] 749 | (fn [rf] 750 | (let [mrf (multiplexable (ensure-kvrf rf)) 751 | rfs (volatile! (if (map? xforms) 752 | (into {} (for [[k xform] % 753 | :let [xform (comp xform (for [x %] [k x]))]] 754 | [k (xform mrf)]) 755 | xforms) 756 | (into #{} (map #(% mrf)) xforms))) 757 | invoke-rfs (if (map? xforms) 758 | (fn [acc invoke] 759 | (reduce-kv 760 | (fn [acc tag rf] 761 | (let [acc (invoke rf acc)] 762 | (if (reduced? acc) 763 | (if (reduced? @acc) 764 | (do 765 | (vreset! rfs nil) 766 | acc) ; downstream is done, propagate 767 | (do (vswap! rfs dissoc tag) (rf @acc))) 768 | acc))) 769 | acc @rfs)) 770 | (fn [acc invoke] 771 | (core/reduce 772 | (fn [acc rf] 773 | (let [acc (invoke rf acc)] 774 | (if (reduced? acc) 775 | (if (reduced? @acc) 776 | (do 777 | (vreset! rfs nil) 778 | acc) ; downstream is done, propagate 779 | (do (vswap! rfs disj rf) (rf @acc))) 780 | acc))) 781 | acc @rfs)))] 782 | (kvrf 783 | ([] (rf)) 784 | ([acc] (rf (invoke-rfs acc #(%1 %2)))) 785 | ([acc x] 786 | (let [acc (invoke-rfs acc #(%1 %2 x))] 787 | (if (zero? (core/count @rfs)) 788 | (ensure-reduced acc) 789 | acc))) 790 | ([acc k v] 791 | (let [acc (invoke-rfs acc #(%1 %2 k v))] 792 | (if (zero? (core/count @rfs)) 793 | (ensure-reduced acc) 794 | acc))))))) 795 | 796 | (def last (reduce rf/last)) 797 | 798 | (defn some 799 | "Process coll through the specified xform and returns the first local true value." 800 | [xform coll] 801 | (transduce xform rf/some nil coll)) 802 | 803 | (defn transjuxt 804 | "Performs several transductions over coll at once. xforms-map can be a map or a sequential collection. 805 | When xforms-map is a map, returns a map with the same keyset as xforms-map. 806 | When xforms-map is a sequential collection returns a vector of same length as xforms-map. 807 | Returns a transducer when coll is omitted." 808 | ([xforms-map] 809 | (let [collect-xform (if (map? xforms-map) 810 | (into {}) 811 | (reduce (kvrf 812 | ([] (core/reduce (fn [v _] (conj! v nil)) 813 | (transient []) (range (core/count xforms-map)))) 814 | ([v] (persistent! v)) 815 | ([v i x] (assoc! v i x))))) 816 | xforms-map (if (map? xforms-map) xforms-map (zipmap (range) xforms-map))] 817 | (comp 818 | (multiplex (into {} (by-key (map #(comp % (take 1)))) xforms-map)) 819 | collect-xform))) 820 | ([xforms-map coll] 821 | (transduce (transjuxt xforms-map) rf/last coll))) 822 | 823 | (macros/replace 824 | [#?(:cljs {(java.util.concurrent.atomic.AtomicLong.) (atom 0) 825 | (System/nanoTime) (system-time) 826 | (.addAndGet at (- t (System/nanoTime))) (swap! at + (- t (system-time))) 827 | (.addAndGet at (- (System/nanoTime) t)) (swap! at + (- (system-time) t)) 828 | .size .getCount})] 829 | 830 | #?(:cljd nil 831 | :default 832 | (defn time 833 | "Measures the time spent in this transformation and prints the measured time. 834 | tag-or-f may be either a function of 1 argument (measured time in ms) in which case 835 | this function will be called instead of printing, or tag-or-f will be print before the measured time." 836 | ([xform] (time "Elapsed time" xform)) 837 | ([tag-or-f xform] 838 | (let [pt (if (fn? tag-or-f) 839 | tag-or-f 840 | #(println (core/str tag-or-f ": " % " msecs")))] 841 | (fn [rf] 842 | (let [at (java.util.concurrent.atomic.AtomicLong.) 843 | rf 844 | (fn 845 | ([] (rf)) 846 | ([acc] (let [t (System/nanoTime) 847 | r (rf acc)] 848 | (.addAndGet at (- t (System/nanoTime))) 849 | r)) 850 | ([acc x] 851 | (let [t (System/nanoTime) 852 | r (rf acc x)] 853 | (.addAndGet at (- t (System/nanoTime))) 854 | r))) 855 | rf (xform rf)] 856 | (fn 857 | ([] (rf)) 858 | ([acc] 859 | (let [t (System/nanoTime) 860 | r (rf acc) 861 | total (.addAndGet at (- (System/nanoTime) t))] 862 | (pt #?(:clj (* total 1e-6) :cljs total)) 863 | r)) 864 | ([acc x] 865 | (let [t (System/nanoTime) 866 | r (rf acc x)] 867 | (.addAndGet at (- (System/nanoTime) t)) 868 | r)))))))))) 869 | 870 | #_(defn rollup 871 | "Roll-up input data along the provided dimensions (which are functions of one input item), 872 | Values of interest are extracted from items using the valfn function and are then summarized 873 | by summary-fn (a reducing function over values returned by valfn or summaries). 874 | Each level of rollup is a map with two keys: :summary and :details." 875 | ([dimensions valfn summary-fn] 876 | (let [[dim & dims] (reverse dimensions)] 877 | (core/reduce 878 | (fn [xform dim] 879 | (comp 880 | (by-key dim xform) 881 | (transjuxt 882 | {:detail (into {}) 883 | :summary (comp vals (map :summary) (reduce summary-fn))}))) 884 | (comp (by-key dim (map valfn)) 885 | (transjuxt 886 | {:detail (into {}) 887 | :summary (comp vals (reduce summary-fn))})) 888 | dims))) 889 | ([dimensions valfn summary-fn coll] 890 | (into {} (rollup dimensions valfn summary-fn) coll))) 891 | ) 892 | -------------------------------------------------------------------------------- /src/net/cgrand/xforms/io.clj: -------------------------------------------------------------------------------- 1 | (ns net.cgrand.xforms.io 2 | (:require [clojure.java.io :as io] 3 | [clojure.java.shell :as sh] 4 | [clojure.edn :as edn]) 5 | (:import (java.io Reader BufferedReader IOException InputStream OutputStream BufferedWriter Writer PushbackReader InputStreamReader OutputStreamWriter Closeable) 6 | (java.util Arrays List) 7 | (java.util.concurrent ArrayBlockingQueue) 8 | (java.lang ProcessBuilder$Redirect) 9 | (clojure.lang IFn Fn IReduce))) 10 | 11 | (defn keep-opts [m like] 12 | (let [ns (namespace like)] 13 | (into {} 14 | (keep (fn [[k v]] 15 | (when (= ns (or (namespace k) ns)) 16 | [(keyword (name k)) v]))) 17 | m))) 18 | 19 | (defn lines-in 20 | "Returns a reducible view over the provided input. 21 | Input is read line by line. Coercion of the input is done by io/reader (and opts are passed to it). 22 | Input is automatically closed upon completion or error." 23 | [in & opts] 24 | (let [no-init (Object.)] 25 | (reify IReduce 26 | (reduce [self f] (.reduce self f no-init)) 27 | (reduce [self f init] 28 | (with-open [^Reader rdr (apply io/reader in opts)] 29 | (let [^BufferedReader rdr (cond-> rdr (not (instance? BufferedReader rdr)) (BufferedReader.)) 30 | init (if (identical? init no-init) 31 | (or (.readLine rdr) (f)) 32 | init)] 33 | (loop [state init] 34 | (if-some [line (.readLine rdr)] 35 | (let [state (f state line)] 36 | (if (reduced? state) 37 | (unreduced state) 38 | (recur state))) 39 | state)))))))) 40 | 41 | (defn lines-out 42 | "1-2 args: reducing function that writes values serialized to its accumulator (a java.io.BufferedWriter). 43 | 3+ args: transducing context that writes transformed values to the specified output. The output is 44 | coerced to a BufferedWriter by passing out and opts to clojure.java.io/writer. The output is automatically closed. 45 | Returns the writer." 46 | ([w] w) 47 | ([^BufferedWriter w line] 48 | (doto w 49 | (.write (str line)) 50 | (.newLine))) 51 | ([out xform coll & opts] 52 | (with-open [^Writer w (apply io/writer out opts)] 53 | (transduce xform lines-out w coll)))) 54 | 55 | (defn edn-in 56 | "Returns a reducible view over the provided input. 57 | Input is read form by form. Coercion of the input is done by io/reader. 58 | Input is automatically closed upon completion or error. 59 | Unqualified options are passed to both edn/read and io/writer, options qualified by clojure.java.io 60 | are only passed (once dequalified) to io/writer, options qualified by clojure.edn are only passed to 61 | edn/read" 62 | [in & {:as opts}] 63 | (let [no-init (Object.)] 64 | (reify IReduce 65 | (reduce [self f] (.reduce self f no-init)) 66 | (reduce [self f init] 67 | (with-open [^Reader rdr (apply io/reader in (mapcat seq (keep-opts opts ::io/opts)))] 68 | (let [^BufferedReader rdr (cond-> rdr (not (instance? PushbackReader rdr)) PushbackReader.) 69 | opts (assoc (keep-opts opts ::edn/opts) :eof no-init) 70 | init (if (identical? init no-init) 71 | (let [form (edn/read opts rdr)] 72 | (if (identical? no-init form) 73 | (f) 74 | form)) 75 | init)] 76 | (loop [state init] 77 | (let [form (edn/read opts rdr)] 78 | (if (identical? no-init form) 79 | state 80 | (let [state (f state form)] 81 | (if (reduced? state) 82 | (unreduced state) 83 | (recur state)))))))))))) 84 | 85 | (defn edn-out 86 | "1-2 args: reducing function that writes values serialized as EDN to its accumulator (a java.io.Writer). 87 | 3+ args: transducing context that writes transformed values to the specified output. The output is 88 | coerced to a Writer by passing out and opts to clojure.java.io/writer. The output is automatically closed. 89 | Returns the writer." 90 | ([w] w) 91 | ([^Writer w x] 92 | (binding [*out* w 93 | *print-length* nil 94 | *print-level* nil 95 | *print-dup* false 96 | *print-meta* false 97 | *print-readably* true] 98 | (prn x) 99 | w)) 100 | ([out xform coll & opts] 101 | (with-open [^Writer w (apply io/writer out opts)] 102 | (transduce xform edn-out w coll)))) 103 | 104 | (defn- stream-spec [x] 105 | (into {:mode :lines :enc "UTF-8"} 106 | (cond (map? x) x (string? x) {:enc x} (keyword? x) {:mode x}))) 107 | 108 | (defn sh 109 | "Transducer or reducible view (in this case assumes empty stdin). 110 | Spawns a process (program cmd with optional arguments arg1 ... argN) and pipes data through it. 111 | Options may be: 112 | * :env, an environment variables map, it will be merged with clojure.java.shell/*sh-env* and JVM environment (in decreasing precedence order), 113 | * :dir, the current dir (defaults to clojure.java.shell/*sh-dir* or JVM current dir), 114 | * :in and :out which are maps with keys :mode (:lines (default), :text or :bytes) and :enc (defaults to \"UTF-8\"); 115 | encoding applies only for modes :lines or :text; shorthands exist: a single keyword is equivalent to {:mode k :enc \"UTF-8\"}, 116 | a single string is equivalent to {:mode :lines, :enc s}. 117 | In :bytes mode, values are bytes array. 118 | In :lines mode, values are strings representing lines without line delimiters. 119 | In :text mode, values are strings." 120 | {:arglists '([cmd arg1 ... argN & opts])} 121 | [& args] 122 | (reify 123 | IReduce 124 | (reduce [self rf] 125 | (reduce rf (eduction self nil))) ; quick way to handle no init 126 | (reduce [self rf init] 127 | (let [xf (self rf)] 128 | (xf init))) 129 | Fn 130 | IFn 131 | (invoke [_ rf] 132 | (let [[cmd [& {:as opts :keys [env in out dir] :or {dir sh/*sh-dir*}}]] (split-with string? args) 133 | env (into (or sh/*sh-env* {}) env) 134 | env (into {} (for [[k v] env] [(name k) (str v)])) 135 | proc (-> ^List (map str cmd) ProcessBuilder. 136 | (.redirectError ProcessBuilder$Redirect/INHERIT) 137 | (doto (-> .environment (.putAll env))) 138 | (.directory (io/as-file dir)) 139 | .start) 140 | EOS (Object.) 141 | q (ArrayBlockingQueue. 16) 142 | drain (fn [acc] 143 | (loop [acc acc] 144 | (if-some [x (.poll q)] 145 | (let [acc (if (identical? EOS x) (reduced acc) (rf acc x))] 146 | (if (reduced? acc) 147 | (do 148 | (.destroy proc) 149 | acc) 150 | (recur acc))) 151 | acc))) 152 | in (stream-spec in) 153 | out (stream-spec out) 154 | ^Closeable stdin (cond-> (.getOutputStream proc) (#{:lines :text} (:mode in)) (-> (OutputStreamWriter. ^String (:enc in)) BufferedWriter.)) 155 | stdout (cond-> (.getInputStream proc) (#{:lines :text} (:mode out)) (-> (InputStreamReader. ^String (:enc out)) BufferedReader.)) 156 | write! 157 | (case (:mode in) 158 | :lines 159 | (fn [x] 160 | (doto ^BufferedWriter stdin 161 | (.write (str x)) 162 | .newLine)) 163 | :text 164 | (fn [x] 165 | (.write ^BufferedWriter stdin (str x))) 166 | :bytes 167 | (fn [^bytes x] 168 | (.write ^OutputStream stdin x)))] 169 | (-> (case (:mode out) 170 | :lines 171 | #(loop [] 172 | (if-some [s (.readLine ^BufferedReader stdout)] 173 | (do (.put q s) (recur)) 174 | (.put q EOS))) 175 | :text 176 | #(let [buf (char-array 1024)] 177 | (loop [] 178 | (let [n (.read ^BufferedReader stdout buf)] 179 | (if (neg? n) 180 | (.put q EOS) 181 | (do (.put q (String. buf 0 n)) (recur)))))) 182 | :bytes 183 | #(let [buf (byte-array 1024)] 184 | (loop [] 185 | (let [n (.read ^InputStream stdout buf)] 186 | (if (neg? n) 187 | (.put q EOS) 188 | (do (.put q (Arrays/copyOf buf n)) (recur))))))) 189 | Thread. .start) 190 | (fn 191 | ([] (rf)) 192 | ([acc] 193 | (.close stdin) 194 | (loop [acc acc] 195 | (let [acc (drain acc)] 196 | (if (reduced? acc) 197 | (rf (unreduced acc)) 198 | (recur acc))))) 199 | ([acc x] 200 | (let [acc (drain acc)] 201 | (try 202 | (when-not (reduced? acc) 203 | (write! x)) 204 | acc 205 | (catch IOException e 206 | (ensure-reduced acc)))))))))) -------------------------------------------------------------------------------- /src/net/cgrand/xforms/nodejs/stream.cljs: -------------------------------------------------------------------------------- 1 | (ns net.cgrand.xforms.nodejs.stream) 2 | 3 | (def ^:private Transform (.-Transform (js/require "stream"))) 4 | 5 | (defn transformer 6 | "Returns a stream.Transform object that performs the specified transduction. 7 | options is a js object as per stream.Transform -- however :readableObjectMode and :writableObjectMode are set to true by default." 8 | ([xform] (transformer #js {} xform)) 9 | ([options xform] 10 | (let [xrf (xform (fn 11 | ([transform] (doto transform .end)) 12 | ([transform x] 13 | (when-not (.push transform x) 14 | (throw (js/Error. "Transformer's internal buffer is full, try passing a larger :highWaterMark option."))) 15 | transform)))] 16 | (specify! (Transform. (.assign js/Object #js {:readableObjectMode true 17 | :writableObjectMode true} options)) 18 | Object 19 | (_transform [this x _ cb] 20 | (try 21 | (when (reduced? (xrf this x)) 22 | (.push this nil)) 23 | (cb) 24 | (catch :default err 25 | (cb err)))) 26 | (_flush [this cb] 27 | (try 28 | (xrf this) 29 | (cb) 30 | (catch :default err 31 | (cb err)))))))) 32 | -------------------------------------------------------------------------------- /src/net/cgrand/xforms/rfs.cljc: -------------------------------------------------------------------------------- 1 | (ns net.cgrand.xforms.rfs 2 | {:author "Christophe Grand"} 3 | (:refer-clojure :exclude [str last min max some]) 4 | #?(:cljs (:require-macros 5 | [net.cgrand.macrovich :as macros] 6 | [net.cgrand.xforms.rfs :refer [or-instance?]]) 7 | :clj (:require [net.cgrand.macrovich :as macros])) 8 | (:require [#?(:clj clojure.core :cljs cljs.core) :as core]) 9 | #?(:cljd (:require ["dart:math" :as Math])) 10 | #?(:cljs (:import [goog.string StringBuffer]))) 11 | 12 | (macros/deftime 13 | (defmacro ^:private or-instance? [class x y] 14 | (let [xsym (gensym 'x_)] 15 | `(let [~xsym ~x] 16 | (if #?(:cljd (dart/is? ~xsym ~class) 17 | :default (instance? ~class ~xsym)) 18 | ~(with-meta xsym {:tag class}) ~y))))) 19 | 20 | (declare str!) 21 | 22 | (macros/usetime 23 | 24 | #? (:cljs 25 | (defn ^:private cmp [f a b] 26 | (let [r (f a b)] 27 | (cond 28 | (number? r) r 29 | r -1 30 | (f b a) 1 31 | :else 0)))) 32 | 33 | (defn minimum 34 | ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator)] 35 | (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])] 36 | (fn 37 | ([] nil) 38 | ([x] x) 39 | ([a b] (cond 40 | (nil? a) b 41 | (nil? b) a 42 | (pos? #?(:cljd (comparator a b) 43 | :clj (.compare comparator a b) 44 | :cljs (cmp comparator a b))) b 45 | :else a))))) 46 | ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator) absolute-maximum] 47 | (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])] 48 | (fn 49 | ([] ::+infinity) 50 | ([x] (if (#?(:clj identical? :cljs keyword-identical?) ::+infinity x) 51 | absolute-maximum 52 | x)) 53 | ([a b] 54 | (if (or 55 | (#?(:clj identical? :cljs keyword-identical?) ::+infinity a) 56 | (pos? #?(:cljd (comparator a b) 57 | :clj (.compare comparator a b) 58 | :cljs (cmp comparator a b)))) 59 | b a)))))) 60 | 61 | (defn maximum 62 | ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator)] 63 | (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])] 64 | (fn 65 | ([] nil) 66 | ([x] x) 67 | ([a b] (cond 68 | (nil? a) b 69 | (nil? b) a 70 | (neg? #?(:cljd (comparator a b) 71 | :clj (.compare comparator a b) 72 | :cljs (cmp comparator a b))) b 73 | :else a))))) 74 | ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator) absolute-minimum] 75 | (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])] 76 | (fn 77 | ([] ::-infinity) 78 | ([x] (if (#?(:clj identical? :cljs keyword-identical?) ::-infinity x) 79 | absolute-minimum 80 | x)) 81 | ([a b] 82 | (if (or (#?(:clj identical? :cljs keyword-identical?) ::-infinity a) 83 | (neg? #?(:cljd (comparator a b) 84 | :clj (.compare comparator a b) 85 | :cljs (cmp comparator a b)))) 86 | b a)))))) 87 | 88 | (def min (minimum compare)) 89 | 90 | (def max (maximum compare)) 91 | 92 | (defn avg 93 | "Reducing fn to compute the arithmetic mean." 94 | ([] nil) 95 | ([#?(:cljd ^{:tag #/(List? double)} acc :clj ^doubles acc :cljs ^doubles acc)] 96 | (when acc (/ (aget acc 1) (aget acc 0)))) 97 | ([acc x] (avg acc x 1)) 98 | ([#?(:cljd ^{:tag #/(List? double)} acc :clj ^doubles acc :cljs ^doubles acc) x w] ; weighted mean 99 | (let [acc (or acc #?(:cljd (double-array 2) :clj (double-array 2) :cljs #js [0.0 0.0]))] 100 | (doto acc 101 | (aset 0 (+ (aget acc 0) w)) 102 | (aset 1 (+ (aget acc 1) (* w x))))))) 103 | 104 | (defn sd 105 | "Reducing fn to compute the standard deviation. Returns 0 if no or only one item." 106 | ([] #?(:cljd (double-array 3) :clj (double-array 3) :cljs #js [0.0 0.0 0.0])) 107 | ([#?(:cljd ^{:tag #/(List double)} a :default ^doubles a)] 108 | (let [s (aget a 0) n (aget a 2)] 109 | (if (< 1 n) 110 | (Math/sqrt (/ s (dec n))) 111 | 0.0))) 112 | ([#?(:cljd ^{:tag #/(List double)} a :default ^doubles a) x] 113 | (let [s (aget a 0) m (aget a 1) n (aget a 2) 114 | d (- x m) 115 | n (inc n) 116 | m' (+ m (/ d n))] 117 | (doto a 118 | (aset 0 (+ s (* d (- x m')))) 119 | (aset 1 m') 120 | (aset 2 n))))) 121 | 122 | (defn last 123 | "Reducing function that returns the last value." 124 | ([] nil) 125 | ([x] x) 126 | ([_ x] x)) 127 | 128 | (defn some 129 | "Reducing function that returns the first logical true value." 130 | ([] nil) 131 | ([x] x) 132 | ([_ x] (when x (reduced x)))) 133 | 134 | (defn str! 135 | "Like xforms/str but returns a StringBuilder." 136 | ([] (#?(:cljd StringBuffer :clj StringBuilder. :cljs StringBuffer.))) 137 | ([sb] (or-instance? #?(:cljd StringBuffer :clj StringBuilder :cljs StringBuffer) sb 138 | (#?(:cljd StringBuffer :clj StringBuilder. :cljs StringBuffer.) (core/str sb)))) 139 | ; the instance? checks are for compatibility with str in case of seeded reduce/transduce. 140 | ([sb x] (doto (or-instance? 141 | #?(:cljd StringBuffer :clj StringBuilder :cljs StringBuffer) sb 142 | (#?(:cljd StringBuffer :clj StringBuilder. :cljs StringBuffer.) (core/str sb))) 143 | (#?(:cljd .write :default .append) x)))) 144 | 145 | (def str 146 | "Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call." 147 | (completing str! core/str)) 148 | 149 | #_(defn juxt 150 | "Returns a reducing fn which compute all rfns at once and whose final return 151 | value is a vector of the final return values of each rfns." 152 | [& rfns] 153 | (let [rfns (mapv ensure-kvrf rfns)] 154 | (kvrf 155 | ([] (mapv #(vector % (volatile! (%))) rfns)) 156 | ([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc)) 157 | ([acc x] 158 | (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]] 159 | (when-not (reduced? @vacc) (vswap! vacc rf x) true)) 160 | false acc)] 161 | (if some-unreduced acc (reduced acc)))) 162 | ([acc k v] 163 | (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]] 164 | (when-not (reduced? @vacc) (vswap! vacc rf k v) true)) 165 | false acc)] 166 | (if some-unreduced acc (reduced acc))))))) 167 | 168 | #_(defn juxt-map 169 | [& key-rfns] 170 | (let [f (apply juxt (take-nth 2 (next key-rfns))) 171 | keys (vec (take-nth 2 key-rfns))] 172 | (let [f (ensure-kvrf f)] 173 | (kvrf 174 | ([] (f)) 175 | ([acc] (zipmap keys (f acc))) 176 | ([acc x] (f acc x)) 177 | ([acc k v] (f acc k v)))))) 178 | ) 179 | -------------------------------------------------------------------------------- /test/net/cgrand/xforms_test.cljc: -------------------------------------------------------------------------------- 1 | (ns net.cgrand.xforms-test 2 | (:refer-clojure :exclude [partition reductions]) 3 | (:require [clojure.test :refer [are is deftest testing]] 4 | [net.cgrand.xforms :as x])) 5 | 6 | (defn trial 7 | "A transducing context for testing that transducers are well-behaved towards 8 | linear use of the accumulator, init, completion and handling of reduced values. 9 | A \"poisonous\" reducing function rf is passed to the transducer. 10 | n is the number of calls to rf before it returns a reduced. 11 | accs is a collection of successive return values for rf." 12 | ([xform n coll] 13 | (trial xform n (repeatedly #(#?(:clj Object. :cljs js/Object.))) coll)) 14 | ([xform n accs coll] 15 | (let [vaccs (volatile! accs) 16 | vstate (volatile! {:n n :acc (first @vaccs) :state :init}) 17 | check-acc (fn [acc] 18 | (when (reduced? acc) 19 | (throw (ex-info "Called with reduced accumulator" (assoc @vstate :actual-acc acc)))) 20 | (when-not (identical? acc (:acc @vstate)) 21 | (throw (ex-info "Called with an unexpected accumulator (either non-linear or out of thin air)" (assoc @vstate :actual-acc acc))))) 22 | rf (fn 23 | ([] 24 | (when-not (= :init (:state @vstate)) 25 | (throw (ex-info "Init arity called on a started or completed rf." @vstate))) 26 | (:acc (vswap! vstate assoc :state :started))) 27 | ([acc] 28 | (when (= :completed (:state @vstate)) 29 | (throw (ex-info "Completion arity called on an already completed rf." @vstate))) 30 | (check-acc acc) 31 | (:acc (vswap! vstate assoc :state :completed :acc (first (vswap! vaccs next))))) 32 | ([acc x] 33 | (when (= :completed (:state @vstate)) 34 | (throw (ex-info "Step arity called on an already completed rf." @vstate))) 35 | (when (= :reduced (:state @vstate)) 36 | (throw (ex-info "Step arity called on a reduced rf." @vstate))) 37 | (check-acc acc) 38 | (let [n (:n @vstate)] 39 | (let [acc (first (vswap! vaccs next))] 40 | (if (pos? n) 41 | (:acc (vswap! vstate assoc :acc acc :n (dec n))) 42 | (reduced (:acc (vswap! vstate assoc :acc acc :state :reduced)))))))) 43 | res (transduce xform rf coll)] 44 | (check-acc res) 45 | (when-not (= :completed (:state @vstate)) 46 | (throw (ex-info "Completion arity never called" @vstate))) 47 | true))) 48 | 49 | (deftest proper-rf-usage 50 | (testing "Ensuring that reducing functions returned by transducers are well-behaved." 51 | (is (trial (x/by-key odd? identity) 52 | 4 (range 16))) 53 | (is (trial (x/by-key odd? identity nil identity) 54 | 4 (range 16))) 55 | (is (trial (x/by-key odd? (take 2)) 56 | 8 (range 16))) 57 | (is (trial (x/by-key odd? identity) 58 | 8 (range 2))) 59 | (is (trial (x/partition 3 identity) 60 | 4 (range 16))) 61 | (is (trial (x/partition 3 (take 2)) 62 | 8 (range 16))) 63 | (is (trial (x/partition 3 (take 2)) 64 | 8 (range 2))) 65 | (is (trial (x/reductions conj []) 66 | 8 (range 2))) 67 | (is (trial (x/reductions conj) 68 | 8 (range 2))) 69 | (is (trial (x/into []) 70 | 4 (range 16))) 71 | (is (trial (x/for [x % y (range x)] [x y]) 72 | 4 (range 16))) 73 | (is (trial (x/reduce +) 74 | 4 (range 16))))) 75 | 76 | (deftest reductions 77 | (is (= (into [] (x/reductions +) (range 10)) [0 0 1 3 6 10 15 21 28 36 45])) 78 | (is (= (into [] (x/reductions +) (range 0)) [0])) 79 | (is (= (into [] (x/reductions +) (range 1)) [0 0])) 80 | (is (= (into [] (x/reductions +) (range 2)) [0 0 1])) 81 | (is (= (into [] (comp (x/reductions +) (take 2)) (range)) [0 0])) 82 | (is (= (into [] (comp (x/reductions +) (take 3)) (range)) [0 0 1])) 83 | (is (= (into [] (comp (take 3) (x/reductions +)) (range)) [0 0 1 3])) 84 | (is (= (into [] (x/reductions (constantly (reduced 42)) 0) (range)) [0 42]))) 85 | 86 | (deftest partition 87 | (is (= (into [] (x/partition 2 1 nil (x/into [])) (range 8)) 88 | [[0 1] [1 2] [2 3] [3 4] [4 5] [5 6] [6 7] [7]])) 89 | (is (= (into [] (x/partition 2 1 (x/into [])) (range 8)) 90 | [[0 1] [1 2] [2 3] [3 4] [4 5] [5 6] [6 7]])) 91 | (is (= (into [] (comp (x/partition 2 2 nil) (x/into [])) (range 8)) 92 | [[[0 1] [2 3] [4 5] [6 7]]]))) 93 | 94 | (deftest without 95 | (is (= {0 :ok 2 :ok 4 :ok 6 :ok 8 :ok} (x/without (zipmap (range 10) (repeat :ok)) (filter odd?) (range 20)))) 96 | (is (= #{0 2 4 6 8 } (x/without (set (range 10)) (filter odd?) (range 20))))) 97 | 98 | #?(:bb nil ;; babashka doesn't currently support calling iterator on range type 99 | :clj 100 | (do 101 | (deftest iterator 102 | (is (true? (.hasNext (x/iterator x/count (.iterator ^java.lang.Iterable (range 5)))))) 103 | (is (is (= [5] (iterator-seq (x/iterator x/count (.iterator ^java.lang.Iterable (range 5))))))) 104 | (is (= [[0 1] [1 2] [2 3] [3 4] [4]] (iterator-seq (x/iterator (x/partition 2 1 nil) (.iterator ^java.lang.Iterable (range 5))))))) 105 | 106 | (deftest window-by-time 107 | (is (= (into 108 | [] 109 | (x/window-by-time :ts 4 110 | (fn 111 | ([] clojure.lang.PersistentQueue/EMPTY) 112 | ([q] (vec q)) 113 | ([q x] (conj q x))) 114 | (fn [q _] (pop q))) 115 | (map (fn [x] {:ts x}) (concat (range 0 2 0.5) (range 3 5 0.25)))) 116 | [[{:ts 0}] ; t = 0 117 | [{:ts 0}] ; t = 0.25 118 | [{:ts 0} {:ts 0.5}] ; t = 0.5 119 | [{:ts 0} {:ts 0.5}] ; t = 0.75 120 | [{:ts 0.5} {:ts 1.0}] ; t = 1.0 121 | [{:ts 0.5} {:ts 1.0}] ; t = 1.25 122 | [{:ts 1.0} {:ts 1.5}] ; t = 1.5 123 | [{:ts 1.0} {:ts 1.5}] ; t = 1.75 124 | [{:ts 1.5}] ; t = 2.0 125 | [{:ts 1.5}] ; t = 2.25 126 | [] ; t = 2.5 127 | [] ; t = 2.75 128 | [{:ts 3}] ; t = 3.0 129 | [{:ts 3} {:ts 3.25}] ; t = 3.25 130 | [{:ts 3} {:ts 3.25} {:ts 3.5}] ; t = 3.5 131 | [{:ts 3} {:ts 3.25} {:ts 3.5} {:ts 3.75}] ; t = 3.75 132 | [{:ts 3.25} {:ts 3.5} {:ts 3.75} {:ts 4.0}] ; t = 4.0 133 | [{:ts 3.5} {:ts 3.75} {:ts 4.0} {:ts 4.25}] ; t = 4.25 134 | [{:ts 3.75} {:ts 4.0} {:ts 4.25} {:ts 4.5}] ; t = 4.5 135 | [{:ts 4.0} {:ts 4.25} {:ts 4.5} {:ts 4.75}]]))))) ; t = 4.75 136 | 137 | (deftest do-not-kvreduce-vectors 138 | (is (= {0 nil 1 nil} (x/into {} (x/for [[k v] %] [k v]) [[0] [1]]))) 139 | (is (= {0 nil 1 nil} (x/into {} (x/for [_ % [k v] [[0] [1]]] [k v]) ["a"])))) 140 | 141 | (deftest sorting 142 | (is (= (range 100) (x/into [] (x/sort) (shuffle (range 100))))) 143 | (is (= (range 100) (x/into [] (x/sort <) (shuffle (range 100))))) 144 | (is (= (reverse (range 100)) (x/into [] (x/sort >) (shuffle (range 100))))) 145 | (is (= (sort-by str (range 100)) (x/into [] (x/sort-by str) (shuffle (range 100))))) 146 | (is (= (sort-by str (comp - compare) (range 100)) (x/into [] (x/sort-by str (comp - compare)) (shuffle (range 100))))) 147 | (is (= (sort-by identity > (shuffle (range 100))) (x/into [] (x/sort-by identity >) (shuffle (range 100)))))) 148 | 149 | (deftest destructuring-pair? 150 | (let [destructuring-pair? #'x/destructuring-pair?] 151 | (are [candidate expected] 152 | (= expected (destructuring-pair? candidate)) 153 | '[a b] true 154 | '[a b c] false 155 | '[& foo] false 156 | '[:as foo] false 157 | 1 false 158 | '(a b) false 159 | '{foo bar} false 160 | '{foo :bar} false))) 161 | 162 | (defmacro wraps-for-with-no-destructuring [] 163 | (x/into [] (x/for [x (range 5)] x))) 164 | 165 | (deftest for-in-macro 166 | (is (= [0 1 2 3 4] (wraps-for-with-no-destructuring)))) 167 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 {} 2 | --------------------------------------------------------------------------------