f5455115a0
Running clojure.core.match (a macro-heavy library that builds its compiler out of deftypes implementing clojure.lang interfaces) shook out a cluster of general gaps. Its own suite goes from not-loading to 111/115 assertions. - deftype/defrecord implementing a clojure.lang collection interface now drives the core fns: Indexed -> nth, Counted -> count, Associative -> assoc, ILookup -> get/valAt (non-field keys only, so a method's own field bindings don't recurse), ISeq -> seq/first/rest, IPersistentCollection -> conj, IFn -> the value is callable. A jrec is still a map of fields by default; the interface method wins when declared. - Multi-arity inline methods are grouped into one fn (a type with (nth [_ i]) and (nth [_ i x]) kept only the last before). Built as data, not a nested syntax-quote, so a `(= ~ocr ~l) method body keeps its unquotes. - instance?/satisfies? recognize a protocol a type implements, including a MARKER protocol with no methods (core.match's IPseudoPattern) — deftype/defrecord now record protocol satisfaction even with zero methods. Added ILookup/Indexed/ Counted to the instance? taxonomy for the built-in collections. - Syntax-quote: a fully-qualified class name (clojure.lang.ILookup) stays bare instead of being namespace-qualified; (unquote x) is detected in a lazy seq (a macro that builds its template with map, e.g. deftype's rewrite-set). - clojure.set union/intersection/difference are variadic (& sets) + union 0-arity. - java map view methods: keySet/values/entrySet/size/isEmpty. - deprecated java.util.Date getters (getYear/getMonth/...) + the multi-arg (Date. year-1900 month0 date hrs min) constructor. Seed change (deftype/defrecord macros + clojure.set) -> re-minted; the rest are runtime. 11 JVM-certified corpus rows; make test + shakesmoke green.
87 lines
2.5 KiB
Clojure
87 lines
2.5 KiB
Clojure
; Jolt Standard Library: clojure.set
|
|
; Set operations.
|
|
|
|
(defn union
|
|
([] #{})
|
|
([s1] s1)
|
|
([s1 s2] (if (< (count s1) (count s2)) (reduce conj s2 s1) (reduce conj s1 s2)))
|
|
([s1 s2 & sets] (reduce union (union s1 s2) sets)))
|
|
|
|
(defn intersection
|
|
([s1] s1)
|
|
([s1 s2]
|
|
(reduce (fn [acc item] (if (contains? s2 item) acc (disj acc item))) s1 s1))
|
|
([s1 s2 & sets] (reduce intersection (intersection s1 s2) sets)))
|
|
|
|
(defn difference
|
|
([s1] s1)
|
|
([s1 s2] (reduce disj s1 s2))
|
|
([s1 s2 & sets] (reduce difference (difference s1 s2) sets)))
|
|
|
|
(defn select
|
|
[pred s]
|
|
(reduce (fn [acc item] (if (pred item) acc (disj acc item))) s s))
|
|
|
|
(defn project
|
|
[xrel ks]
|
|
(set (map #(select-keys % ks) xrel)))
|
|
|
|
(defn rename-keys
|
|
[map kmap]
|
|
(reduce (fn [m [old new]]
|
|
(if (contains? map old)
|
|
(assoc m new (get map old))
|
|
m))
|
|
(apply dissoc map (keys kmap))
|
|
kmap))
|
|
|
|
(defn map-invert
|
|
[m]
|
|
(reduce (fn [acc [k v]] (assoc acc v k)) {} m))
|
|
|
|
(defn rename
|
|
[xrel kmap]
|
|
(set (map (fn [m]
|
|
(reduce (fn [acc [old new]] (if (contains? m old) (assoc acc new (get m old)) acc))
|
|
(apply dissoc m (keys kmap)) kmap)) xrel)))
|
|
|
|
(defn index
|
|
[xrel ks]
|
|
(reduce (fn [m x] (let [ik (select-keys x ks)] (assoc m ik (conj (get m ik #{}) x)))) {} xrel))
|
|
|
|
(defn join
|
|
"When passed 2 rels, returns the rel corresponding to the natural join.
|
|
When passed an additional keymap, joins on the corresponding keys."
|
|
([xrel yrel]
|
|
(if (and (seq xrel) (seq yrel))
|
|
(let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel))))
|
|
[r s] (if (<= (count xrel) (count yrel)) [xrel yrel] [yrel xrel])
|
|
idx (index r ks)]
|
|
(reduce (fn [ret x]
|
|
(let [found (idx (select-keys x ks))]
|
|
(if found
|
|
(reduce (fn [acc y] (conj acc (merge y x))) ret found)
|
|
ret)))
|
|
#{} s))
|
|
#{}))
|
|
([xrel yrel km]
|
|
(let [[r s k] (if (<= (count xrel) (count yrel))
|
|
[xrel yrel (map-invert km)]
|
|
[yrel xrel km])
|
|
idx (index r (vals k))]
|
|
(reduce (fn [ret x]
|
|
(let [found (idx (rename-keys (select-keys x (keys k)) k))]
|
|
(if found
|
|
(reduce (fn [acc y] (conj acc (merge y x))) ret found)
|
|
ret)))
|
|
#{} s))))
|
|
|
|
(defn subset?
|
|
[set1 set2]
|
|
(and (<= (count set1) (count set2))
|
|
(every? #(contains? set2 %) set1)))
|
|
|
|
(defn superset?
|
|
[set1 set2]
|
|
(and (>= (count set1) (count set2))
|
|
(every? #(contains? set1 %) set2)))
|