/
rfs.cljc
150 lines (134 loc) · 4.96 KB
/
rfs.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
(ns net.cgrand.xforms.rfs
{:author "Christophe Grand"}
(:refer-clojure :exclude [str last min max some])
#?(:cljs (:require-macros
[net.cgrand.macrovich :as macros]
[net.cgrand.xforms.rfs :refer [or-instance?]])
:clj (:require [net.cgrand.macrovich :as macros]))
(:require [#?(:clj clojure.core :cljs cljs.core) :as core])
#?(:cljs (:import [goog.string StringBuffer])))
(macros/deftime
(defmacro ^:private or-instance? [class x y]
(let [xsym (gensym 'x_)]
`(let [~xsym ~x]
(if (instance? ~class ~xsym) ~(with-meta xsym {:tag class}) ~y)))))
(declare str!)
(macros/usetime
#? (:cljs
(defn ^:private cmp [f a b]
(let [r (f a b)]
(cond
(number? r) r
r -1
(f b a) 1
:else 0))))
(defn minimum
([#?(:clj ^java.util.Comparator comparator :cljs comparator)]
(fn
([] nil)
([x] x)
([a b] (cond
(nil? a) b
(nil? b) a
(pos? (#?(:clj .compare :cljs cmp) comparator a b)) b
:else a))))
([#?(:clj ^java.util.Comparator comparator :cljs comparator) absolute-maximum]
(fn
([] ::+∞)
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::+∞ x)
absolute-maximum
x))
([a b] (if (or (#?(:clj identical? :cljs keyword-identical?) ::+∞ a) (pos? (#?(:clj .compare :cljs cmp) comparator a b))) b a)))))
(defn maximum
([#?(:clj ^java.util.Comparator comparator :cljs comparator)]
(fn
([] nil)
([x] x)
([a b] (cond
(nil? a) b
(nil? b) a
(neg? (#?(:clj .compare :cljs cmp) comparator a b)) b
:else a))))
([#?(:clj ^java.util.Comparator comparator :cljs comparator) absolute-minimum]
(fn
([] ::-∞)
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::-∞ x)
absolute-minimum
x))
([a b] (if (or (#?(:clj identical? :cljs keyword-identical?) ::-∞ a) (neg? (#?(:clj .compare :cljs cmp) comparator a b))) b a)))))
(def min (minimum compare))
(def max (maximum compare))
(defn avg
"Reducing fn to compute the arithmetic mean."
([] nil)
([^doubles acc] (when acc (/ (aget acc 1) (aget acc 0))))
([acc x] (avg acc x 1))
([^doubles acc x w] ; weighted mean
(let [acc (or acc #?(:clj (double-array 3) :cljs #js [0.0 0.0]))]
(doto acc
(aset 0 (+ (aget acc 0) w))
(aset 1 (+ (aget acc 1) (* w x)))))))
(defn sd
"Reducing fn to compute the standard deviation. Returns 0 if no or only one item."
([] #?(:clj (double-array 3) :cljs #js [0.0 0.0 0.0]))
([^doubles a]
(let [s (aget a 0) n (aget a 2)]
(if (< 1 n)
(Math/sqrt (/ s (dec n)))
0.0)))
([^doubles a x]
(let [s (aget a 0) m (aget a 1) n (aget a 2)
d (- x m)
n (inc n)
m' (+ m (/ d n))]
(doto a
(aset 0 (+ s (* d (- x m'))))
(aset 1 m')
(aset 2 n)))))
(defn last
"Reducing function that returns the last value."
([] nil)
([x] x)
([_ x] x))
(defn some
"Reducing function that returns the first logical true value."
([] nil)
([x] x)
([_ x] (when x (reduced x))))
(defn str!
"Like xforms/str but returns a StringBuilder."
([] (#?(:clj StringBuilder. :cljs StringBuffer.)))
([sb] (or-instance? #?(:clj StringBuilder :cljs StringBuffer) sb (#?(:clj StringBuilder. :cljs StringBuffer.) (core/str sb)))) ; the instance? checks are for compatibility with str in case of seeded reduce/transduce.
([sb x] (.append (or-instance? #?(:clj StringBuilder :cljs StringBuffer) sb (#?(:clj StringBuilder. :cljs StringBuffer.) (core/str sb))) x)))
(def str
"Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call."
(completing str! core/str))
#_(defn juxt
"Returns a reducing fn which compute all rfns at once and whose final return
value is a vector of the final return values of each rfns."
[& rfns]
(let [rfns (mapv ensure-kvrf rfns)]
(kvrf
([] (mapv #(vector % (volatile! (%))) rfns))
([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc))
([acc x]
(let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf x) true))
false acc)]
(if some-unreduced acc (reduced acc))))
([acc k v]
(let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf k v) true))
false acc)]
(if some-unreduced acc (reduced acc)))))))
#_(defn juxt-map
[& key-rfns]
(let [f (apply juxt (take-nth 2 (next key-rfns)))
keys (vec (take-nth 2 key-rfns))]
(let [f (ensure-kvrf f)]
(kvrf
([] (f))
([acc] (zipmap keys (f acc)))
([acc x] (f acc x))
([acc k v] (f acc k v))))))
)