Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 178 lines (156 sloc) 5.225 kb
d59defe9 »
2008-07-29 moved clj files into src/clj/
1 ; Copyright (c) Rich Hickey. All rights reserved.
2 ; The use and distribution terms for this software are covered by the
cad4fcf1 »
2008-12-14 Moved to Eclipse Public License - see epl-v10.html or
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
d59defe9 »
2008-07-29 moved clj files into src/clj/
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
78793836 »
2010-04-26 replace #^s with ^s
9 (ns ^{:doc "Set operations such as union/intersection."
76e7c431 »
2009-12-03 Add :doc and :author metadata to core namespaces; fixes #216, fixes #217
10 :author "Rich Hickey"}
11 clojure.set)
d59defe9 »
2008-07-29 moved clj files into src/clj/
12
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
13 (defn- bubble-max-key [k coll]
14 "Move a maximal element of coll according to fn k (which returns a number)
15 to the front of coll."
16 (let [max (apply max-key k coll)]
17 (cons max (remove #(identical? max %) coll))))
18
d59defe9 »
2008-07-29 moved clj files into src/clj/
19 (defn union
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
20 "Return a set that is the union of the input sets"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
21 {:added "1.0"}
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
22 ([] #{})
23 ([s1] s1)
24 ([s1 s2]
25 (if (< (count s1) (count s2))
26 (reduce conj s2 s1)
27 (reduce conj s1 s2)))
28 ([s1 s2 & sets]
29 (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
30 (reduce into (first bubbled-sets) (rest bubbled-sets)))))
31
32 (defn intersection
33 "Return a set that is the intersection of the input sets"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
34 {:added "1.0"}
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
35 ([s1] s1)
36 ([s1 s2]
37 (if (< (count s2) (count s1))
38 (recur s2 s1)
39 (reduce (fn [result item]
40 (if (contains? s2 item)
41 result
42 (disj result item)))
43 s1 s1)))
44 ([s1 s2 & sets]
45 (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))]
46 (reduce intersection (first bubbled-sets) (rest bubbled-sets)))))
d59defe9 »
2008-07-29 moved clj files into src/clj/
47
48 (defn difference
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
49 "Return a set that is the first set without elements of the remaining sets"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
50 {:added "1.0"}
60e805dc »
2009-02-12 added multi-arg clojure.set/union/difference/intersection, patch from…
51 ([s1] s1)
52 ([s1 s2]
53 (if (< (count s1) (count s2))
54 (reduce (fn [result item]
55 (if (contains? s2 item)
56 (disj result item)
57 result))
58 s1 s1)
59 (reduce disj s1 s2)))
60 ([s1 s2 & sets]
61 (reduce difference s1 (conj sets s2))))
d59defe9 »
2008-07-29 moved clj files into src/clj/
62
63
64 (defn select
65 "Returns a set of the elements for which pred is true"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
66 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
67 [pred xset]
68 (reduce (fn [s k] (if (pred k) s (disj s k)))
69 xset xset))
70
71 (defn project
72 "Returns a rel of the elements of xrel with only the keys in ks"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
73 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
74 [xrel ks]
75 (set (map #(select-keys % ks) xrel)))
76
77 (defn rename-keys
78 "Returns the map with the keys in kmap renamed to the vals in kmap"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
79 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
80 [map kmap]
81 (reduce
82 (fn [m [old new]]
b8d28920 »
2010-01-27 Correct behavior of clojure.set/rename-keys. Issue #145.
83 (if (and (not= old new)
84 (contains? m old))
a0704003 »
2010-06-30 Fix rename-keys to work with defrecords
85 (-> m (assoc new (get m old)) (dissoc old))
d59defe9 »
2008-07-29 moved clj files into src/clj/
86 m))
87 map kmap))
88
89 (defn rename
90 "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap"
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
91 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
92 [xrel kmap]
93 (set (map #(rename-keys % kmap) xrel)))
94
95 (defn index
96 "Returns a map of the distinct values of ks in the xrel mapped to a
97 set of the maps in xrel with the corresponding values of ks."
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
98 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
99 [xrel ks]
100 (reduce
101 (fn [m x]
102 (let [ik (select-keys x ks)]
103 (assoc m ik (conj (get m ik #{}) x))))
104 {} xrel))
105
106 (defn map-invert
107 "Returns the map with the vals mapped to the keys."
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
108 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
109 [m] (reduce (fn [m [k v]] (assoc m v k)) {} m))
110
111 (defn join
112 "When passed 2 rels, returns the rel corresponding to the natural
113 join. When passed an additional keymap, joins on the corresponding
114 keys."
59b65669 »
2010-04-29 added 1.0, test all public doc-ed fns have :added
115 {:added "1.0"}
d59defe9 »
2008-07-29 moved clj files into src/clj/
116 ([xrel yrel] ;natural join
117 (if (and (seq xrel) (seq yrel))
118 (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel))))
119 [r s] (if (<= (count xrel) (count yrel))
120 [xrel yrel]
121 [yrel xrel])
122 idx (index r ks)]
123 (reduce (fn [ret x]
124 (let [found (idx (select-keys x ks))]
125 (if found
126 (reduce #(conj %1 (merge %2 x)) ret found)
127 ret)))
128 #{} s))
129 #{}))
130 ([xrel yrel km] ;arbitrary key mapping
131 (let [[r s k] (if (<= (count xrel) (count yrel))
132 [xrel yrel (map-invert km)]
133 [yrel xrel km])
134 idx (index r (vals k))]
135 (reduce (fn [ret x]
136 (let [found (idx (rename-keys (select-keys x (keys k)) k))]
137 (if found
138 (reduce #(conj %1 (merge %2 x)) ret found)
139 ret)))
140 #{} s))))
141
f769f565 »
2010-05-05 promote Jason Wolfe's superset?, subset? #338
142 (defn subset?
143 "Is set1 a subset of set2?"
144 {:added "1.2",
145 :tag Boolean}
146 [set1 set2]
147 (and (<= (count set1) (count set2))
148 (every? set2 set1)))
149
150 (defn superset?
151 "Is set1 a superset of set2?"
152 {:added "1.2",
153 :tag Boolean}
154 [set1 set2]
155 (and (>= (count set1) (count set2))
156 (every? set1 set2)))
157
d59defe9 »
2008-07-29 moved clj files into src/clj/
158 (comment
159 (refer 'set)
160 (def xs #{{:a 11 :b 1 :c 1 :d 4}
161 {:a 2 :b 12 :c 2 :d 6}
162 {:a 3 :b 3 :c 3 :d 8 :f 42}})
163
164 (def ys #{{:a 11 :b 11 :c 11 :e 5}
165 {:a 12 :b 11 :c 12 :e 3}
166 {:a 3 :b 3 :c 3 :e 7 }})
167
168 (join xs ys)
169 (join xs (rename ys {:b :yb :c :yc}) {:a :a})
170
171 (union #{:a :b :c} #{:c :d :e })
172 (difference #{:a :b :c} #{:c :d :e})
173 (intersection #{:a :b :c} #{:c :d :e})
174
175 (index ys [:b])
176 )
177
Something went wrong with that request. Please try again.