From 74c05d428bda0fd9d17dce5878a35800ecd8cdc9 Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Fri, 20 Mar 2015 18:12:55 -0400 Subject: [PATCH 1/4] Added subset, properSubset, and intersection. --- src/Data/Set.purs | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/src/Data/Set.purs b/src/Data/Set.purs index 464849d..7b5050b 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,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 From d74c27810895db7178290b57a58aa07aaa1f0e65 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Thu, 26 Nov 2015 05:26:23 +0100 Subject: [PATCH 2/4] Fix some compile errors --- bower.json | 3 ++- docs/Data/Set.md | 26 ++++++++++++++++++++++++++ src/Data/Set.purs | 17 ++++++++++++----- 3 files changed, 40 insertions(+), 6 deletions(-) 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 7b5050b..bd75723 100644 --- a/src/Data/Set.purs +++ b/src/Data/Set.purs @@ -35,13 +35,14 @@ 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 (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) -import Prelude.Unsafe (unsafeIndex) -- | `Set a` represents a set of values of type `a` data Set a = Set (M.Map a Unit) @@ -138,9 +139,9 @@ 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 +intersection s1 s2 = fromArray $ 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) @@ -154,3 +155,9 @@ intersection s1 s2 = fromList $ runPure (runSTArray (emptySTArray >>= intersect) 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 + +fromArray :: forall a. (Ord a) => Array a -> Set a +fromArray = fromList <<< List.toList From 53f5b223d4cb1cdbc362286c03ec5d499e147806 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Wed, 23 Dec 2015 21:06:57 +0100 Subject: [PATCH 3/4] Switch fromArray -> fromFoldable --- src/Data/Set.purs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Data/Set.purs b/src/Data/Set.purs index bd75723..7e8371b 100644 --- a/src/Data/Set.purs +++ b/src/Data/Set.purs @@ -139,7 +139,7 @@ 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 = fromArray $ runPure (runSTArray (emptySTArray >>= intersect)) where +intersection s1 s2 = fromFoldable $ runPure (runSTArray (emptySTArray >>= intersect)) where ls = toArray s1 rs = toArray s2 ll = length ls @@ -158,6 +158,3 @@ intersection s1 s2 = fromArray $ runPure (runSTArray (emptySTArray >>= intersect toArray :: forall a. (Ord a) => Set a -> Array a toArray = List.fromList <<< toList - -fromArray :: forall a. (Ord a) => Array a -> Set a -fromArray = fromList <<< List.toList From 506b9f9b845c8dc5bcf39eec72c15ca7105f525f Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Wed, 23 Dec 2015 21:07:08 +0100 Subject: [PATCH 4/4] Add basic intersection test --- test/Test/Main.purs | 6 ++++++ 1 file changed, 6 insertions(+) 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