Added subset, properSubset, and intersection.

Author: pseudonom

src/Data/Set.purs

@@ -19,6 +19,9 @@ module Data.Set
   , union
   , unions
   , difference
+  , subset
+  , properSubset
+  , intersection
   ) where
 
 import Prelude
@@ -29,6 +32,17 @@ import Data.Monoid (Monoid)
 import Data.Tuple (fst)
 import qualified Data.Map as M
 
+import Control.Monad.Eff (runPure, Eff())
+import Control.Monad.ST (ST())
+import Control.Monad.Rec.Class (tailRecM2)
+import Data.Array (map, nub, length)
+import Data.Array.ST
+import Data.Either
+import Data.Maybe
+import Data.Tuple
+import Data.Foldable (foldl)
+import Prelude.Unsafe (unsafeIndex)
+
 -- | `Set a` represents a set of values of type `a`
 data Set a = Set (M.Map a Unit)
 
@@ -111,3 +125,32 @@ unions = foldl union empty
 -- | Form the set difference
 difference :: forall a. (Ord a) => Set a -> Set a -> Set a
 difference s1 s2 = foldl (flip delete) s1 (toList s2)
+
+-- | True if and only if every element in the first set
+-- | is an element of the second set
+subset :: forall a. (Ord a) => Set a -> Set a -> Boolean
+subset s1 s2 = isEmpty $ s1 `difference` s2
+
+-- | True if and only if the first set is a subset of the second set
+-- | and the sets are not equal
+properSubset :: forall a. (Ord a) => Set a -> Set a -> Boolean
+properSubset s1 s2 = subset s1 s2 && (s1 /= s2)
+
+-- | The set of elements which are in both the first and second set
+intersection :: forall a. (Ord a) => Set a -> Set a -> Set a
+intersection s1 s2 = fromList $ runPure (runSTArray (emptySTArray >>= intersect)) where
+  ls = toList s1
+  rs = toList s2
+  ll = length ls
+  rl = length rs
+  intersect :: forall h r. STArray h a -> Eff (st :: ST h | r) (STArray h a)
+  intersect acc = tailRecM2 go 0 0 where
+    go l r =
+      if l < ll && r < rl
+      then case compare (ls `unsafeIndex` l) (rs `unsafeIndex` r) of
+        EQ -> do
+          pushSTArray acc (ls `unsafeIndex` l)
+          pure $ Left {a: l + 1, b: r + 1}
+        LT -> pure $ Left {a: l + 1, b: r}
+        GT -> pure $ Left {a: l, b: r + 1}
+      else pure $ Right acc