luciano/xforms
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

rfs done for cljd

Browse source
This commit is contained in:
Baptiste Dupuch 2023-07-05 12:10:38 +02:00 committed by Christophe Grand
parent 66f3c1ac59
commit 1e23966d5e
1 changed files with 74 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

119
src/net/cgrand/xforms/rfs.cljc
View file

@ -6,13 +6,16 @@
[net.cgrand.xforms.rfs :refer [or-instance?]]) [net.cgrand.xforms.rfs :refer [or-instance?]])
:clj (:require [net.cgrand.macrovich :as macros])) :clj (:require [net.cgrand.macrovich :as macros]))
(:require [#?(:clj clojure.core :cljs cljs.core) :as core]) (:require [#?(:clj clojure.core :cljs cljs.core) :as core])
#?(:cljd (:require ["dart:math" :as Math]))
#?(:cljs (:import [goog.string StringBuffer]))) #?(:cljs (:import [goog.string StringBuffer])))
(macros/deftime (macros/deftime
(defmacro ^:private or-instance? [class x y] (defmacro ^:private or-instance? [class x y]
(let [xsym (gensym 'x_)] (let [xsym (gensym 'x_)]
`(let [~xsym ~x] `(let [~xsym ~x]
(if (instance? ~class ~xsym) ~(with-meta xsym {:tag class}) ~y))))) (if #?(:cljd (dart/is? ~xsym ~class)
:default (instance? ~class ~xsym))
~(with-meta xsym {:tag class}) ~y)))))
(declare str!) (declare str!)
@ -26,42 +29,61 @@
r -1 r -1
(f b a) 1 (f b a) 1
:else 0)))) :else 0))))
(defn minimum (defn minimum
([#?(:clj ^java.util.Comparator comparator :cljs comparator)] ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator)]
(fn (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])]
([] nil) (fn
([x] x) ([] nil)
([a b] (cond ([x] x)
(nil? a) b ([a b] (cond
(nil? b) a (nil? a) b
(pos? (#?(:clj .compare :cljs cmp) comparator a b)) b (nil? b) a
:else a)))) (pos? #?(:cljd (comparator a b)
([#?(:clj ^java.util.Comparator comparator :cljs comparator) absolute-maximum] :clj (.compare comparator a b)
(fn :cljs (cmp comparator a b))) b
([] ::+infinity) :else a)))))
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::+infinity x) ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator) absolute-maximum]
absolute-maximum (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])]
x)) (fn
([a b] (if (or (#?(:clj identical? :cljs keyword-identical?) ::+infinity a) (pos? (#?(:clj .compare :cljs cmp) comparator a b))) b a))))) ([] ::+infinity)
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::+infinity x)
absolute-maximum
x))
([a b]
(if (or
(#?(:clj identical? :cljs keyword-identical?) ::+infinity a)
(pos? #?(:cljd (comparator a b)
:clj (.compare comparator a b)
:cljs (cmp comparator a b))))
b a))))))
(defn maximum (defn maximum
([#?(:clj ^java.util.Comparator comparator :cljs comparator)] ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator)]
(fn (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])]
([] nil) (fn
([x] x) ([] nil)
([a b] (cond ([x] x)
(nil? a) b ([a b] (cond
(nil? b) a (nil? a) b
(neg? (#?(:clj .compare :cljs cmp) comparator a b)) b (nil? b) a
:else a)))) (neg? #?(:cljd (comparator a b)
([#?(:clj ^java.util.Comparator comparator :cljs comparator) absolute-minimum] :clj (.compare comparator a b)
(fn :cljs (cmp comparator a b))) b
([] ::-infinity) :else a)))))
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::-infinity x) ([#?(:cljd comparator :clj ^java.util.Comparator comparator :cljs comparator) absolute-minimum]
absolute-minimum (let [#?@(:cljd [comparator (dart-comparator comparator)] :default [])]
x)) (fn
([a b] (if (or (#?(:clj identical? :cljs keyword-identical?) ::-infinity a) (neg? (#?(:clj .compare :cljs cmp) comparator a b))) b a))))) ([] ::-infinity)
([x] (if (#?(:clj identical? :cljs keyword-identical?) ::-infinity x)
absolute-minimum
x))
([a b]
(if (or (#?(:clj identical? :cljs keyword-identical?) ::-infinity a)
(neg? #?(:cljd (comparator a b)
:clj (.compare comparator a b)
:cljs (cmp comparator a b))))
b a))))))
(def min (minimum compare)) (def min (minimum compare))
@ -70,23 +92,24 @@
(defn avg (defn avg
"Reducing fn to compute the arithmetic mean." "Reducing fn to compute the arithmetic mean."
([] nil) ([] nil)
([^doubles acc] (when acc (/ (aget acc 1) (aget acc 0)))) ([#?(:cljd ^{:tag #/(List double)} acc :clj ^doubles acc :cljs ^doubles acc)]
(when acc (/ (aget acc 1) (aget acc 0))))
([acc x] (avg acc x 1)) ([acc x] (avg acc x 1))
([^doubles acc x w] ; weighted mean ([#?(:cljd ^{:tag #/(List double)} acc :clj ^doubles acc :cljs ^doubles acc) x w]
(let [acc (or acc #?(:clj (double-array 3) :cljs #js [0.0 0.0]))] (let [acc (or acc #?(:cljd (double-array 2) :clj (double-array 2) :cljs #js [0.0 0.0]))]
(doto acc (doto acc
(aset 0 (+ (aget acc 0) w)) (aset 0 (+ (aget acc 0) w))
(aset 1 (+ (aget acc 1) (* w x))))))) (aset 1 (+ (aget acc 1) (* w x)))))))
(defn sd (defn sd
"Reducing fn to compute the standard deviation. Returns 0 if no or only one item." "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])) ([] #?(:cljd (double-array 3) :clj (double-array 3) :cljs #js [0.0 0.0 0.0]))
([^doubles a] ([#?(:cljd ^{:tag #/(List double)} a :default ^doubles a)]
(let [s (aget a 0) n (aget a 2)] (let [s (aget a 0) n (aget a 2)]
(if (< 1 n) (if (< 1 n)
(Math/sqrt (/ s (dec n))) (Math/sqrt (/ s (dec n)))
0.0))) 0.0)))
([^doubles a x] ([#?(:cljd ^{:tag #/(List double)} a :default ^doubles a) x]
(let [s (aget a 0) m (aget a 1) n (aget a 2) (let [s (aget a 0) m (aget a 1) n (aget a 2)
d (- x m) d (- x m)
n (inc n) n (inc n)
@ -110,9 +133,15 @@
(defn str! (defn str!
"Like xforms/str but returns a StringBuilder." "Like xforms/str but returns a StringBuilder."
([] (#?(:clj StringBuilder. :cljs StringBuffer.))) ([] (#?(:cljd StringBuffer :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] (or-instance? #?(:cljd StringBuffer :clj StringBuilder :cljs StringBuffer) sb
([sb x] (.append (or-instance? #?(:clj StringBuilder :cljs StringBuffer) sb (#?(:clj StringBuilder. :cljs StringBuffer.) (core/str sb))) x))) (#?(:cljd StringBuffer :clj StringBuilder. :cljs StringBuffer.) (core/str sb))))
; the instance? checks are for compatibility with str in case of seeded reduce/transduce.
([sb x] (#?(:cljd .write :default .append)
(or-instance?
#?(:cljd StringBuffer :clj StringBuilder :cljs StringBuffer) sb
(#?(:cljd StringBuffer :clj StringBuilder. :cljs StringBuffer.) (core/str sb)))
x)))
(def str (def str
"Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call." "Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call."
@ -127,12 +156,12 @@
([] (mapv #(vector % (volatile! (%))) rfns)) ([] (mapv #(vector % (volatile! (%))) rfns))
([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc)) ([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc))
([acc x] ([acc x]
(let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]] (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf x) true)) (when-not (reduced? @vacc) (vswap! vacc rf x) true))
false acc)] false acc)]
(if some-unreduced acc (reduced acc)))) (if some-unreduced acc (reduced acc))))
([acc k v] ([acc k v]
(let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]] (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf k v) true)) (when-not (reduced? @vacc) (vswap! vacc rf k v) true))
false acc)] false acc)]
(if some-unreduced acc (reduced acc))))))) (if some-unreduced acc (reduced acc)))))))