translatable-intset (empty) → 0.1
raw patch · 6 files changed
+597/−0 lines, 6 filesdep +basedep +fingertreebuild-type:Customsetup-changed
Dependencies added: base, fingertree
Files
- Data/IntSet/Translatable.hs +395/−0
- Data/IntSet/Translatable/Test.hs +132/−0
- LICENSE +19/−0
- Setup.hs +19/−0
- Test.hs +5/−0
- translatable-intset.cabal +27/−0
+ Data/IntSet/Translatable.hs view
@@ -0,0 +1,395 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module : Data.IntSet.Translatable+-- Copyright : (c) Jannis Harder 2011+-- License : MIT+-- Maintainer : Jannis Harder <jannis@harderweb.de>+--+-- An implementation of integer sets with a constant time 'translate'+-- operation, where 'translate' is defined to be+-- @'translate' x s = 'map' (+x) s@.+--+-- Since many function names (but not the type name) clash with+-- "Prelude" names, this module is usually imported @qualified@, e.g.+--+-- > import Data.IntSet.Translatable (IntSet)+-- > import qualified Data.IntSet.Translatable as IntSet+--+-- This implementation is based on /Finger-Trees/ storing differences+-- of consecutive entries of the ordered sequence of set elements.+-- With this representation, a translation of all elements can be+-- realized by changing only the leftmost element of the Finger-Tree+-- which is a constant time operation. Together with caching of the+-- accumulated differences most set operations can be implemented+-- efficiently too.+module Data.IntSet.Translatable (+ -- * Set type+ IntSet++ -- * Operators+ , (\\)++ -- * Query+ , null+ , size+ , member+ , notMember++ -- * Construction+ , empty+ , singleton+ , insert+ , delete++ -- * Combine+ , union+ , unions+ , difference+ , intersection++ -- * Filter+ , filter+ , partition+ , split+ , splitMember++ -- * Min\/Max+ , findMin+ , findMax+ , deleteMin+ , deleteMax+ , deleteFindMin+ , deleteFindMax+ , maxView+ , minView++ -- * Map+ , map+ , translate++ -- * Fold+ , fold++ -- * Conversion+ -- ** List+ , elems+ , toList+ , fromList++ -- ** Ordered list+ , toAscList+ , fromAscList+ , fromDistinctAscList++ ) where++import Prelude hiding (null, filter, map)++#if __GLASGOW_HASKELL__+import Text.Read+#endif++import Data.Monoid (Monoid(..))+import qualified Data.List as List+import Data.List (group, sort, foldl')+import Data.Maybe (fromMaybe)++import Control.Arrow ((***))+import Control.Monad (join)++import qualified Data.FingerTree as FingerTree+import Data.FingerTree (FingerTree, Measured, measure, (<|), (|>), (><),+ ViewL(..), ViewR(..), viewl, viewr)++newtype Diff = Diff { getDiff :: Int } deriving Eq++data DiffSum = DiffSum { getSum :: !Int+ , getSize :: !Int+ }++instance Monoid DiffSum where+ mempty = DiffSum 0 0+ mappend a b = DiffSum { getSum = getSum a + getSum b+ , getSize = getSize a + getSize b }++instance Measured DiffSum Diff where+ measure a = DiffSum { getSum = getDiff a, getSize = 1}++newtype IntSet = IntSet (FingerTree DiffSum Diff) deriving Eq++instance Ord IntSet where+ compare s1 s2 = compare (toAscList s1) (toAscList s2)+ -- lazyness should make this quite efficient++instance Show IntSet where+ showsPrec p xs = showParen (p > 10) $+ showString "fromList " . shows (toList xs)++instance Read IntSet where+#ifdef __GLASGOW_HASKELL__+ readPrec = parens $ prec 10 $ do+ Ident "fromList" <- lexP+ xs <- readPrec+ return (fromList xs)++ readListPrec = readListPrecDefault+#else+ readsPrec p = readParen (p > 10) $ \ r -> do+ ("fromList",s) <- lex r+ (xs,t) <- reads s+ return (fromList xs,t)+#endif++instance Monoid IntSet where+ mempty = empty+ mappend = union+ mconcat = unions++-- | /O(???)/. See 'difference'.+(\\) :: IntSet -> IntSet -> IntSet+m1 \\ m2 = difference m1 m2++-- | /O(1)/. Is the set empty?+null :: IntSet -> Bool+null (IntSet xs) = FingerTree.null xs++-- | /O(1)/. Cardinality of the set.+size :: IntSet -> Int+size (IntSet xs) = getSize $ measure xs++-- | /O(log(n))/. Is the value a member of the set?+member :: Int -> IntSet -> Bool+member k (IntSet s) = case FingerTree.split ((> k) . getSum) s of+ (ls, _) | FingerTree.null ls -> False+ | getSum (measure ls) == k -> True+ | otherwise -> False++-- | /O(log(n)/. Is the element not in the set?+notMember :: Int -> IntSet -> Bool+notMember k = not . member k++-- | /O(1)/. The empty set.+empty :: IntSet+empty = IntSet FingerTree.empty++-- | /O(1)/. A set of one element.+singleton :: Int -> IntSet+singleton = IntSet . FingerTree.singleton . Diff++-- | /O(log(n))/. Add a value to the set.+insert :: Int -> IntSet -> IntSet+insert k (IntSet s) = IntSet $ case FingerTree.split ((> k) . getSum) s of+ (ls, rs) | FingerTree.null ls -> Diff k <| translate' (-k) rs+ | d == 0 -> s+ | otherwise -> ls >< Diff d <| translate' (-d) rs+ where d = k - getSum (measure ls)++-- | /O(log(n))/. Delete a value in the set. Returns the+-- original set when the value was not present.+delete :: Int -> IntSet -> IntSet+delete k (IntSet s) = IntSet $ case FingerTree.split ((> k) . getSum) s of+ (ls, rs) | getSum (measure ls) == k ->+ case viewr ls of+ EmptyR -> s+ ls' :> _ -> ls' >< translate' (k - getSum (measure ls')) rs+ | otherwise -> s++-- | /O(m log(n /\// m))/ where /m<=n/. The union of two sets. /O(log m)/+-- if all elements of one set are larger than all elements of the+-- other set.+union :: IntSet -> IntSet -> IntSet+union (IntSet xs) (IntSet ys) = IntSet $ merge xs ys+ where merge as bs = case viewl bs of+ EmptyL -> as+ Diff b :< bs' -> ls >< d <|? merge bs' (translate' (-d) rs)+ where (ls, rs) = FingerTree.split (\v -> getSum v > b) as+ d = b - getSum (measure ls)+ 0 <|? as | not $ FingerTree.null ls = as+ a <|? as = Diff a <| as++-- | The union of a list of sets.+unions :: [IntSet] -> IntSet+unions xs = foldl' union empty xs+++-- | /O(???)/. Difference between two sets.++-- This should be O(m log(n / m)) but it might be even better.+difference :: IntSet -> IntSet -> IntSet+difference (IntSet xs) (IntSet ys) = IntSet $ diffF xs ys+ where diffF as bs = case viewl bs of+ EmptyL -> as+ Diff b :< bs'+ | FingerTree.null ls -> diffR (translate' b bs') rs+ | d == 0 ->+ case viewr ls of+ ls' :> Diff m -> ls' >< translate' (d + m) (diffR bs' rs)+ | otherwise -> ls >< diffR (translate' d bs') rs+ where (ls, rs) = FingerTree.split (\v -> getSum v > b) as+ d = b - getSum (measure ls)+ diffR as bs = case viewl bs of+ EmptyL -> bs+ Diff b :< bs'+ | FingerTree.null ls -> Diff b <| diffF bs' (translate' (-b) rs)+ | d == 0 ->+ case viewr ls of+ ls' :> Diff m -> translate' b $ diffF bs' rs+ | otherwise -> Diff b <| diffF bs' (translate' (-d) rs)+ where (ls, rs) = FingerTree.split (\v -> getSum v > b) as+ d = b - getSum (measure ls)++-- | /O(???)/. The intersection of two sets.++-- This should be O(m log(n / m)) but is likely even better.+intersection :: IntSet -> IntSet -> IntSet+intersection (IntSet xs) (IntSet ys) = IntSet $ both xs ys+ where both as bs = case viewl bs of+ EmptyL -> bs+ Diff b :< bs'+ | FingerTree.null ls -> both (translate' b bs') rs+ | d == 0 -> Diff b <| both bs' rs+ | otherwise -> both (translate' b bs') (translate' m rs)+ where (ls, rs) = FingerTree.split (\v -> getSum v > b) as+ m = getSum (measure ls)+ d = b - m++-- | /O(n)/. Filter all elements that satisfy some predicate.+filter :: (Int -> Bool) -> IntSet -> IntSet+filter p = fromDistinctAscList . List.filter p . toList++-- | /O(n)/. Partition the set into two sets, one with all elements that satisfy+-- the predicate and one with all elements that don't satisfy the predicate.+-- See also 'split'.+partition :: (Int -> Bool) -> IntSet -> (IntSet, IntSet)+partition p = join (***) fromDistinctAscList . List.partition p . toList++-- | /O(log(min(i,n-i)))/. The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+--+-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])+split :: Int -> IntSet -> (IntSet, IntSet)+split k s = case splitMember k s of+ (a, _, b) -> (a, b)+++-- | /O(log(min(i,n-i)))/. Performs a 'split' but also returns whether the pivot+-- element was found in the original set.+splitMember :: Int -> IntSet -> (IntSet, Bool, IntSet)+splitMember k (IntSet s) =+ case FingerTree.split ((> k) . getSum) s of+ (ls, rs) | FingerTree.null ls -> (IntSet ls, False, IntSet rs)+ | getSum (measure ls) == k ->+ case viewr ls of+ ls' :> _ -> (IntSet ls', True, IntSet rs')+ | otherwise -> (IntSet ls, False, IntSet rs')+ where d = getSum (measure ls)+ rs' = translate' d rs++-- | /O(1)/. The minimal element of the set.+findMin :: IntSet -> Int+findMin =+ maybe (error "findMin: empty set has no minimal element") fst . minView++-- | /O(1)/. The maximal element of a set.+findMax :: IntSet -> Int+findMax =+ maybe (error "findMax: empty set has no maximal element") fst . maxView++-- | /O(1)/. Delete the minimal element.+deleteMin :: IntSet -> IntSet+deleteMin =+ maybe (error "deleteMin: empty set has no minimal element") snd . minView++-- | /O(1)/. Delete the maximal element.+deleteMax :: IntSet -> IntSet+deleteMax =+ maybe (error "deleteMax: empty set has no maximal element") snd . maxView++-- | /O(1)/. Delete and find the minimal element.+--+-- > deleteFindMin set = (findMin set, deleteMin set)+deleteFindMin :: IntSet -> (Int, IntSet)+deleteFindMin =+ fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView++-- | /O(1)/. Delete and find the maximal element.+--+-- > deleteFindMax set = (findMax set, deleteMax set)+deleteFindMax :: IntSet -> (Int, IntSet)+deleteFindMax =+ fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView++-- | /O(1)/. Retrieves the maximal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+maxView :: IntSet -> Maybe (Int, IntSet)+maxView (IntSet xs) = case viewr xs of+ EmptyR -> Nothing+ xs' :> _ -> Just (getSum $ measure xs, IntSet xs')++-- | /O(1)/. Retrieves the minimal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+minView :: IntSet -> Maybe (Int, IntSet)+minView (IntSet xs) = case viewl xs of+ EmptyL -> Nothing+ Diff x :< xs' -> Just (x, IntSet $ translate' x xs')++-- | /O(n*log(n))/.+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.+--+-- It's worth noting that the size of the result may be smaller if,+-- for some @(x,y)@, @x \/= y && f x == f y@+map :: (Int -> Int) -> IntSet -> IntSet+map f = fromList . List.map f . toList++-- | /O(1)/. Add a constant value to all elements of the set.+--+-- > translate x s == map (+x) s+translate :: Int -> IntSet -> IntSet+translate x (IntSet xs) = IntSet $ translate' x xs++-- | /O(n)/. Fold over the elements of a set in an unspecified order.+--+-- > sum set == fold (+) 0 set+-- > elems set == fold (:) [] set+fold :: (Int -> b -> b) -> b -> IntSet -> b+fold f i = foldr f i . toList+++-- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList)+elems :: IntSet -> [Int]+elems = toList++-- | /O(n)/. Convert the set to a list of elements.+toList :: IntSet -> [Int]+toList = toAscList++-- | /O(n*log(n))/. Create a set from a list of integers.+fromList :: [Int] -> IntSet+fromList = fromAscList . sort++-- | /O(n)/. Convert the set to an ascending list of elements.+toAscList :: IntSet -> [Int]+toAscList (IntSet xs) = toList xs 0+ where toList xs d = case viewl xs of+ EmptyL -> []+ Diff x :< xs -> x + d : toList xs (x + d)++-- | /O(n)/. Build a set from an ascending list of elements.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: [Int] -> IntSet+fromAscList = fromDistinctAscList . List.map head . group++-- | /O(n)/. Build a set from an ascending list of distinct elements.+-- /The precondition (input list is strictly ascending) is not checked./+fromDistinctAscList :: [Int] -> IntSet+fromDistinctAscList xs = IntSet $ foldl step FingerTree.empty xs+ where step as x = as |> Diff (x - getSum (measure as))++-- Internal++translate' 0 xs = xs+translate' d xs = case viewl xs of+ EmptyL -> FingerTree.empty+ Diff x :< xs -> Diff (x + d) <| xs
+ Data/IntSet/Translatable/Test.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE TemplateHaskell #-}+module Data.IntSet.Translatable.Test (main) where++import Test.Framework.TH+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.HUnit+import Test.QuickCheck+++import qualified Data.IntSet.Translatable as T+import qualified Data.IntSet as R++import Data.Monoid+import qualified Data.List as L+import Data.List+import Data.Functor++import Control.Arrow ((***), second)+import Control.Monad (join)++main = $(defaultMainGenerator)++snub = nub . sort++prop_eqRefl x = T.fromList x == T.fromList x+prop_eqList x y = (T.fromList x == T.fromList y) ==+ (snub x == snub y)+prop_eqRef x y = (T.fromList x == T.fromList y) ==+ (R.fromList x == R.fromList y)+++prop_ordList x y = T.fromList x `compare` T.fromList y ==+ snub x `compare` snub y+prop_ordRef x y = T.fromList x `compare` T.fromList y ==+ R.fromList x `compare` R.fromList y++prop_readShow x = xs == read (show xs)+ where xs = T.fromList x++prop_monoidId x = xs == xs `mappend` mempty && xs == mempty `mappend` xs+ where xs = T.fromList x++prop_monoidAssoc x y z = xs `mappend` (ys `mappend` zs) ==+ (xs `mappend` ys) `mappend` zs+ where [xs, ys, zs] = map T.fromList [x, y, z]++prop_nullList x = T.null (T.fromList x) == null x+prop_nullRef x = T.null (T.fromList x) == R.null (R.fromList x)++prop_sizeList x = T.size (T.fromList x) == length (nub x)+prop_sizeRef x = T.size (T.fromList x) == R.size (R.fromList x)++prop_memberList e x = T.member e (T.fromList x) == elem e x+prop_memberRef e x = T.member e (T.fromList x) ==+ R.member e (R.fromList x)++case_emptyList = T.toAscList T.empty @=? []+case_emptyRef = T.toAscList T.empty @=? R.toAscList R.empty++prop_singletonList x = T.toAscList (T.singleton x) == [x]+prop_singletonRef x = T.toAscList (T.singleton x) ==+ R.toAscList (R.singleton x)++prop_insertRef e x = T.toAscList (T.insert e (T.fromList x)) ==+ R.toAscList (R.insert e (R.fromList x))++prop_deleteRef e x = T.toAscList (T.delete e (T.fromList x)) ==+ R.toAscList (R.delete e (R.fromList x))++prop_unionRef x y = T.toAscList (T.union (T.fromList x) (T.fromList y)) ==+ R.toAscList (R.union (R.fromList x) (R.fromList y))++prop_differenceRef x y =+ T.toAscList (T.difference (T.fromList x) (T.fromList y)) ==+ R.toAscList (R.difference (R.fromList x) (R.fromList y))++prop_intersectionRef x y =+ T.toAscList (T.intersection (T.fromList x) (T.fromList y)) ==+ R.toAscList (R.intersection (R.fromList x) (R.fromList y))++prop_filterRef (Blind p) x = T.toAscList (T.filter p (T.fromList x)) ==+ R.toAscList (R.filter p (R.fromList x))++prop_partitionRef (Blind p) x =+ join (***) T.toAscList (T.partition p (T.fromList x)) ==+ join (***) R.toAscList (R.partition p (R.fromList x))++prop_splitRef (Blind p) x =+ join (***) T.toAscList (T.split p (T.fromList x)) ==+ join (***) R.toAscList (R.split p (R.fromList x))++prop_splitMemberRef (Blind p) x =+ h T.toAscList (T.splitMember p (T.fromList x)) ==+ h R.toAscList (R.splitMember p (R.fromList x))+ where h f (a, b, c) = (f a, b, f c)++prop_findMinRef (NonEmpty x) = T.findMin (T.fromList x) ==+ R.findMin (R.fromList x)++prop_findMaxRef (NonEmpty x) = T.findMax (T.fromList x) ==+ R.findMax (R.fromList x)++prop_deleteMinRef (NonEmpty x) = T.toAscList (T.deleteMin (T.fromList x)) ==+ R.toAscList (R.deleteMin (R.fromList x))++prop_deleteMaxRef (NonEmpty x) = T.toAscList (T.deleteMax (T.fromList x)) ==+ R.toAscList (R.deleteMax (R.fromList x))++prop_deleteFindMinRef (NonEmpty x) =+ second T.toAscList (T.deleteFindMin (T.fromList x)) ==+ second R.toAscList (R.deleteFindMin (R.fromList x))++prop_deleteFindMaxRef (NonEmpty x) =+ second T.toAscList (T.deleteFindMax (T.fromList x)) ==+ second R.toAscList (R.deleteFindMax (R.fromList x))++prop_minViewRef x = fmap (second T.toAscList) (T.minView (T.fromList x)) ==+ fmap (second R.toAscList) (R.minView (R.fromList x))++prop_maxViewRef x = fmap (second T.toAscList) (T.maxView (T.fromList x)) ==+ fmap (second R.toAscList) (R.maxView (R.fromList x))++prop_mapRef (Blind f) x = T.toAscList (T.map f (T.fromList x)) ==+ R.toAscList (R.map f (R.fromList x))++prop_translateDef n x = T.translate n xs == T.map (+n) xs+ where xs = T.fromList x++prop_toAscListFromListRef x = T.toAscList (T.fromList x) ==+ R.toAscList (R.fromList x)
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2011 Jannis Harder++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,19 @@+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import System.Cmd+import System.Exit++main = defaultMainWithHooks hooks+ where hooks = simpleUserHooks { runTests = runTests' }++runTests' args _ _ lbi = do+ exitCode <- rawSystem "runhaskell" $+ [ "-odir=" ++ testobj+ , "-hidir=" ++ testobj+ , "-fobject-code"+ , "Test.hs"+ ] ++ args+ case exitCode of+ ExitFailure _ -> exitWith exitCode+ _ -> return ()+ where testobj = buildDir lbi ++ "/testobj"
+ Test.hs view
@@ -0,0 +1,5 @@+module Main where++import qualified Data.IntSet.Translatable.Test as Test++main = Test.main
+ translatable-intset.cabal view
@@ -0,0 +1,27 @@+Name: translatable-intset+Version: 0.1+License: MIT+License-File: LICENSE+Copyright: (c) 2011 Jannis Harder+Author: Jannis Harder <jannis@harderweb.de>+Maintainer: Jannis Harder <jannis@harderweb.de>+Category: Data Structures+Synopsis: Integer sets with a constant time translate operation.+Description: + This package implements integer sets with a+ constant time translate operation, defined as+ @translate x s = map (+x) s@. It is based on+ Finger-Trees storing differences of consecutive+ entries of the ordered sequence of set elements.+Cabal-Version: >= 1.6+Build-Type: Custom++Library+ Build-Depends: base >= 4 && < 5, fingertree < 0.1+ Exposed-Modules: Data.IntSet.Translatable++-- This is build implicitly by cabal test+Executable test+ Buildable: False+ Other-Modules: Data.IntSet.Translatable.Test+ Main-Is: Test.hs