{-# 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