Merge pull request #28 from hdgarrood/intersection-etc

Intersection etc

Author: garyb

bower.json

@@ -22,7 +22,8 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-maps": "^0.5.0"
+    "purescript-maps": "^0.5.0",
+    "purescript-tailrec": "^0.3.1"
   },
   "devDependencies": {
     "purescript-assert": "~0.1.1",

docs/Data/Set.md

@@ -139,4 +139,30 @@ difference :: forall a. (Ord a) => Set a -> Set a -> Set a
 
 Form the set difference
 
+#### `subset`
+
+``` purescript
+subset :: forall a. (Ord a) => Set a -> Set a -> Boolean
+```
+
+True if and only if every element in the first set
+is an element of the second set
+
+#### `properSubset`
+
+``` purescript
+properSubset :: forall a. (Ord a) => Set a -> Set a -> Boolean
+```
+
+True if and only if the first set is a subset of the second set
+and the sets are not equal
+
+#### `intersection`
+
+``` purescript
+intersection :: forall a. (Ord a) => Set a -> Set a -> Set a
+```
+
+The set of elements which are in both the first and second set
+
 

src/Data/Set.purs

@@ -19,6 +19,9 @@ module Data.Set
   , union
   , unions
   , difference
+  , subset
+  , properSubset
+  , intersection
   ) where
 
 import Prelude
@@ -29,6 +32,18 @@ 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 (nub, length)
+import Data.Array.ST
+import Data.Array.Unsafe (unsafeIndex)
+import qualified Data.List as List
+import Data.Either
+import Data.Maybe
+import Data.Tuple
+import Data.Foldable (foldl)
+
 -- | `Set a` represents a set of values of type `a`
 data Set a = Set (M.Map a Unit)
 
@@ -111,3 +126,35 @@ 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 = fromFoldable $ runPure (runSTArray (emptySTArray >>= intersect)) where
+  ls = toArray s1
+  rs = toArray 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
+
+toArray :: forall a. (Ord a) => Set a -> Array a
+toArray = List.fromList <<< toList

test/Test/Main.purs

@@ -18,3 +18,9 @@ main = do
      assert $ S.member 0 set
      assert $ S.member 1 set
      assert $ S.member 2 set
+
+  log "intersection"
+  do let s1 = S.fromFoldable [1,2,3,4,5]
+         s2 = S.fromFoldable [2,4,6,8,10]
+         s3 = S.fromFoldable [2,4]
+     assert $ S.intersection s1 s2 == s3