diff --git a/bower.json b/bower.json index 30ff500..4e00145 100644 --- a/bower.json +++ b/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", diff --git a/docs/Data/Set.md b/docs/Data/Set.md index 1a2dfcc..aaba8e1 100644 --- a/docs/Data/Set.md +++ b/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 + diff --git a/src/Data/Set.purs b/src/Data/Set.purs index 464849d..7e8371b 100644 --- a/src/Data/Set.purs +++ b/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 diff --git a/test/Test/Main.purs b/test/Test/Main.purs index abaa3ea..e23b15f 100644 --- a/test/Test/Main.purs +++ b/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