Mercurial > lasercutter
comparison src/clojure/set.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ; Copyright (c) Rich Hickey. All rights reserved. | |
2 ; The use and distribution terms for this software are covered by the | |
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. | |
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 | |
9 (ns ^{:doc "Set operations such as union/intersection." | |
10 :author "Rich Hickey"} | |
11 clojure.set) | |
12 | |
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 | |
19 (defn union | |
20 "Return a set that is the union of the input sets" | |
21 {:added "1.0"} | |
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" | |
34 {:added "1.0"} | |
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))))) | |
47 | |
48 (defn difference | |
49 "Return a set that is the first set without elements of the remaining sets" | |
50 {:added "1.0"} | |
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)))) | |
62 | |
63 | |
64 (defn select | |
65 "Returns a set of the elements for which pred is true" | |
66 {:added "1.0"} | |
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" | |
73 {:added "1.0"} | |
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" | |
79 {:added "1.0"} | |
80 [map kmap] | |
81 (reduce | |
82 (fn [m [old new]] | |
83 (if (and (not= old new) | |
84 (contains? m old)) | |
85 (-> m (assoc new (get m old)) (dissoc old)) | |
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" | |
91 {:added "1.0"} | |
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." | |
98 {:added "1.0"} | |
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." | |
108 {:added "1.0"} | |
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." | |
115 {:added "1.0"} | |
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 | |
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 | |
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 |