1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/set.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,177 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +(ns ^{:doc "Set operations such as union/intersection."
    1.13 +       :author "Rich Hickey"}
    1.14 +       clojure.set)
    1.15 +
    1.16 +(defn- bubble-max-key [k coll]
    1.17 +  "Move a maximal element of coll according to fn k (which returns a number) 
    1.18 +   to the front of coll."
    1.19 +  (let [max (apply max-key k coll)]
    1.20 +    (cons max (remove #(identical? max %) coll))))
    1.21 +
    1.22 +(defn union
    1.23 +  "Return a set that is the union of the input sets"
    1.24 +  {:added "1.0"}
    1.25 +  ([] #{})
    1.26 +  ([s1] s1)
    1.27 +  ([s1 s2]
    1.28 +     (if (< (count s1) (count s2))
    1.29 +       (reduce conj s2 s1)
    1.30 +       (reduce conj s1 s2)))
    1.31 +  ([s1 s2 & sets]
    1.32 +     (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
    1.33 +       (reduce into (first bubbled-sets) (rest bubbled-sets)))))
    1.34 +
    1.35 +(defn intersection
    1.36 +  "Return a set that is the intersection of the input sets"
    1.37 +  {:added "1.0"}
    1.38 +  ([s1] s1)
    1.39 +  ([s1 s2]
    1.40 +     (if (< (count s2) (count s1))
    1.41 +       (recur s2 s1)
    1.42 +       (reduce (fn [result item]
    1.43 +                   (if (contains? s2 item)
    1.44 +		     result
    1.45 +                     (disj result item)))
    1.46 +	       s1 s1)))
    1.47 +  ([s1 s2 & sets] 
    1.48 +     (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))]
    1.49 +       (reduce intersection (first bubbled-sets) (rest bubbled-sets)))))
    1.50 +
    1.51 +(defn difference
    1.52 +  "Return a set that is the first set without elements of the remaining sets"
    1.53 +  {:added "1.0"}
    1.54 +  ([s1] s1)
    1.55 +  ([s1 s2] 
    1.56 +     (if (< (count s1) (count s2))
    1.57 +       (reduce (fn [result item] 
    1.58 +                   (if (contains? s2 item) 
    1.59 +                     (disj result item) 
    1.60 +                     result))
    1.61 +               s1 s1)
    1.62 +       (reduce disj s1 s2)))
    1.63 +  ([s1 s2 & sets] 
    1.64 +     (reduce difference s1 (conj sets s2))))
    1.65 +
    1.66 +
    1.67 +(defn select
    1.68 +  "Returns a set of the elements for which pred is true"
    1.69 +  {:added "1.0"}
    1.70 +  [pred xset]
    1.71 +    (reduce (fn [s k] (if (pred k) s (disj s k)))
    1.72 +            xset xset))
    1.73 +
    1.74 +(defn project
    1.75 +  "Returns a rel of the elements of xrel with only the keys in ks"
    1.76 +  {:added "1.0"}
    1.77 +  [xrel ks]
    1.78 +    (set (map #(select-keys % ks) xrel)))
    1.79 +
    1.80 +(defn rename-keys
    1.81 +  "Returns the map with the keys in kmap renamed to the vals in kmap"
    1.82 +  {:added "1.0"}
    1.83 +  [map kmap]
    1.84 +    (reduce 
    1.85 +     (fn [m [old new]]
    1.86 +       (if (and (not= old new)
    1.87 +                (contains? m old))
    1.88 +         (-> m (assoc new (get m old)) (dissoc old))
    1.89 +         m)) 
    1.90 +     map kmap))
    1.91 +
    1.92 +(defn rename
    1.93 +  "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap"
    1.94 +  {:added "1.0"}
    1.95 +  [xrel kmap]
    1.96 +    (set (map #(rename-keys % kmap) xrel)))
    1.97 +
    1.98 +(defn index
    1.99 +  "Returns a map of the distinct values of ks in the xrel mapped to a
   1.100 +  set of the maps in xrel with the corresponding values of ks."
   1.101 +  {:added "1.0"}
   1.102 +  [xrel ks]
   1.103 +    (reduce
   1.104 +     (fn [m x]
   1.105 +       (let [ik (select-keys x ks)]
   1.106 +         (assoc m ik (conj (get m ik #{}) x))))
   1.107 +     {} xrel))
   1.108 +   
   1.109 +(defn map-invert
   1.110 +  "Returns the map with the vals mapped to the keys."
   1.111 +  {:added "1.0"}
   1.112 +  [m] (reduce (fn [m [k v]] (assoc m v k)) {} m))
   1.113 +
   1.114 +(defn join
   1.115 +  "When passed 2 rels, returns the rel corresponding to the natural
   1.116 +  join. When passed an additional keymap, joins on the corresponding
   1.117 +  keys."
   1.118 +  {:added "1.0"}
   1.119 +  ([xrel yrel] ;natural join
   1.120 +   (if (and (seq xrel) (seq yrel))
   1.121 +     (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel))))
   1.122 +           [r s] (if (<= (count xrel) (count yrel))
   1.123 +                   [xrel yrel]
   1.124 +                   [yrel xrel])
   1.125 +           idx (index r ks)]
   1.126 +       (reduce (fn [ret x]
   1.127 +                 (let [found (idx (select-keys x ks))]
   1.128 +                   (if found
   1.129 +                     (reduce #(conj %1 (merge %2 x)) ret found)
   1.130 +                     ret)))
   1.131 +               #{} s))
   1.132 +     #{}))
   1.133 +  ([xrel yrel km] ;arbitrary key mapping
   1.134 +   (let [[r s k] (if (<= (count xrel) (count yrel))
   1.135 +                   [xrel yrel (map-invert km)]
   1.136 +                   [yrel xrel km])
   1.137 +         idx (index r (vals k))]
   1.138 +     (reduce (fn [ret x]
   1.139 +               (let [found (idx (rename-keys (select-keys x (keys k)) k))]
   1.140 +                 (if found
   1.141 +                   (reduce #(conj %1 (merge %2 x)) ret found)
   1.142 +                   ret)))
   1.143 +             #{} s))))
   1.144 +
   1.145 +(defn subset? 
   1.146 +  "Is set1 a subset of set2?"
   1.147 +  {:added "1.2",
   1.148 +   :tag Boolean}
   1.149 +  [set1 set2]
   1.150 +  (and (<= (count set1) (count set2))
   1.151 +       (every? set2 set1)))
   1.152 +
   1.153 +(defn superset? 
   1.154 +  "Is set1 a superset of set2?"
   1.155 +  {:added "1.2",
   1.156 +   :tag Boolean}
   1.157 +  [set1 set2]
   1.158 +  (and (>= (count set1) (count set2))
   1.159 +       (every? set1 set2)))
   1.160 +
   1.161 +(comment
   1.162 +(refer 'set)
   1.163 +(def xs #{{:a 11 :b 1 :c 1 :d 4}
   1.164 +         {:a 2 :b 12 :c 2 :d 6}
   1.165 +         {:a 3 :b 3 :c 3 :d 8 :f 42}})
   1.166 +
   1.167 +(def ys #{{:a 11 :b 11 :c 11 :e 5}
   1.168 +         {:a 12 :b 11 :c 12 :e 3}
   1.169 +         {:a 3 :b 3 :c 3 :e 7 }})
   1.170 +
   1.171 +(join xs ys)
   1.172 +(join xs (rename ys {:b :yb :c :yc}) {:a :a})
   1.173 +
   1.174 +(union #{:a :b :c} #{:c :d :e })
   1.175 +(difference #{:a :b :c} #{:c :d :e})
   1.176 +(intersection #{:a :b :c} #{:c :d :e})
   1.177 +
   1.178 +(index ys [:b])
   1.179 +)
   1.180 +