sets 0.0.5.2 → 0.0.6
raw patch · 5 files changed
+317/−150 lines, 5 filesdep +bytestringdep +vectordep ~QuickCheckdep ~basedep ~commutative
Dependencies added: bytestring, vector
Dependency ranges changed: QuickCheck, base, commutative, containers, mtl
Files
- README.md +118/−0
- sets.cabal +128/−80
- src/Data/Set/Class.hs +20/−0
- src/Data/Set/Ordered/Many.hs +49/−69
- src/Data/Set/Ordered/Unique/With.hs +2/−1
+ README.md view
@@ -0,0 +1,118 @@+sets+====++This package provides overloaded terms, commonly used with set-like types,+like `Map` and `Set` from `containers`. There are also unorthodox, mostly useless+data types defined here - playing with ordering, uniqueness and finiteness.++## Usage++The following actions are overloaded:++__Binary Operators__:++- `union`+- `intersection`+- `difference`+- `complement`++__Top and Bottom Elements__:++- `empty`+- `total`++__Element-Wise Operations__:++- `singleton`+- `insert`+- `delete`++__Metrics and Comparison__:++- `size`+- `isSubsetOf` `isProperSubsetOf`++---++Each of the operations has their own typeclass. We have also made newtype wrappers+for lists, for different restrictions:++- Ordered Sets+ - Multiple+- Unordered Sets+ - Unique+ - Multiple++This way, we can expect the following to work:++```haskell+uniqueAppend :: Eq a => [a] -> [a] -> [a]+uniqueAppend xs ys = unUUSet $ fromFoldable xs `union` fromFoldable ys++orderedAppend :: Ord a => [a] -> [a] -> [a]+orderedAppend xs ys = unOMSet $ fromFoldable xs `union` fromFoldable ys+```++---++We've also made a few newtypes to encode our binary operations, for `Monoid`+and `Semigroup` instances:++```haskell+instance (HasUnion s, HasEmpty s) => Monoid (Union s) where+ mempty = empty+ mappend = union+```++### Multiple Set Types++To use the overloaded terms, they need to be the only ones in scope. To make this+correct, we need to import our container with caution:++```haskell+import qualified Data.Set as Set+import Data.Map (Map) -- only the type name to designate behavior++foo :: Map+foo = x `union` y++bar :: Set.Set+bar = a `union` b+```++This way, we can keep our code more readable while still having set-like intuition.++## Testing and Benchmarking++> You can view the results [here](https://github.com/athanclark/sets/raw/master/profile.html)+> (__warning__: it's a 7MB text file - your browser will hate you)++The tests are built with QuickCheck - it's pretty easy to get them working for you:++```bash+cabal install --enable-tests+cabal test --show-details=always+```++(...or for the stack folk...)++```bash+stack build+stack test+```++---++To benchmark (it usually takes about 10 minutes on my laptop), run the command!++```bash+cabal install --enable-benchmarks+cabal bench+```++(...stiggitty-stack is co-wiggity-whack...)++```bash+stack build+stack bench --benchmark-arguments="--output profile.html"+```
sets.cabal view
@@ -1,85 +1,133 @@-Name: sets-Version: 0.0.5.2-Author: Athan Clark <athan.clark@gmail.com>-Maintainer: Athan Clark <athan.clark@gmail.com>-License: MIT-License-File: LICENSE-Synopsis: Ducktyped set interface for Haskell containers.-Description: Includes overloaded functions for common set operations. See @Data.Set.Class@.-Cabal-Version: >= 1.10-Build-Type: Simple-Category: Data, Math+cabal-version: 1.12 -Library- Default-Language: Haskell2010- HS-Source-Dirs: src- GHC-Options: -Wall- Exposed-Modules: Data.Set.Class- Data.Set.Unordered.Unique- Data.Set.Unordered.Many- Data.Set.Ordered.Unique- Data.Set.Ordered.Unique.With- Data.Set.Ordered.Unique.Finite- Data.Set.Ordered.Many- Data.Set.Ordered.Many.With- Build-Depends: base >= 4.6 && < 5- , containers- , unordered-containers- , hashable- , commutative >= 0.0.1.4- , composition- , contravariant--- , invariant- , witherable- , keys- , semigroups- , semigroupoids- , mtl- , transformers- , transformers-base- , QuickCheck+-- This file has been generated from package.yaml by hpack version 0.31.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 43dfe0d613b8c2ccf7c76fdb2b07db2e683eda310038bdcc33fe5108a6ce8f4f -Test-Suite spec- Type: exitcode-stdio-1.0- Default-Language: Haskell2010- Hs-Source-Dirs: test- Ghc-Options: -Wall -threaded- Main-Is: Main.hs- Other-Modules: Data.SetSpec- Build-Depends: base- , sets- , tasty- , tasty-quickcheck- , tasty-hunit- , QuickCheck- , quickcheck-instances- , containers- , unordered-containers- , contravariant- , commutative+name: sets+version: 0.0.6+synopsis: Ducktyped set interface for Haskell containers.+description: Please see the README on Github at <https://github.com/athanclark/sets#readme>+category: Data+homepage: https://github.com/athanclark/sets#readme+bug-reports: https://github.com/athanclark/sets/issues+author: Athan Clark+maintainer: athan.clark@localcooking.com+copyright: 2018 Athan Clark+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md +source-repository head+ type: git+ location: https://github.com/athanclark/sets -Benchmark bench- Type: exitcode-stdio-1.0- Default-Language: Haskell2010- Hs-Source-Dirs: bench- Ghc-Options: -Wall -threaded- Main-Is: Profile.hs- Other-Modules: Data.Set.Data- Data.Map.Data- Data.IntSet.Data- Data.IntMap.Data- Data.Set.Ordered.Many.Data- Data.Set.Unordered.Many.Data- Data.Set.Unordered.Unique.Data- Build-Depends: base- , sets- , containers- , unordered-containers- , commutative- , contravariant- , criterion+library+ exposed-modules:+ Data.Set.Class+ Data.Set.Ordered.Many+ Data.Set.Ordered.Many.With+ Data.Set.Ordered.Unique+ Data.Set.Ordered.Unique.Finite+ Data.Set.Ordered.Unique.With+ Data.Set.Unordered.Many+ Data.Set.Unordered.Unique+ other-modules:+ Paths_sets+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ QuickCheck >=2.9.2+ , base >=4.11 && <5.0+ , bytestring+ , commutative >=0.0.2+ , composition+ , containers+ , contravariant+ , hashable+ , keys+ , mtl+ , semigroupoids+ , semigroups+ , transformers+ , transformers-base+ , unordered-containers+ , vector+ , witherable+ default-language: Haskell2010 -Source-Repository head- Type: git- Location: https://github.com/athanclark/sets.git+test-suite sets-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Data.SetSpec+ Paths_sets+ hs-source-dirs:+ test+ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base >=4.11 && <5.0+ , bytestring+ , commutative+ , composition+ , containers+ , contravariant+ , hashable+ , keys+ , mtl+ , quickcheck-instances+ , semigroupoids+ , semigroups+ , sets+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , transformers+ , transformers-base+ , unordered-containers+ , vector+ , witherable+ default-language: Haskell2010++benchmark sets-bench+ type: exitcode-stdio-1.0+ main-is: Profile.hs+ other-modules:+ Data.IntMap.Data+ Data.IntSet.Data+ Data.Map.Data+ Data.Set.Data+ Data.Set.Ordered.Many.Data+ Data.Set.Unordered.Many.Data+ Data.Set.Unordered.Unique.Data+ Paths_sets+ hs-source-dirs:+ bench+ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.9.2+ , base >=4.11 && <5.0+ , bytestring+ , commutative+ , composition+ , containers+ , contravariant+ , criterion+ , hashable+ , keys+ , mtl+ , semigroupoids+ , semigroups+ , sets+ , transformers+ , transformers-base+ , unordered-containers+ , vector+ , witherable+ default-language: Haskell2010
src/Data/Set/Class.hs view
@@ -23,6 +23,7 @@ import Data.Traversable import Data.Semigroup.Foldable as Fold1 import Data.Semigroup+import Data.Monoid import Data.Key import Data.Commutative as Comm import Data.Composition@@ -42,6 +43,8 @@ import qualified Data.Set.Unordered.Unique as UU import qualified Data.Set.Ordered.Unique.Finite as OUF import qualified Data.Set.Ordered.Unique.With as SetWith+import Data.Vector (Vector)+import qualified Data.Vector as Vector @@ -373,6 +376,23 @@ instance HasSize [a] where size = List.length++-- Data.Vector+instance HasSingleton a (Vector.Vector a) where+ singleton = Vector.singleton++instance HasInsert a (Vector.Vector a) where+ insert = Vector.cons++instance Eq a => HasDelete a (Vector.Vector a) where+ delete x = Vector.filter (== x)++instance HasEmpty (Vector a) where+ empty = Vector.empty++instance HasSize (Vector a) where+ size = Vector.length+ -- Data.Sequence instance HasSingleton a (Seq.Seq a) where
src/Data/Set/Ordered/Many.hs view
@@ -5,25 +5,30 @@ , DeriveTraversable , FlexibleContexts , MultiParamTypeClasses+ , OverloadedLists+ , TupleSections+ , FlexibleInstances #-} module Data.Set.Ordered.Many where import Data.Mergeable-import Data.List as List hiding (delete) import Data.Foldable as Fold import Data.Traversable import Data.Maybe (fromJust, isJust, mapMaybe)+import Data.Vector (Vector, (!?))+import qualified Data.Vector as Vector import Control.Applicative import Control.Monad.Fix import Control.Monad.State import Control.Monad.Base import Test.QuickCheck+import System.IO.Unsafe (unsafePerformIO) -- | Ordered sets with duplicate elements.-newtype OMSet a = OMSet {unOMSet :: [a]}+newtype OMSet a = OMSet {unOMSet :: Vector a} deriving ( Eq , Show , Functor@@ -31,30 +36,30 @@ , Monad , Fold.Foldable , Traversable- , MonadFix+ -- , MonadFix ) instance Mergeable OMSet where mergeMap f (OMSet xs) = mergeMap f xs - instance MonadBase Gen Gen where liftBase = id -instance (Arbitrary a, Ord a) => Arbitrary (OMSet a) where+instance (Arbitrary a, Ord a, Show a) => Arbitrary (OMSet a) where arbitrary = OMSet <$> sized go where- go s = evalStateT (replicateM s go') Nothing- go' :: ( MonadState (Maybe a) m- , MonadBase Gen m- , Ord a- , Arbitrary a- ) => m a- go' = do- mprev <- get- x <- liftBase $ maybe arbitrary (\p -> arbitrary `suchThat` (>= p)) mprev- put $ Just x- return x+ -- go s = let xs = [1..s]+ -- in pure xs -- unsafePerformIO (print xs) `seq` (pure xs)+ go s = do x <- arbitrary+ xs <- go' s x+ let xss = Vector.cons x xs+ pure xss+ -- unsafePerformIO (print xss) `seq` (pure xss)+ go' :: (Ord a, Arbitrary a) => Int -> a -> Gen (Vector a)+ go' 0 _ = pure []+ go' s' prev = do+ next <- arbitrary `suchThat` (>= prev)+ (Vector.cons next) <$> go' (s' - 1) next -- * Operators @@ -63,113 +68,88 @@ -- * Query --- | /O(1)/ null :: Eq a => OMSet a -> Bool-null (OMSet xs) = List.null xs+null (OMSet xs) = Vector.null xs --- | /O(n)/ size :: OMSet a -> Int-size (OMSet xs) = List.length xs+size (OMSet xs) = Vector.length xs --- | /O(n)/ member :: Eq a => a -> OMSet a -> Bool-member x (OMSet xs) = List.elem x xs+member x (OMSet xs) = Vector.elem x xs --- | /O(n)/ notMember :: Eq a => a -> OMSet a -> Bool notMember x = not . member x --- | /O(n)/ lookup :: Eq a => a -> OMSet a -> Maybe a-lookup x (OMSet xs) = lookup' x xs- where- lookup' _ [] = Nothing- lookup' x' (y:ys) | x == y = Just y- | otherwise = lookup' x' ys+lookup x (OMSet xs) = Vector.find (== x) xs --- | /O(n*m)/ isSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool-isSubsetOf (OMSet xs) (OMSet ys) = List.foldr go True xs- where- go x b | List.elem x ys = b- | otherwise = False+isSubsetOf (OMSet xs) (OMSet ys) = Vector.all (`Vector.elem` ys) xs --- | /O(n*(m^3))/ isProperSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool-isProperSubsetOf (OMSet xs) (OMSet ys) = fst $ List.foldr go (True,ys) xs- where- go _ (False,soFar) = (False,soFar)- go _ (_,[]) = (False,[])- go x (b,soFar) = if List.elem x soFar- then (b, List.filter (/= x) soFar)- else (False, soFar)+isProperSubsetOf xs ys = xs /= ys && isSubsetOf xs ys -- * Construction -- | /O(1)/ empty :: OMSet a-empty = OMSet []+empty = OMSet Vector.empty -- | /O(1)/ singleton :: a -> OMSet a-singleton x = OMSet [x]+singleton = OMSet . Vector.singleton -- | /O(n)/ insert :: Ord a => a -> OMSet a -> OMSet a-insert x (OMSet xs) = OMSet $ insert' x xs- where- insert' x' [] = [x']- insert' x' (a:as) | x' <= a = x': a:as- | otherwise = a : insert' x' as+insert x (OMSet xs) =+ let (ps,ss) = Vector.span (<= x) xs+ in OMSet (ps <> Vector.singleton x <> ss) -- | /O(n)/ delete :: Eq a => a -> OMSet a -> OMSet a-delete x (OMSet xs) = OMSet $ List.filter (== x) xs+delete x (OMSet xs) = OMSet (Vector.filter (/= x) xs) -- * Combine -- | /O(min n m)/ union :: Ord a => OMSet a -> OMSet a -> OMSet a-union (OMSet xs') (OMSet ys') = OMSet $ go xs' ys'- where- go [] ys = ys- go xs [] = xs- go (x:xs) (y:ys) | x <= y = x : go xs (y:ys)- | otherwise = y : go (x:xs) ys+union xs ys = foldr insert xs ys -- | /O(n*m)/ difference :: Eq a => OMSet a -> OMSet a -> OMSet a-difference (OMSet xs) (OMSet ys) = OMSet $ List.foldr go [] xs+difference (OMSet xs) (OMSet ys) = OMSet (Vector.foldr go [] xs) where- go x soFar | List.elem x ys = soFar- | otherwise = x:soFar+ go x soFar | Vector.elem x ys = soFar+ | otherwise = Vector.cons x soFar -- | /O(min(n,m))/ - Combines all elements of both intersection :: Ord a => OMSet a -> OMSet a -> OMSet a-intersection (OMSet xs') (OMSet ys') = OMSet $ go xs' ys'+intersection (OMSet xs') (OMSet ys') = OMSet (go xs' ys') where- go [] _ = []- go _ [] = []- go (x:xs) (y:ys) | x < y = go (x:xs) ys- | x == y = x:x:go xs ys- | x > y = go xs (y:ys)+ go :: Ord a => Vector a -> Vector a -> Vector a+ go xss yss = case (,) <$> xss Vector.!? 0 <*> yss Vector.!? 0 of+ Nothing -> []+ Just (x,y)+ | x < y -> go xss (Vector.drop 1 yss)+ | x == y -> [x,y] <> go (Vector.drop 1 xss) (Vector.drop 1 yss)+ | otherwise -> go (Vector.drop 1 xss) yss -- * Filter -- | /O(n)/ filter :: (a -> Bool) -> OMSet a -> OMSet a-filter p (OMSet xs) = OMSet $ List.filter p xs+filter p (OMSet xs) = OMSet (Vector.filter p xs) -- | /O(n)/ partition :: (a -> Bool) -> OMSet a -> (OMSet a, OMSet a)-partition p (OMSet xs) = let (l,r) = List.partition p xs in (OMSet l, OMSet r)+partition p (OMSet xs) = let (l,r) = Vector.partition p xs in (OMSet l, OMSet r) -- * Map -- | /O(n)/ map :: (a -> b) -> OMSet a -> OMSet b-map f (OMSet xs) = OMSet $ List.map f xs+map f (OMSet xs) = OMSet (Vector.map f xs) -- | /O(?)/ mapMaybe :: (a -> Maybe b) -> OMSet a -> OMSet b-mapMaybe f (OMSet xs) = OMSet $ Data.Maybe.mapMaybe f xs+mapMaybe f (OMSet xs) = OMSet (Vector.mapMaybe f xs)
src/Data/Set/Ordered/Unique/With.hs view
@@ -21,11 +21,12 @@ import qualified Data.Foldable as Fold --import Data.Functor.Invariant import Control.Applicative ((<$>))+import Data.Semigroup (Semigroup) import Data.Monoid (Monoid) newtype SetWith k a = SetWith {unSetWith :: (a -> k, Map.Map k a)}- deriving (Monoid)+ deriving (Semigroup, Monoid) --instance Invariant (SetWith k) where -- invmap = map