1 files changed, 158 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux
new file mode 100644
index 000000000..efd266c18
--- /dev/null
+++ b/stdlib/source/library/lux/data/collection/set/multi.lux
@@ -0,0 +1,158 @@
+## https://en.wikipedia.org/wiki/Multiset
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]
+    [control
+     ["." function]]
+    [math
+     [number
+      ["n" nat]]]
+    [type
+     [abstract (#+ abstract: :abstraction :representation ^:representation)]]]]
+  ["." //
+   [//
+    ["." list ("#\." fold monoid)]
+    ["." dictionary (#+ Dictionary)]
+    [//
+     ["." maybe]]]])
+
+(abstract: #export (Set a)
+  (Dictionary a Nat)
+
+  (def: #export new
+    (All [a] (-> (Hash a) (Set a)))
+    (|>> dictionary.new :abstraction))
+
+  (def: #export size
+    (All [a] (-> (Set a) Nat))
+    (|>> :representation dictionary.values (list\fold n.+ 0)))
+
+  (def: #export (add multiplicity elem set)
+    (All [a] (-> Nat a (Set a) (Set a)))
+    (case multiplicity
+      0 set
+      _ (|> set
+            :representation
+            (dictionary.upsert elem 0 (n.+ multiplicity))
+            :abstraction)))
+
+  (def: #export (remove multiplicity elem set)
+    (All [a] (-> Nat a (Set a) (Set a)))
+    (case multiplicity
+      0 set
+      _ (case (dictionary.get elem (:representation set))
+          (#.Some current)
+          (:abstraction
+           (if (n.> multiplicity current)
+             (dictionary.update elem (n.- multiplicity) (:representation set))
+             (dictionary.remove elem (:representation set))))
+          
+          #.None
+          set)))
+
+  (def: #export (multiplicity set elem)
+    (All [a] (-> (Set a) a Nat))
+    (|> set :representation (dictionary.get elem) (maybe.default 0)))
+
+  (def: #export to_list
+    (All [a] (-> (Set a) (List a)))
+    (|>> :representation
+         dictionary.entries
+         (list\fold (function (_ [elem multiplicity] output)
+                      (list\compose (list.repeat multiplicity elem) output))
+                    #.Nil)))
+
+  (template [<name> <compose>]
+    [(def: #export (<name> parameter subject)
+       (All [a] (-> (Set a) (Set a) (Set a)))
+       (:abstraction (dictionary.merge_with <compose> (:representation parameter) (:representation subject))))]
+
+    [union n.max]
+    [sum n.+]
+    )
+
+  (def: #export (intersection parameter (^:representation subject))
+    (All [a] (-> (Set a) (Set a) (Set a)))
+    (list\fold (function (_ [elem multiplicity] output)
+                 (..add (n.min (..multiplicity parameter elem)
+                               multiplicity)
+                        elem
+                        output))
+               (..new (dictionary.key_hash subject))
+               (dictionary.entries subject)))
+
+  (def: #export (difference parameter subject)
+    (All [a] (-> (Set a) (Set a) (Set a)))
+    (|> parameter
+        :representation
+        dictionary.entries
+        (list\fold (function (_ [elem multiplicity] output)
+                     (..remove multiplicity elem output))
+                   subject)))
+
+  (def: #export (sub? reference subject)
+    (All [a] (-> (Set a) (Set a) Bit))
+    (|> subject
+        :representation
+        dictionary.entries
+        (list.every? (function (_ [elem multiplicity])
+                       (|> elem
+                           (..multiplicity reference)
+                           (n.>= multiplicity))))))
+
+  (def: #export (support set)
+    (All [a] (-> (Set a) (//.Set a)))
+    (let [(^@ set [hash _]) (:representation set)]
+      (|> set
+          dictionary.keys
+          (//.from_list hash))))
+
+  (implementation: #export equivalence
+    (All [a] (Equivalence (Set a)))
+    
+    (def: (= (^:representation reference) sample)
+      (and (n.= (dictionary.size reference)
+                (dictionary.size (:representation sample)))
+           (|> reference
+               dictionary.entries
+               (list.every? (function (_ [elem multiplicity])
+                              (|> elem
+                                  (..multiplicity sample)
+                                  (n.= multiplicity))))))))
+
+  (implementation: #export hash
+    (All [a] (Hash (Set a)))
+    
+    (def: &equivalence ..equivalence)
+    
+    (def: (hash (^:representation set))
+      (let [[hash _] set]
+        (list\fold (function (_ [elem multiplicity] acc)
+                     (|> elem (\ hash hash) (n.* multiplicity) (n.+ acc)))
+                   0
+                   (dictionary.entries set)))))
+  )
+
+(def: #export (member? set elem)
+  (All [a] (-> (Set a) a Bit))
+  (|> elem (..multiplicity set) (n.> 0)))
+
+(def: #export empty?
+  (All [a] (-> (Set a) Bit))
+  (|>> ..size (n.= 0)))
+
+(def: #export (from_list hash subject)
+  (All [a] (-> (Hash a) (List a) (Set a)))
+  (list\fold (..add 1) (..new hash) subject))
+
+(def: #export (from_set subject)
+  (All [a] (-> (//.Set a) (Set a)))
+  (..from_list (//.member_hash subject)
+               (//.to_list subject)))
+
+(def: #export super?
+  (All [a] (-> (Set a) (Set a) Bit))
+  (function.flip sub?))