Skip to content
This repository has been archived by the owner on Oct 4, 2020. It is now read-only.

Commit

Permalink
Merge pull request #28 from hdgarrood/intersection-etc
Browse files Browse the repository at this point in the history
Intersection etc
  • Loading branch information
garyb committed Dec 23, 2015
2 parents ab0fabc + 506b9f9 commit 71cac2b
Show file tree
Hide file tree
Showing 4 changed files with 81 additions and 1 deletion.
3 changes: 2 additions & 1 deletion bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
26 changes: 26 additions & 0 deletions docs/Data/Set.md
Original file line number Diff line number Diff line change
Expand Up @@ -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


47 changes: 47 additions & 0 deletions src/Data/Set.purs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,9 @@ module Data.Set
, union
, unions
, difference
, subset
, properSubset
, intersection
) where

import Prelude
Expand All @@ -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)

Expand Down Expand Up @@ -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
6 changes: 6 additions & 0 deletions test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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

0 comments on commit 71cac2b

Please sign in to comment.