diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for ordered-containers +## 0.2.2 -- 2019-07-05 + +* Add `toMap` and `toSet`, which support efficient conversions from + `OMap`s/`OSet`s to `Map`s/`Set`s, respectively. + ## 0.2.1 -- 2019-03-25 * Compatibility fixes from Ryan Scott (thanks!) diff --git a/Data/Map/Ordered.hs b/Data/Map/Ordered.hs --- a/Data/Map/Ordered.hs +++ b/Data/Map/Ordered.hs @@ -3,9 +3,9 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} --- | An 'OMap' behaves much like a 'Map', with mostly the same asymptotics, but +-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but -- also remembers the order that keys were inserted. All operations whose --- asymptotics are worse than 'Map' have documentation saying so. +-- asymptotics are worse than 'M.Map' have documentation saying so. module Data.Map.Ordered ( OMap -- * Trivial maps @@ -32,242 +32,11 @@ , Index, findIndex, elemAt -- * List conversions , fromList, assocs, toAscList + -- * 'M.Map' conversion + , toMap ) where -import Control.Applicative ((<|>)) -import Control.Monad (guard) -import Data.Data -import Data.Foldable (Foldable, foldl', foldMap) -import Data.Function (on) -import Data.Map (Map) +import qualified Data.Map as M () +import Data.Map.Ordered.Internal import Data.Map.Util -import Data.Monoid (Monoid(..)) -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup (Semigroup(..)) -#endif -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<$>)) -import Data.Traversable -#endif import Prelude hiding (filter, lookup, null) -import qualified Data.Map as M - -data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v)) - deriving (Functor, Typeable) - --- | Values are produced in insertion order, not key order. -instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs -instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs -instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs -instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs -instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList - --- This instance preserves data abstraction at the cost of inefficiency. --- We provide limited reflection services for the sake of data abstraction. -instance (Data k, Data a, Ord k) => Data (OMap k a) where - gfoldl f z m = z fromList `f` assocs m - toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - dataTypeOf _ = oMapDataType - -- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8. - dataCast2 f = gcast2 f - -fromListConstr :: Constr -fromListConstr = mkConstr oMapDataType "fromList" [] Prefix - -oMapDataType :: DataType -oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr] - -#if MIN_VERSION_base(4,9,0) -instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where - Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o') -instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where - Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o') -#endif - --- | Empty maps and map union. When combining two sets that share elements, the --- indices of the left argument are preferred, and the values are combined with --- 'mappend'. --- --- See the asymptotics of 'unionWithL'. -instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where - mempty = Bias empty - mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o') - --- | Empty maps and map union. When combining two sets that share elements, the --- indices of the right argument are preferred, and the values are combined --- with 'mappend'. --- --- See the asymptotics of 'unionWithR'. -instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where - mempty = Bias empty - mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o') - --- | Values are traversed in insertion order, not key order. --- --- /O(n*log(n))/ where /n/ is the size of the map. -instance Ord k => Traversable (OMap k) where - traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs - -infixr 5 <|, |< -- copy : -infixl 5 >|, |> -infixr 6 <>|, |<> -- copy <> - -(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v -(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v - --- | When a key occurs in both maps, prefer the value from the first map. --- --- See asymptotics of 'unionWithR'. -(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v - --- | When a key occurs in both maps, prefer the value from the first map. --- --- See asymptotics of 'unionWithL'. -(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v - -(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where - t = maybe (nextLowerTag kvs) fst (M.lookup k tvs) - -(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where - t = nextLowerTag kvs - OMap tvs kvs = delete k o - -o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where - t = nextHigherTag kvs - OMap tvs kvs = delete k o - -OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where - t = maybe (nextHigherTag kvs) fst (M.lookup k tvs) - -(<>|) = unionWithR (const const) -(|<>) = unionWithL (const const) - --- | Take the union. The first 'OMap' \'s argument's indices are lower than the --- second. If a key appears in both maps, the first argument's index takes --- precedence, and the supplied function is used to combine the values. --- --- /O(r*log(r))/ where /r/ is the size of the result -unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v -unionWithL = unionWithInternal (\t t' -> t ) - --- | Take the union. The first 'OMap' \'s argument's indices are lower than the --- second. If a key appears in both maps, the second argument's index takes --- precedence, and the supplied function is used to combine the values. --- --- /O(r*log(r))/ where /r/ is the size of the result -unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v -unionWithR = unionWithInternal (\t t' -> t') - -unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v -unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where - bump = case maxTag kvs of - Nothing -> 0 - Just k -> -k-1 - bump' = case minTag kvs' of - Nothing -> 0 - Just k -> -k - tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v')) - (fmap (\(t,v) -> (bump +t,v)) tvs ) - (fmap (\(t,v) -> (bump'+t,v)) tvs') - --- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@ --- --- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size --- of the larger map. -(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v -o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o' - then filter (const . (`notMember` o')) o - else foldr delete o (fmap fst (assocs o')) - -empty :: OMap k v -empty = OMap M.empty M.empty - -singleton :: (k, v) -> OMap k v -singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv) - --- | If a key appears multiple times, the first occurrence is used for ordering --- and the last occurrence is used for its value. The library author welcomes --- comments on whether this default is sane. -fromList :: Ord k => [(k, v)] -> OMap k v -fromList = foldl' (|>) empty - -null :: OMap k v -> Bool -null (OMap tvs _) = M.null tvs - -size :: OMap k v -> Int -size (OMap tvs _) = M.size tvs - -member, notMember :: Ord k => k -> OMap k v -> Bool -member k (OMap tvs _) = M.member k tvs -notMember k (OMap tvs _) = M.notMember k tvs - -lookup :: Ord k => k -> OMap k v -> Maybe v -lookup k (OMap tvs _) = fmap snd (M.lookup k tvs) - --- The Ord constraint is for compatibility with older (<0.5) versions of --- containers. --- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@, --- without changing the order they appear -filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v -filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs) - (M.filterWithKey (\t (k, v) -> f k v) kvs) - -delete :: Ord k => k -> OMap k v -> OMap k v -delete k o@(OMap tvs kvs) = case M.lookup k tvs of - Nothing -> o - Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs) - --- | Intersection. (The @/\\@ is intended to look a bit like the standard --- mathematical notation for set intersection.) --- --- See asymptotics of 'intersectionWith'. -(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v -o /\| o' = intersectionWith (\k v' v -> v) o' o - --- | Intersection. (The @/\\@ is intended to look a bit like the standard --- mathematical notation for set intersection.) --- --- See asymptotics of 'intersectionWith'. -(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v -o |/\ o' = intersectionWith (\k v v' -> v) o o' - --- | Take the intersection. The first 'OMap' \'s argument's indices are used for --- the result. --- --- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/ --- is the size of the larger map, and /r/ is the size of the result. -intersectionWith :: - Ord k => - (k -> v -> v' -> v'') -> - OMap k v -> OMap k v' -> OMap k v'' -intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV - $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs' - -fromTV :: Ord k => Map k (Tag, v) -> OMap k v -fromTV tvs = OMap tvs kvs where - kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs] - -fromKV :: Ord k => Map Tag (k, v) -> OMap k v -fromKV kvs = OMap tvs kvs where - tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs] - -findIndex :: Ord k => k -> OMap k v -> Maybe Index -findIndex k o@(OMap tvs kvs) = do - (t, _) <- M.lookup k tvs - M.lookupIndex t kvs - -elemAt :: OMap k v -> Index -> Maybe (k, v) -elemAt o@(OMap tvs kvs) i = do - guard (0 <= i && i < M.size kvs) - return . snd $ M.elemAt i kvs - --- | Return key-value pairs in the order they were inserted. -assocs :: OMap k v -> [(k, v)] -assocs (OMap _ kvs) = map snd $ M.toAscList kvs - --- | Return key-value pairs in order of increasing key. -toAscList :: OMap k v -> [(k, v)] -toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs diff --git a/Data/Map/Ordered/Internal.hs b/Data/Map/Ordered/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Map/Ordered/Internal.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Map.Ordered.Internal where + +import Control.Applicative ((<|>)) +import Control.Monad (guard) +import Data.Data +import Data.Foldable (Foldable, foldl', foldMap) +import Data.Function (on) +import Data.Map (Map) +import Data.Map.Util +import Data.Monoid (Monoid(..)) +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup(..)) +#endif +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<$>)) +import Data.Traversable +#endif +import Prelude hiding (filter, lookup, null) +import qualified Data.Map as M + +data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v)) + deriving (Functor, Typeable) + +-- | Values are produced in insertion order, not key order. +instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs +instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs +instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs +instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs +instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList + +-- This instance preserves data abstraction at the cost of inefficiency. +-- We provide limited reflection services for the sake of data abstraction. +instance (Data k, Data a, Ord k) => Data (OMap k a) where + gfoldl f z m = z fromList `f` assocs m + toConstr _ = fromListConstr + gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + dataTypeOf _ = oMapDataType + -- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8. + dataCast2 f = gcast2 f + +fromListConstr :: Constr +fromListConstr = mkConstr oMapDataType "fromList" [] Prefix + +oMapDataType :: DataType +oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr] + +#if MIN_VERSION_base(4,9,0) +instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where + Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o') +instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where + Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o') +#endif + +-- | Empty maps and map union. When combining two sets that share elements, the +-- indices of the left argument are preferred, and the values are combined with +-- 'mappend'. +-- +-- See the asymptotics of 'unionWithL'. +instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where + mempty = Bias empty + mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o') + +-- | Empty maps and map union. When combining two sets that share elements, the +-- indices of the right argument are preferred, and the values are combined +-- with 'mappend'. +-- +-- See the asymptotics of 'unionWithR'. +instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where + mempty = Bias empty + mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o') + +-- | Values are traversed in insertion order, not key order. +-- +-- /O(n*log(n))/ where /n/ is the size of the map. +instance Ord k => Traversable (OMap k) where + traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs + +infixr 5 <|, |< -- copy : +infixl 5 >|, |> +infixr 6 <>|, |<> -- copy <> + +(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v +(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v + +-- | When a key occurs in both maps, prefer the value from the first map. +-- +-- See asymptotics of 'unionWithR'. +(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v + +-- | When a key occurs in both maps, prefer the value from the first map. +-- +-- See asymptotics of 'unionWithL'. +(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v + +(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = maybe (nextLowerTag kvs) fst (M.lookup k tvs) + +(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = nextLowerTag kvs + OMap tvs kvs = delete k o + +o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = nextHigherTag kvs + OMap tvs kvs = delete k o + +OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = maybe (nextHigherTag kvs) fst (M.lookup k tvs) + +(<>|) = unionWithR (const const) +(|<>) = unionWithL (const const) + +-- | Take the union. The first 'OMap' \'s argument's indices are lower than the +-- second. If a key appears in both maps, the first argument's index takes +-- precedence, and the supplied function is used to combine the values. +-- +-- /O(r*log(r))/ where /r/ is the size of the result +unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithL = unionWithInternal (\t t' -> t ) + +-- | Take the union. The first 'OMap' \'s argument's indices are lower than the +-- second. If a key appears in both maps, the second argument's index takes +-- precedence, and the supplied function is used to combine the values. +-- +-- /O(r*log(r))/ where /r/ is the size of the result +unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithR = unionWithInternal (\t t' -> t') + +unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where + bump = case maxTag kvs of + Nothing -> 0 + Just k -> -k-1 + bump' = case minTag kvs' of + Nothing -> 0 + Just k -> -k + tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v')) + (fmap (\(t,v) -> (bump +t,v)) tvs ) + (fmap (\(t,v) -> (bump'+t,v)) tvs') + +-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@ +-- +-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size +-- of the larger map. +(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v +o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o' + then filter (const . (`notMember` o')) o + else foldr delete o (fmap fst (assocs o')) + +empty :: OMap k v +empty = OMap M.empty M.empty + +singleton :: (k, v) -> OMap k v +singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv) + +-- | If a key appears multiple times, the first occurrence is used for ordering +-- and the last occurrence is used for its value. The library author welcomes +-- comments on whether this default is sane. +fromList :: Ord k => [(k, v)] -> OMap k v +fromList = foldl' (|>) empty + +null :: OMap k v -> Bool +null (OMap tvs _) = M.null tvs + +size :: OMap k v -> Int +size (OMap tvs _) = M.size tvs + +member, notMember :: Ord k => k -> OMap k v -> Bool +member k (OMap tvs _) = M.member k tvs +notMember k (OMap tvs _) = M.notMember k tvs + +lookup :: Ord k => k -> OMap k v -> Maybe v +lookup k (OMap tvs _) = fmap snd (M.lookup k tvs) + +-- The Ord constraint is for compatibility with older (<0.5) versions of +-- containers. +-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@, +-- without changing the order they appear +filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v +filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs) + (M.filterWithKey (\t (k, v) -> f k v) kvs) + +delete :: Ord k => k -> OMap k v -> OMap k v +delete k o@(OMap tvs kvs) = case M.lookup k tvs of + Nothing -> o + Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs) + +-- | Intersection. (The @/\\@ is intended to look a bit like the standard +-- mathematical notation for set intersection.) +-- +-- See asymptotics of 'intersectionWith'. +(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v +o /\| o' = intersectionWith (\k v' v -> v) o' o + +-- | Intersection. (The @/\\@ is intended to look a bit like the standard +-- mathematical notation for set intersection.) +-- +-- See asymptotics of 'intersectionWith'. +(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v +o |/\ o' = intersectionWith (\k v v' -> v) o o' + +-- | Take the intersection. The first 'OMap' \'s argument's indices are used for +-- the result. +-- +-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/ +-- is the size of the larger map, and /r/ is the size of the result. +intersectionWith :: + Ord k => + (k -> v -> v' -> v'') -> + OMap k v -> OMap k v' -> OMap k v'' +intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV + $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs' + +fromTV :: Ord k => Map k (Tag, v) -> OMap k v +fromTV tvs = OMap tvs kvs where + kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs] + +fromKV :: Ord k => Map Tag (k, v) -> OMap k v +fromKV kvs = OMap tvs kvs where + tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs] + +findIndex :: Ord k => k -> OMap k v -> Maybe Index +findIndex k o@(OMap tvs kvs) = do + (t, _) <- M.lookup k tvs + M.lookupIndex t kvs + +elemAt :: OMap k v -> Index -> Maybe (k, v) +elemAt o@(OMap tvs kvs) i = do + guard (0 <= i && i < M.size kvs) + return . snd $ M.elemAt i kvs + +-- | Return key-value pairs in the order they were inserted. +assocs :: OMap k v -> [(k, v)] +assocs (OMap _ kvs) = map snd $ M.toAscList kvs + +-- | Return key-value pairs in order of increasing key. +toAscList :: OMap k v -> [(k, v)] +toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs + +-- | Convert an 'OMap' to a 'Map'. +-- +-- /O(n)/, where /n/ is the size of the 'OMap'. +toMap :: OMap k v -> Map k v +toMap (OMap tvs _) = fmap snd tvs diff --git a/Data/Map/Ordered/Strict.hs b/Data/Map/Ordered/Strict.hs new file mode 100644 --- /dev/null +++ b/Data/Map/Ordered/Strict.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but +-- also remembers the order that keys were inserted. All operations whose +-- asymptotics are worse than 'M.Map' have documentation saying so. +module Data.Map.Ordered.Strict + ( OMap + -- * Trivial maps + , empty, singleton + -- * Insertion + -- | Conventions: + -- + -- * The open side of an angle bracket points to an 'OMap' + -- + -- * The pipe appears on the side whose indices take precedence if both sides contain the same key + -- + -- * The left argument's indices are lower than the right argument's indices + -- + -- * If both sides contain the same key, the tuple's value wins + , (<|), (|<), (>|), (|>) + , (<>|), (|<>), unionWithL, unionWithR + , Bias(Bias, unbiased), L, R + -- * Deletion + , delete, filter, (\\) + , (|/\), (/\|), intersectionWith + -- * Query + , null, size, member, notMember, lookup + -- * Indexing + , Index, findIndex, elemAt + -- * List conversions + , fromList, assocs, toAscList + -- * 'M.Map' conversion + , toMap + ) where + +import Data.Foldable (foldl') +import qualified Data.Map.Strict as M +import Data.Map.Ordered.Internal + ( OMap(..), empty, (<>|), (|<>), delete, filter, (\\), (|/\), (/\|), null, size + , member, notMember, lookup, findIndex, elemAt, assocs, toAscList, fromTV, toMap ) +import Data.Map.Util +import Prelude hiding (filter, lookup, null) + +infixr 5 <|, |< -- copy : +infixl 5 >|, |> + +(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v +(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v + +(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = maybe (nextLowerTag kvs) fst (M.lookup k tvs) + +(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = nextLowerTag kvs + OMap tvs kvs = delete k o + +o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = nextHigherTag kvs + OMap tvs kvs = delete k o + +OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where + t = maybe (nextHigherTag kvs) fst (M.lookup k tvs) + +-- | Take the union. The first 'OMap' \'s argument's indices are lower than the +-- second. If a key appears in both maps, the first argument's index takes +-- precedence, and the supplied function is used to combine the values. +-- +-- /O(r*log(r))/ where /r/ is the size of the result +unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithL = unionWithInternal (\t t' -> t ) + +-- | Take the union. The first 'OMap' \'s argument's indices are lower than the +-- second. If a key appears in both maps, the second argument's index takes +-- precedence, and the supplied function is used to combine the values. +-- +-- /O(r*log(r))/ where /r/ is the size of the result +unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithR = unionWithInternal (\t t' -> t') + +unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v +unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where + bump = case maxTag kvs of + Nothing -> 0 + Just k -> -k-1 + bump' = case minTag kvs' of + Nothing -> 0 + Just k -> -k + tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v')) + (fmap (\(t,v) -> (bump +t,v)) tvs ) + (fmap (\(t,v) -> (bump'+t,v)) tvs') + +singleton :: (k, v) -> OMap k v +singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv) + +-- | If a key appears multiple times, the first occurrence is used for ordering +-- and the last occurrence is used for its value. The library author welcomes +-- comments on whether this default is sane. +fromList :: Ord k => [(k, v)] -> OMap k v +fromList = foldl' (|>) empty + +-- | Take the intersection. The first 'OMap' \'s argument's indices are used for +-- the result. +-- +-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/ +-- is the size of the larger map, and /r/ is the size of the result. +intersectionWith :: + Ord k => + (k -> v -> v' -> v'') -> + OMap k v -> OMap k v' -> OMap k v'' +intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV + $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs' diff --git a/Data/Map/Util.hs b/Data/Map/Util.hs --- a/Data/Map/Util.hs +++ b/Data/Map/Util.hs @@ -1,12 +1,23 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE KindSignatures #-} module Data.Map.Util where +import Data.Data (Data, Typeable) import Data.Map (Map) import Data.Monoid -- so that the docs for Monoid link to the right place import qualified Data.Map as M +#if !(MIN_VERSION_base(4,8,0)) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable) +#endif + -- | An internal index used to track ordering only -- its magnitude doesn't -- matter. If you manage to see this documentation, the library author has made -- a mistake! @@ -38,6 +49,8 @@ -- tells whether 'mappend' will prefer the indices of its first or second -- argument if there are shared elements in both. newtype Bias (dir :: IndexPreference) a = Bias { unbiased :: a } + deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable) data IndexPreference = L | R + deriving Typeable type L = 'L type R = 'R diff --git a/Data/Set/Ordered.hs b/Data/Set/Ordered.hs --- a/Data/Set/Ordered.hs +++ b/Data/Set/Ordered.hs @@ -28,6 +28,8 @@ , Index, findIndex, elemAt -- * List conversions , fromList, toAscList + -- * 'Set' conversion + , toSet ) where import Control.Monad (guard) @@ -216,3 +218,9 @@ -- insertion order.) toAscList :: OSet a -> [a] toAscList o@(OSet ts _) = fmap fst (M.toAscList ts) + +-- | Convert an 'OSet' to a 'Set'. +-- +-- /O(n)/, where /n/ is the size of the 'OSet'. +toSet :: OSet a -> Set a +toSet (OSet ts _) = M.keysSet ts diff --git a/ordered-containers.cabal b/ordered-containers.cabal --- a/ordered-containers.cabal +++ b/ordered-containers.cabal @@ -1,5 +1,5 @@ name: ordered-containers -version: 0.2.1 +version: 0.2.2 synopsis: Set- and Map-like types that remember the order elements were inserted license: BSD3 license-file: LICENSE @@ -15,8 +15,8 @@ location: https://github.com/dmwit/ordered-containers library - exposed-modules: Data.Map.Ordered, Data.Set.Ordered - other-modules: Data.Map.Util + exposed-modules: Data.Map.Ordered, Data.Map.Ordered.Strict, Data.Set.Ordered + other-modules: Data.Map.Ordered.Internal, Data.Map.Util build-depends: base >=4.7 && <5, containers >=0.1 && <0.7 default-language: Haskell98 ghc-options: -fno-warn-tabs