Add a set library to Basilisp (#261)

* Add a set library to Basilisp

* basilisp.set/index function

* Index function

* Partial join implementation

* Not implemented join arity

* Add gitattributes

* Fix test runner reporting errors as failures

* Fix set lib

Author: chrisrink10

src/basilisp/lang/set.py

@@ -34,6 +34,18 @@ def __contains__(self, item):
     def __eq__(self, other):
         return self._inner == other
 
+    def __ge__(self, other):
+        return self._inner >= other
+
+    def __gt__(self, other):
+        return self._inner > other
+
+    def __le__(self, other):
+        return self._inner <= other
+
+    def __lt__(self, other):
+        return self._inner < other
+
     def __hash__(self):
         return hash(self._inner)
 
@@ -43,6 +55,39 @@ def __iter__(self):
     def __len__(self):
         return len(self._inner)
 
+    def difference(self, *others):
+        e = self._inner
+        for other in others:
+            e = e.difference(other)
+        return Set(e)
+
+    def intersection(self, *others):
+        e = self._inner
+        for other in others:
+            e = e.intersection(other)
+        return Set(e)
+
+    def symmetric_difference(self, *others):
+        e = self._inner
+        for other in others:
+            e = e.symmetric_difference(other)
+        return Set(e)
+
+    def union(self, *others):
+        e = self._inner
+        for other in others:
+            e = e.union(other)
+        return Set(e)
+
+    def isdisjoint(self, s):
+        return self._inner.isdisjoint(s)
+
+    def issuperset(self, other):
+        return self._inner >= other
+
+    def issubset(self, other):
+        return self._inner <= other
+
     @property
     def meta(self) -> Optional[Map]:
         return self._meta

src/basilisp/set.lpy

@@ -0,0 +1,154 @@
+(ns basilisp.set)
+
+(defn difference
+  "Return a new set with elements from s1 not in the others.
+  If no others are provided, return s."
+  ([s] s)
+  ([s1 & others]
+   (apply-method s1 difference others)))
+
+(defn disjoint?
+  "Return true if s1 shares no common elements with s2.
+
+  Sets are considered disjoint if and only if their intersection
+  is the empty set."
+  [s1 s2]
+  (.isdisjoint s1 s2))
+
+(defn index
+  "Given a set of maps, return a mapping of unique selections of keys
+  from ks to the set of values which have those mappings."
+  [rel ks]
+  (if-not (seq rel)
+    {}
+    (reduce (fn [m v]
+              (let [index-val (select-keys v ks)]
+                (if (contains? m index-val)
+                  (update m index-val conj v)
+                  (assoc m index-val #{v}))))
+            {}
+            rel)))
+
+(defn intersection
+  "Return a new set with only elements in s1 that are in all
+  the others. If no others are provided, return s."
+  ([s] s)
+  ([s1 & others]
+   (apply-method s1 intersection others)))
+
+(defn map-invert
+  "Return a map whose vals and keys are swapped.
+
+  Duplicate values used as keys will overwrite each other as
+  iteration order is non-deterministic."
+  [m]
+  (if-not (seq m)
+    m
+    (reduce (fn [m entry]
+              (assoc m (val entry) (key entry)))
+            {}
+            m)))
+
+(defn project
+  "Given a set of maps, return a set of those maps with only the keys in ks."
+  [rel ks]
+  (set (map #(select-keys % ks) rel)))
+
+(defn rename-keys
+  "Return m with any keys appearing in kmap replaced with the value
+  in kmap."
+  [m kmap]
+  (if-not (seq m)
+    m
+    (reduce (fn [m entry]
+              (let [orig-k (key entry)
+                    new-k  (val entry)]
+                (if (contains? m orig-k)
+                  (let [v         (get m orig-k)
+                        clean-map (dissoc m orig-k)]
+                    (assoc clean-map new-k v))
+                  m)))
+            m
+            kmap)))
+
+(defn rename
+  "Given a set of maps, return a set whose maps have had any keys in kmap
+  renamed to the value in kmap."
+  [rel kmap]
+  (set (map #(rename-keys % kmap) rel)))
+
+(defn select
+  "Return a set of values for which pred is true."
+  [pred xset]
+  (set (filter pred xset)))
+
+(defn symmetric-difference
+  "Return a new set with elements which are not shared by any of
+  the s1 and others. If no others are provided, return s."
+  ([s] s)
+  ([s1 & others]
+   (apply-method s1 symmetric-difference others)))
+
+(defn subset?
+  "Return true if every element in s1 is also in s2."
+  [s1 s2]
+  (.issubset s1 s2))
+
+(defn superset?
+  "Return true if every element in s2 is also in s1."
+  [s1 s2]
+  (.issuperset s1 s2))
+
+(defn union
+  "Return a new set with elements in s1 that are in the others.
+  If no others are provided, return s."
+  ([s] s)
+  ([s1 & others]
+   (apply-method s1 union others)))
+
+(defn ^:private product
+  "Generate the Cartesian product of sets l and r, calling (f left right)
+  on each relation. Returns a set of all returned elements."
+  [f l r]
+  (set
+   (mapcat (fn [l-elem]
+          (map #(f l-elem %) r))
+        l)))
+
+(defn join
+  "Perform a natural join on the maps in lrel and rrel using keys shared
+  by elements of each relation. If ks is specified, join only on the given
+  keys."
+  ([lrel rrel]
+   (let [shared (vec
+                 (intersection
+                  (apply intersection (map (comp set keys) lrel))
+                  (apply intersection (map (comp set keys) rrel))))
+
+         lindex (index lrel shared)
+         rindex (index rrel shared)]
+     (if-not (seq lindex)
+       #{}
+       (reduce (fn [s [k l-indexed]]
+                 (if (contains? rindex k)
+                   (apply conj s (product merge l-indexed (get rindex k)))
+                   s))
+               #{}
+               lindex))))
+  ([lrel rrel keymap]
+   (let [[f s ks] (if (<= (count lrel) (count rrel))
+                    [lrel rrel (map-invert keymap)]
+                    [rrel lrel keymap])
+         idx      (index f (vals ks))]
+     (if-not (seq s)
+       #{}
+       (reduce (fn [ret x]
+                 (let [match (idx (rename-keys (select-keys x (keys ks)) ks))]
+                   (if match
+                     (reduce (fn [s v]
+                               (conj s (merge v x)))
+                             ret
+                             match)
+                     ret)))
+               #{}
+               s)))))

tests/basilisp/test_multifn.lpy

@@ -1,4 +1,4 @@
-(ns basilisp.multifn-test
+(ns basilisp.test-multifn
   (:require
    [basilisp.test :refer [deftest is testing]]))
 

tests/basilisp/test_set.lpy

@@ -0,0 +1,107 @@
+(ns basilisp.test-set
+  (:require
+   [basilisp.set :as set]
+   [basilisp.test :refer [deftest is testing]]))
+
+(deftest difference-test
+  (is (= #{:a :b :c} (set/difference #{:a :b :c})))
+  (is (= #{:a :b} (set/difference #{:a :b :c} #{:c :d :e})))
+  (is (= #{:a} (set/difference #{:a :b :c} #{:c :d} #{:b "z" 3}))))
+
+(deftest disjoint?-test
+  (is (not (set/disjoint? #{:a :b :c} #{:c :d :e})))
+  (is (set/disjoint? #{:a :b :c} #{:d :e :f})))
+
+(deftest index-test
+  (is (= {} (set/index #{} [:weight])))
+  (is (= {{:weight 100} #{{:name "Gary" :weight 100}
+                          {:name "Darla" :weight 100}}
+          {:weight 50}  #{{:name "Karl" :weight 50}}}
+         (set/index #{{:name "Gary" :weight 100}
+                      {:name "Darla" :weight 100}
+                      {:name "Karl" :weight 50}}
+                    [:weight]))))
+
+(deftest intersection-test
+  (is (= #{:a :b :c} (set/intersection #{:a :b :c})))
+  (is (= #{:c} (set/intersection #{:a :b :c} #{:c :d :e})))
+  (is (= #{} (set/intersection #{:a :b :c} #{:c :d} #{:b "z" 3}))))
+
+(deftest join-test
+  (testing "natural join"
+    (is (= #{{:b 1 :a 2}
+             {:b 2 :a 1}
+             {:b 2 :a 2}
+             {:b 1 :a 1}}
+           (set/join #{{:a 1} {:a 2}}
+                     #{{:b 1} {:b 2}})))
+    (is (= #{{:owner "Jeff" :manufacturer "Apple" :kind "laptop" :use "travel"}
+             {:owner "Anna" :manufacturer "Dell", :kind "laptop" :use "travel"}
+             {:owner "Dinesh" :manufacturer "HP", :kind "desktop" :use "workstation"}}
+           (set/join #{{:manufacturer "Dell" :owner "Anna" :kind "laptop"}
+                       {:manufacturer "HP" :owner "Dinesh" :kind "desktop"}
+                       {:manufacturer "Apple" :owner "Jeff" :kind "laptop"}}
+                     #{{:kind "desktop" :use "workstation"}
+                       {:kind "laptop" :use "travel"}}))))
+
+  (testing "keymap join"
+    (is (= #{{:owner "Jeff" :manufacturer "Apple" :kind "laptop" :type "laptop" :use "travel"}
+             {:owner "Anna" :manufacturer "Dell", :kind "laptop" :type "laptop" :use "travel"}
+             {:owner "Dinesh" :manufacturer "HP", :kind "desktop" :type "desktop" :use "workstation"}}
+           (set/join #{{:manufacturer "Dell" :owner "Anna" :kind "laptop"}
+                       {:manufacturer "HP" :owner "Dinesh" :kind "desktop"}
+                       {:manufacturer "Apple" :owner "Jeff" :kind "laptop"}}
+                     #{{:type "desktop" :use "workstation"}
+                       {:type "laptop" :use "travel"}}
+                     {:kind :type})))))
+
+(deftest map-invert-test
+  (is (= {} (set/map-invert {})))
+  (is (= {"a" :a} (set/map-invert {:a "a"})))
+  (is (= {3 :b 's :a} (set/map-invert {:a 's :b 3}))))
+
+(deftest project-test
+  (is (= #{} (set/project #{} [:a :b :c])))
+  (is (= #{{:a "a"} {:a "A"}}
+         (set/project #{{:a "a" :d "e"} {:a "A" :z "p"}}
+                      [:a :b :c]))))
+
+(deftest rename-keys-test
+  (is (= {} (set/rename-keys {} {:a :new-a})))
+  (is (= {:new-a "a"} (set/rename-keys {:a "a"} {:a :new-a})))
+  (is (= {:a "a"} (set/rename-keys {:a "a"} {:b :new-b})))
+  (is (= {:a "a" :new-b "b"} (set/rename-keys {:a "a" :b "b"} {:b :new-b}))))
+
+(deftest rename-test
+  (is (= #{} (set/rename #{} {:a :new-a})))
+  (is (= #{{:new-a "a"}} (set/rename #{{:a "a"}} {:a :new-a})))
+  (is (= #{{:a "a"}} (set/rename #{{:a "a"}} {:b :new-b})))
+  (is (= #{{:a "a" :new-b "b"}} (set/rename #{{:a "a" :b "b"}} {:b :new-b})))
+  (is (= #{{:a "a" :new-b "b"} {:a "A" :new-b "B"}}
+         (set/rename #{{:a "a" :b "b"} {:a "A" :b "B"}}
+                     {:b :new-b}))))
+
+(deftest select-test
+  (is (= #{} (set/select odd? #{})))
+  (is (= #{1 3} (set/select odd? #{1 2 3})))
+  (is (= #{2} (set/select even? #{1 2 3})))
+  (is (= #{1 2 3} (set/select identity #{1 2 3}))))
+
+(deftest symmetric-difference-test
+  (is (= #{:a :b :c} (set/symmetric-difference #{:a :b :c})))
+  (is (= #{:a :b :d :e} (set/symmetric-difference #{:a :b :c} #{:c :d :e})))
+  (is (= #{:a :d "z" 3} (set/symmetric-difference #{:a :b :c} #{:c :d} #{:b "z" 3}))))
+
+(deftest subset?-test
+  (is (not (set/subset? #{:a :b :c} #{:c :d :e})))
+  (is (set/subset? #{:a :b :c} #{:a :b :c :d :e :f})))
+
+(deftest superset?-test
+  (is (set/superset? #{:a :b :c :d :e :f} #{:a :d :f}))
+  (is (not (set/superset? #{:a :b :c} #{:c :d :e})))
+  (is (not (set/superset? #{:a :b :c} #{:a :b :c :d :e :f}))))
+
+(deftest union-test
+  (is (= #{:a :b :c} (set/union #{:a :b :c})))
+  (is (= #{:a :b :c :d :e} (set/union #{:a :b :c} #{:c :d :e})))
+  (is (= #{:a :b :c :d "z" 3} (set/union #{:a :b :c} #{:c :d} #{:b "z" 3}))))

tests/basilisp/test_string.lpy

@@ -1,4 +1,4 @@
-(ns basilisp.string-test
+(ns basilisp.test-string
   (:require
    [basilisp.string :as str]
    [basilisp.test :refer [deftest is]]))