git.iko.soy/typeable/ordered-containers
on master help sign in
swap
b9e405313 ahead, 0 behind
ChangeLog.md+21
since splitsnapshots
unifiedsplit
@@ -1,5 +1,26 @@
1# Revision history for ordered-containers
1# Revision history for ordered-containers
2
2
3+## 0.2.2 -- 2019-07-05
4+
5+* Add `toMap` and `toSet`, which support efficient conversions from
6+ `OMap`s/`OSet`s to `Map`s/`Set`s, respectively.
7+
8+## 0.2.1 -- 2019-03-25
9+
10+* Compatibility fixes from Ryan Scott (thanks!)
11+
12+## 0.2 -- 2019-03-24
13+
14+* Support many more operations:
15+ * Semigroup,Monoid,Data,Typeable for OSet
16+ * Semigroup,Monoid,Functor,Traversable,Data,Typeable for OMap
17+ * union and intersection primitives for both
18+* Document asymptotics (when they vary from Set and Map)
19+
20+## 0.1.1 -- 2018-10-31
21+
22+* Metadata changes only
23+
3## 0.1.0 -- 2016-12-26
24## 0.1.0 -- 2016-12-26
4
25
5* Documentation fix
26* Documentation fix
Data/Map/Ordered.hs+10−194
@@ -1,9 +1,11 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE FlexibleInstances #-}
3
5
4−-- | An 'OMap' behaves much like a 'Map', with mostly the same asymptotics, but
6+-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but
5-- also remembers the order that keys were inserted. All operations whose
7-- also remembers the order that keys were inserted. All operations whose
6−-- asymptotics are worse than 'Map' have documentation saying so.
8+-- asymptotics are worse than 'M.Map' have documentation saying so.
7module Data.Map.Ordered
9module Data.Map.Ordered
8 ( OMap
10 ( OMap
9 -- * Trivial maps
11 -- * Trivial maps
@@ -20,6 +22,7 @@ module Data.Map.Ordered
20 -- * If both sides contain the same key, the tuple's value wins
22 -- * If both sides contain the same key, the tuple's value wins
21 , (<|), (|<), (>|), (|>)
23 , (<|), (|<), (>|), (|>)
22 , (<>|), (|<>), unionWithL, unionWithR
24 , (<>|), (|<>), unionWithL, unionWithR
25+ , Bias(Bias, unbiased), L, R
23 -- * Deletion
26 -- * Deletion
24 , delete, filter, (\\)
27 , delete, filter, (\\)
25 , (|/\), (/\|), intersectionWith
28 , (|/\), (/\|), intersectionWith
@@ -29,198 +32,11 @@ module Data.Map.Ordered
29 , Index, findIndex, elemAt
32 , Index, findIndex, elemAt
30 -- * List conversions
33 -- * List conversions
31 , fromList, assocs, toAscList
34 , fromList, assocs, toAscList
35+ -- * 'M.Map' conversion
36+ , toMap
32 ) where
37 ) where
33
38
34−import Control.Applicative ((<|>))
39+import qualified Data.Map as M ()
35−import Control.Monad (guard)
36−import Data.Data
37−import Data.Foldable (Foldable, foldl', foldMap)
38−import Data.Function (on)
39−import Data.Map (Map)
40+import Data.Map.Ordered.Internal
40−import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)
41+import Data.Map.Util
41import Prelude hiding (filter, lookup, null)
42import Prelude hiding (filter, lookup, null)
42−import qualified Data.Map as M
43−
44−data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))
45− deriving (Functor, Typeable)
46−
47−-- | Values are produced in insertion order, not key order.
48−instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs
49−instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs
50−instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs
51−instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs
52−instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList
53−
54−-- This instance preserves data abstraction at the cost of inefficiency.
55−-- We provide limited reflection services for the sake of data abstraction.
56−instance (Data k, Data a, Ord k) => Data (OMap k a) where
57− gfoldl f z m = z fromList `f` assocs m
58− toConstr _ = fromListConstr
59− gunfold k z c = case constrIndex c of
60− 1 -> k (z fromList)
61− _ -> error "gunfold"
62− dataTypeOf _ = oMapDataType
63− dataCast2 = gcast2
64−
65−fromListConstr :: Constr
66−fromListConstr = mkConstr oMapDataType "fromList" [] Prefix
67−
68−oMapDataType :: DataType
69−oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]
70−
71−infixr 5 <|, |< -- copy :
72−infixl 5 >|, |>
73−infixr 6 <>|, |<> -- copy <>
74−
75−(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
76−(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
77−
78−-- | When a key occurs in both maps, prefer the value from the first map.
79−--
80−-- See asymptotics of 'unionWithR'.
81−(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v
82−
83−-- | When a key occurs in both maps, prefer the value from the first map.
84−--
85−-- See asymptotics of 'unionWithL'.
86−(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v
87−
88−(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
89− t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
90−
91−(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
92− t = nextLowerTag kvs
93− OMap tvs kvs = delete k o
94−
95−o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
96− t = nextHigherTag kvs
97− OMap tvs kvs = delete k o
98−
99−OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
100− t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
101−
102−(<>|) = unionWithR (const const)
103−(|<>) = unionWithL (const const)
104−
105−-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
106−-- second. If a key appears in both maps, the first argument's index takes
107−-- precedence, and the supplied function is used to combine the values.
108−--
109−-- /O(r*log(r))/ where /r/ is the size of the result
110−unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
111−unionWithL = unionWithInternal (\t t' -> t )
112−
113−-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
114−-- second. If a key appears in both maps, the second argument's index takes
115−-- precedence, and the supplied function is used to combine the values.
116−--
117−-- /O(r*log(r))/ where /r/ is the size of the result
118−unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
119−unionWithR = unionWithInternal (\t t' -> t')
120−
121−unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
122−unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where
123− bump = case maxTag kvs of
124− Nothing -> 0
125− Just k -> -k-1
126− bump' = case minTag kvs' of
127− Nothing -> 0
128− Just k -> -k
129− tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))
130− (fmap (\(t,v) -> (bump +t,v)) tvs )
131− (fmap (\(t,v) -> (bump'+t,v)) tvs')
132−
133−-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@
134−--
135−-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size
136−-- of the larger map.
137−(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
138−o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'
139− then filter (const . (`notMember` o')) o
140− else foldr delete o (fmap fst (assocs o'))
141−
142−empty :: OMap k v
143−empty = OMap M.empty M.empty
144−
145−singleton :: (k, v) -> OMap k v
146−singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
147−
148−-- | If a key appears multiple times, the first occurrence is used for ordering
149−-- and the last occurrence is used for its value. The library author welcomes
150−-- comments on whether this default is sane.
151−fromList :: Ord k => [(k, v)] -> OMap k v
152−fromList = foldl' (|>) empty
153−
154−null :: OMap k v -> Bool
155−null (OMap tvs _) = M.null tvs
156−
157−size :: OMap k v -> Int
158−size (OMap tvs _) = M.size tvs
159−
160−member, notMember :: Ord k => k -> OMap k v -> Bool
161−member k (OMap tvs _) = M.member k tvs
162−notMember k (OMap tvs _) = M.notMember k tvs
163−
164−lookup :: Ord k => k -> OMap k v -> Maybe v
165−lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)
166−
167−-- The Ord constraint is for compatibility with older (<0.5) versions of
168−-- containers.
169−-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,
170−-- without changing the order they appear
171−filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
172−filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)
173− (M.filterWithKey (\t (k, v) -> f k v) kvs)
174−
175−delete :: Ord k => k -> OMap k v -> OMap k v
176−delete k o@(OMap tvs kvs) = case M.lookup k tvs of
177− Nothing -> o
178− Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)
179−
180−-- | Intersection. (The @/\\@ is intended to look a bit like the standard
181−-- mathematical notation for set intersection.)
182−--
183−-- See asymptotics of 'intersectionWith'.
184−(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v
185−o /\| o' = intersectionWith (\k v' v -> v) o' o
186−
187−-- | Intersection. (The @/\\@ is intended to look a bit like the standard
188−-- mathematical notation for set intersection.)
189−--
190−-- See asymptotics of 'intersectionWith'.
191−(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
192−o |/\ o' = intersectionWith (\k v v' -> v) o o'
193−
194−-- | Take the intersection. The first 'OMap' \'s argument's indices are used for
195−-- the result.
196−--
197−-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/
198−-- is the size of the larger map, and /r/ is the size of the result.
199−intersectionWith ::
200− Ord k =>
201− (k -> v -> v' -> v'') ->
202− OMap k v -> OMap k v' -> OMap k v''
203−intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV
204− $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'
205−
206−fromTV :: Ord k => Map k (Tag, v) -> OMap k v
207−fromTV tvs = OMap tvs kvs where
208− kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]
209−
210−findIndex :: Ord k => k -> OMap k v -> Maybe Index
211−findIndex k o@(OMap tvs kvs) = do
212− (t, _) <- M.lookup k tvs
213− M.lookupIndex t kvs
214−
215−elemAt :: OMap k v -> Index -> Maybe (k, v)
216−elemAt o@(OMap tvs kvs) i = do
217− guard (0 <= i && i < M.size kvs)
218− return . snd $ M.elemAt i kvs
219−
220−-- | Return key-value pairs in the order they were inserted.
221−assocs :: OMap k v -> [(k, v)]
222−assocs (OMap _ kvs) = map snd $ M.toAscList kvs
223−
224−-- | Return key-value pairs in order of increasing key.
225−toAscList :: OMap k v -> [(k, v)]
226−toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs
Data/Map/Ordered/Internal.hsnew file+250
@@ -0,0 +1,250 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+
6+module Data.Map.Ordered.Internal where
7+
8+import Control.Applicative ((<|>))
9+import Control.Monad (guard)
10+import Data.Data
11+import Data.Foldable (Foldable, foldl', foldMap)
12+import Data.Function (on)
13+import Data.Map (Map)
14+import Data.Map.Util
15+import Data.Monoid (Monoid(..))
16+#if MIN_VERSION_base(4,9,0)
17+import Data.Semigroup (Semigroup(..))
18+#endif
19+#if !(MIN_VERSION_base(4,8,0))
20+import Control.Applicative ((<$>))
21+import Data.Traversable
22+#endif
23+import Prelude hiding (filter, lookup, null)
24+import qualified Data.Map as M
25+
26+data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))
27+ deriving (Functor, Typeable)
28+
29+-- | Values are produced in insertion order, not key order.
30+instance Foldable (OMap k) where foldMap f (OMap _ kvs) = foldMap (f . snd) kvs
31+instance ( Eq k, Eq v) => Eq (OMap k v) where (==) = (==) `on` assocs
32+instance ( Ord k, Ord v) => Ord (OMap k v) where compare = compare `on` assocs
33+instance ( Show k, Show v) => Show (OMap k v) where showsPrec = showsPrecList assocs
34+instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec = readsPrecList fromList
35+
36+-- This instance preserves data abstraction at the cost of inefficiency.
37+-- We provide limited reflection services for the sake of data abstraction.
38+instance (Data k, Data a, Ord k) => Data (OMap k a) where
39+ gfoldl f z m = z fromList `f` assocs m
40+ toConstr _ = fromListConstr
41+ gunfold k z c = case constrIndex c of
42+ 1 -> k (z fromList)
43+ _ -> error "gunfold"
44+ dataTypeOf _ = oMapDataType
45+ -- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8.
46+ dataCast2 f = gcast2 f
47+
48+fromListConstr :: Constr
49+fromListConstr = mkConstr oMapDataType "fromList" [] Prefix
50+
51+oMapDataType :: DataType
52+oMapDataType = mkDataType "Data.Map.Ordered.Map" [fromListConstr]
53+
54+#if MIN_VERSION_base(4,9,0)
55+instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where
56+ Bias o <> Bias o' = Bias (unionWithL (const (<>)) o o')
57+instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where
58+ Bias o <> Bias o' = Bias (unionWithR (const (<>)) o o')
59+#endif
60+
61+-- | Empty maps and map union. When combining two sets that share elements, the
62+-- indices of the left argument are preferred, and the values are combined with
63+-- 'mappend'.
64+--
65+-- See the asymptotics of 'unionWithL'.
66+instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where
67+ mempty = Bias empty
68+ mappend (Bias o) (Bias o') = Bias (unionWithL (const mappend) o o')
69+
70+-- | Empty maps and map union. When combining two sets that share elements, the
71+-- indices of the right argument are preferred, and the values are combined
72+-- with 'mappend'.
73+--
74+-- See the asymptotics of 'unionWithR'.
75+instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where
76+ mempty = Bias empty
77+ mappend (Bias o) (Bias o') = Bias (unionWithR (const mappend) o o')
78+
79+-- | Values are traversed in insertion order, not key order.
80+--
81+-- /O(n*log(n))/ where /n/ is the size of the map.
82+instance Ord k => Traversable (OMap k) where
83+ traverse f (OMap tvs kvs) = fromKV <$> traverse (\(k,v) -> (,) k <$> f v) kvs
84+
85+infixr 5 <|, |< -- copy :
86+infixl 5 >|, |>
87+infixr 6 <>|, |<> -- copy <>
88+
89+(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
90+(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
91+
92+-- | When a key occurs in both maps, prefer the value from the first map.
93+--
94+-- See asymptotics of 'unionWithR'.
95+(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v
96+
97+-- | When a key occurs in both maps, prefer the value from the first map.
98+--
99+-- See asymptotics of 'unionWithL'.
100+(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v
101+
102+(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
103+ t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
104+
105+(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
106+ t = nextLowerTag kvs
107+ OMap tvs kvs = delete k o
108+
109+o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
110+ t = nextHigherTag kvs
111+ OMap tvs kvs = delete k o
112+
113+OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
114+ t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
115+
116+(<>|) = unionWithR (const const)
117+(|<>) = unionWithL (const const)
118+
119+-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
120+-- second. If a key appears in both maps, the first argument's index takes
121+-- precedence, and the supplied function is used to combine the values.
122+--
123+-- /O(r*log(r))/ where /r/ is the size of the result
124+unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
125+unionWithL = unionWithInternal (\t t' -> t )
126+
127+-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
128+-- second. If a key appears in both maps, the second argument's index takes
129+-- precedence, and the supplied function is used to combine the values.
130+--
131+-- /O(r*log(r))/ where /r/ is the size of the result
132+unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
133+unionWithR = unionWithInternal (\t t' -> t')
134+
135+unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
136+unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where
137+ bump = case maxTag kvs of
138+ Nothing -> 0
139+ Just k -> -k-1
140+ bump' = case minTag kvs' of
141+ Nothing -> 0
142+ Just k -> -k
143+ tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))
144+ (fmap (\(t,v) -> (bump +t,v)) tvs )
145+ (fmap (\(t,v) -> (bump'+t,v)) tvs')
146+
147+-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@
148+--
149+-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size
150+-- of the larger map.
151+(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
152+o@(OMap tvs kvs) \\ o'@(OMap tvs' kvs') = if size o < size o'
153+ then filter (const . (`notMember` o')) o
154+ else foldr delete o (fmap fst (assocs o'))
155+
156+empty :: OMap k v
157+empty = OMap M.empty M.empty
158+
159+singleton :: (k, v) -> OMap k v
160+singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
161+
162+-- | If a key appears multiple times, the first occurrence is used for ordering
163+-- and the last occurrence is used for its value. The library author welcomes
164+-- comments on whether this default is sane.
165+fromList :: Ord k => [(k, v)] -> OMap k v
166+fromList = foldl' (|>) empty
167+
168+null :: OMap k v -> Bool
169+null (OMap tvs _) = M.null tvs
170+
171+size :: OMap k v -> Int
172+size (OMap tvs _) = M.size tvs
173+
174+member, notMember :: Ord k => k -> OMap k v -> Bool
175+member k (OMap tvs _) = M.member k tvs
176+notMember k (OMap tvs _) = M.notMember k tvs
177+
178+lookup :: Ord k => k -> OMap k v -> Maybe v
179+lookup k (OMap tvs _) = fmap snd (M.lookup k tvs)
180+
181+-- The Ord constraint is for compatibility with older (<0.5) versions of
182+-- containers.
183+-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,
184+-- without changing the order they appear
185+filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
186+filter f (OMap tvs kvs) = OMap (M.filterWithKey (\k (t, v) -> f k v) tvs)
187+ (M.filterWithKey (\t (k, v) -> f k v) kvs)
188+
189+delete :: Ord k => k -> OMap k v -> OMap k v
190+delete k o@(OMap tvs kvs) = case M.lookup k tvs of
191+ Nothing -> o
192+ Just (t, _) -> OMap (M.delete k tvs) (M.delete t kvs)
193+
194+-- | Intersection. (The @/\\@ is intended to look a bit like the standard
195+-- mathematical notation for set intersection.)
196+--
197+-- See asymptotics of 'intersectionWith'.
198+(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v
199+o /\| o' = intersectionWith (\k v' v -> v) o' o
200+
201+-- | Intersection. (The @/\\@ is intended to look a bit like the standard
202+-- mathematical notation for set intersection.)
203+--
204+-- See asymptotics of 'intersectionWith'.
205+(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
206+o |/\ o' = intersectionWith (\k v v' -> v) o o'
207+
208+-- | Take the intersection. The first 'OMap' \'s argument's indices are used for
209+-- the result.
210+--
211+-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/
212+-- is the size of the larger map, and /r/ is the size of the result.
213+intersectionWith ::
214+ Ord k =>
215+ (k -> v -> v' -> v'') ->
216+ OMap k v -> OMap k v' -> OMap k v''
217+intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV
218+ $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'
219+
220+fromTV :: Ord k => Map k (Tag, v) -> OMap k v
221+fromTV tvs = OMap tvs kvs where
222+ kvs = M.fromList [(t,(k,v)) | (k,(t,v)) <- M.toList tvs]
223+
224+fromKV :: Ord k => Map Tag (k, v) -> OMap k v
225+fromKV kvs = OMap tvs kvs where
226+ tvs = M.fromList [(k,(t,v)) | (t,(k,v)) <- M.toList kvs]
227+
228+findIndex :: Ord k => k -> OMap k v -> Maybe Index
229+findIndex k o@(OMap tvs kvs) = do
230+ (t, _) <- M.lookup k tvs
231+ M.lookupIndex t kvs
232+
233+elemAt :: OMap k v -> Index -> Maybe (k, v)
234+elemAt o@(OMap tvs kvs) i = do
235+ guard (0 <= i && i < M.size kvs)
236+ return . snd $ M.elemAt i kvs
237+
238+-- | Return key-value pairs in the order they were inserted.
239+assocs :: OMap k v -> [(k, v)]
240+assocs (OMap _ kvs) = map snd $ M.toAscList kvs
241+
242+-- | Return key-value pairs in order of increasing key.
243+toAscList :: OMap k v -> [(k, v)]
244+toAscList (OMap tvs kvs) = map (\(k, (t, v)) -> (k, v)) $ M.toAscList tvs
245+
246+-- | Convert an 'OMap' to a 'Map'.
247+--
248+-- /O(n)/, where /n/ is the size of the 'OMap'.
249+toMap :: OMap k v -> Map k v
250+toMap (OMap tvs _) = fmap snd tvs
Data/Map/Ordered/Strict.hsnew file+114
@@ -0,0 +1,114 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+
6+-- | An 'OMap' behaves much like a 'M.Map', with mostly the same asymptotics, but
7+-- also remembers the order that keys were inserted. All operations whose
8+-- asymptotics are worse than 'M.Map' have documentation saying so.
9+module Data.Map.Ordered.Strict
10+ ( OMap
11+ -- * Trivial maps
12+ , empty, singleton
13+ -- * Insertion
14+ -- | Conventions:
15+ --
16+ -- * The open side of an angle bracket points to an 'OMap'
17+ --
18+ -- * The pipe appears on the side whose indices take precedence if both sides contain the same key
19+ --
20+ -- * The left argument's indices are lower than the right argument's indices
21+ --
22+ -- * If both sides contain the same key, the tuple's value wins
23+ , (<|), (|<), (>|), (|>)
24+ , (<>|), (|<>), unionWithL, unionWithR
25+ , Bias(Bias, unbiased), L, R
26+ -- * Deletion
27+ , delete, filter, (\\)
28+ , (|/\), (/\|), intersectionWith
29+ -- * Query
30+ , null, size, member, notMember, lookup
31+ -- * Indexing
32+ , Index, findIndex, elemAt
33+ -- * List conversions
34+ , fromList, assocs, toAscList
35+ -- * 'M.Map' conversion
36+ , toMap
37+ ) where
38+
39+import Data.Foldable (foldl')
40+import qualified Data.Map.Strict as M
41+import Data.Map.Ordered.Internal
42+ ( OMap(..), empty, (<>|), (|<>), delete, filter, (\\), (|/\), (/\|), null, size
43+ , member, notMember, lookup, findIndex, elemAt, assocs, toAscList, fromTV, toMap )
44+import Data.Map.Util
45+import Prelude hiding (filter, lookup, null)
46+
47+infixr 5 <|, |< -- copy :
48+infixl 5 >|, |>
49+
50+(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
51+(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
52+
53+(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
54+ t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
55+
56+(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
57+ t = nextLowerTag kvs
58+ OMap tvs kvs = delete k o
59+
60+o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
61+ t = nextHigherTag kvs
62+ OMap tvs kvs = delete k o
63+
64+OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
65+ t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
66+
67+-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
68+-- second. If a key appears in both maps, the first argument's index takes
69+-- precedence, and the supplied function is used to combine the values.
70+--
71+-- /O(r*log(r))/ where /r/ is the size of the result
72+unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
73+unionWithL = unionWithInternal (\t t' -> t )
74+
75+-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
76+-- second. If a key appears in both maps, the second argument's index takes
77+-- precedence, and the supplied function is used to combine the values.
78+--
79+-- /O(r*log(r))/ where /r/ is the size of the result
80+unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
81+unionWithR = unionWithInternal (\t t' -> t')
82+
83+unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
84+unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where
85+ bump = case maxTag kvs of
86+ Nothing -> 0
87+ Just k -> -k-1
88+ bump' = case minTag kvs' of
89+ Nothing -> 0
90+ Just k -> -k
91+ tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))
92+ (fmap (\(t,v) -> (bump +t,v)) tvs )
93+ (fmap (\(t,v) -> (bump'+t,v)) tvs')
94+
95+singleton :: (k, v) -> OMap k v
96+singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
97+
98+-- | If a key appears multiple times, the first occurrence is used for ordering
99+-- and the last occurrence is used for its value. The library author welcomes
100+-- comments on whether this default is sane.
101+fromList :: Ord k => [(k, v)] -> OMap k v
102+fromList = foldl' (|>) empty
103+
104+-- | Take the intersection. The first 'OMap' \'s argument's indices are used for
105+-- the result.
106+--
107+-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/
108+-- is the size of the larger map, and /r/ is the size of the result.
109+intersectionWith ::
110+ Ord k =>
111+ (k -> v -> v' -> v'') ->
112+ OMap k v -> OMap k v' -> OMap k v''
113+intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV
114+ $ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'
Data/Map/Util.hs+25
@@ -1,8 +1,23 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFoldable #-}
5+{-# LANGUAGE DeriveFunctor #-}
6+{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE KindSignatures #-}
8+
1module Data.Map.Util where
9module Data.Map.Util where
2
10
11+import Data.Data (Data, Typeable)
3import Data.Map (Map)
12import Data.Map (Map)
13+import Data.Monoid -- so that the docs for Monoid link to the right place
4import qualified Data.Map as M
14import qualified Data.Map as M
5
15
16+#if !(MIN_VERSION_base(4,8,0))
17+import Data.Foldable (Foldable)
18+import Data.Traversable (Traversable)
19+#endif
20+
6-- | An internal index used to track ordering only -- its magnitude doesn't
21-- | An internal index used to track ordering only -- its magnitude doesn't
7-- matter. If you manage to see this documentation, the library author has made
22-- matter. If you manage to see this documentation, the library author has made
8-- a mistake!
23-- a mistake!
@@ -29,3 +44,13 @@ readsPrecList fromList d = readParen (d > 10) $ \r -> do
29 ("fromList", s) <- lex r
44 ("fromList", s) <- lex r
30 (xs, t) <- reads s
45 (xs, t) <- reads s
31 return (fromList xs, t)
46 return (fromList xs, t)
47+
48+-- | A newtype to hand a 'Monoid' instance on. The phantom first parameter
49+-- tells whether 'mappend' will prefer the indices of its first or second
50+-- argument if there are shared elements in both.
51+newtype Bias (dir :: IndexPreference) a = Bias { unbiased :: a }
52+ deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)
53+data IndexPreference = L | R
54+ deriving Typeable
55+type L = 'L
56+type R = 'R
Data/Set/Ordered.hs+39−2
@@ -1,4 +1,6 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE FlexibleInstances #-}
2
4
3-- | An 'OSet' behaves much like a 'Set', with mostly the same asymptotics, but
5-- | An 'OSet' behaves much like a 'Set', with mostly the same asymptotics, but
4-- also remembers the order that values were inserted. All operations whose
6-- also remembers the order that values were inserted. All operations whose
@@ -17,6 +19,7 @@ module Data.Set.Ordered
17 -- * The left argument's indices are lower than the right argument's indices
19 -- * The left argument's indices are lower than the right argument's indices
18 , (<|), (|<), (>|), (|>)
20 , (<|), (|<), (>|), (|>)
19 , (<>|), (|<>)
21 , (<>|), (|<>)
22+ , Bias(Bias, unbiased), L, R
20 -- * Query
23 -- * Query
21 , null, size, member, notMember
24 , null, size, member, notMember
22 -- * Deletion
25 -- * Deletion
@@ -25,6 +28,8 @@ module Data.Set.Ordered
25 , Index, findIndex, elemAt
28 , Index, findIndex, elemAt
26 -- * List conversions
29 -- * List conversions
27 , fromList, toAscList
30 , fromList, toAscList
31+ -- * 'Set' conversion
32+ , toSet
28 ) where
33 ) where
29
34
30import Control.Monad (guard)
35import Control.Monad (guard)
@@ -32,7 +37,11 @@ import Data.Data
32import Data.Foldable (Foldable, foldl', foldMap, foldr, toList)
37import Data.Foldable (Foldable, foldl', foldMap, foldr, toList)
33import Data.Function (on)
38import Data.Function (on)
34import Data.Map (Map)
39import Data.Map (Map)
35−import Data.Map.Util (Index, Tag, maxTag, minTag, nextHigherTag, nextLowerTag, readsPrecList, showsPrecList)
40+import Data.Map.Util
41+import Data.Monoid (Monoid(..))
42+#if MIN_VERSION_base(4,9,0)
43+import Data.Semigroup (Semigroup(..))
44+#endif
36import Data.Set (Set) -- so the haddocks link to the right place
45import Data.Set (Set) -- so the haddocks link to the right place
37import Prelude hiding (filter, foldr, lookup, null)
46import Prelude hiding (filter, foldr, lookup, null)
38import qualified Data.Map as M
47import qualified Data.Map as M
@@ -56,7 +65,8 @@ instance (Data a, Ord a) => Data (OSet a) where
56 1 -> k (z fromList)
65 1 -> k (z fromList)
57 _ -> error "gunfold"
66 _ -> error "gunfold"
58 dataTypeOf _ = oSetDataType
67 dataTypeOf _ = oSetDataType
68+ -- dataCast1 /must/ be eta-expanded in order to build on GHC 7.8.
59− dataCast1 = gcast1
69+ dataCast1 f = gcast1 f
60
70
61fromListConstr :: Constr
71fromListConstr :: Constr
62fromListConstr = mkConstr oSetDataType "fromList" [] Prefix
72fromListConstr = mkConstr oSetDataType "fromList" [] Prefix
@@ -64,6 +74,27 @@ fromListConstr = mkConstr oSetDataType "fromList" [] Prefix
64oSetDataType :: DataType
74oSetDataType :: DataType
65oSetDataType = mkDataType "Data.Set.Ordered.Set" [fromListConstr]
75oSetDataType = mkDataType "Data.Set.Ordered.Set" [fromListConstr]
66
76
77+#if MIN_VERSION_base(4,9,0)
78+instance Ord a => Semigroup (Bias L (OSet a)) where Bias o <> Bias o' = Bias (o |<> o')
79+instance Ord a => Semigroup (Bias R (OSet a)) where Bias o <> Bias o' = Bias (o <>| o')
80+#endif
81+
82+-- | Empty sets and set union. When combining two sets that share elements, the
83+-- indices of the left argument are preferred.
84+--
85+-- See the asymptotics of ('|<>').
86+instance Ord a => Monoid (Bias L (OSet a)) where
87+ mempty = Bias empty
88+ mappend (Bias o) (Bias o') = Bias (o |<> o')
89+
90+-- | Empty sets and set union. When combining two sets that share elements, the
91+-- indices of the right argument are preferred.
92+--
93+-- See the asymptotics of ('<>|').
94+instance Ord a => Monoid (Bias R (OSet a)) where
95+ mempty = Bias empty
96+ mappend (Bias o) (Bias o') = Bias (o <>| o')
97+
67infixr 5 <|, |< -- copy :
98infixr 5 <|, |< -- copy :
68infixl 5 >|, |>
99infixl 5 >|, |>
69infixr 6 <>|, |<> -- copy <>
100infixr 6 <>|, |<> -- copy <>
@@ -187,3 +218,9 @@ elemAt o@(OSet ts vs) i = do
187-- insertion order.)
218-- insertion order.)
188toAscList :: OSet a -> [a]
219toAscList :: OSet a -> [a]
189toAscList o@(OSet ts _) = fmap fst (M.toAscList ts)
220toAscList o@(OSet ts _) = fmap fst (M.toAscList ts)
221+
222+-- | Convert an 'OSet' to a 'Set'.
223+--
224+-- /O(n)/, where /n/ is the size of the 'OSet'.
225+toSet :: OSet a -> Set a
226+toSet (OSet ts _) = M.keysSet ts
ordered-containers.cabal+3−3
@@ -1,5 +1,5 @@
1name: ordered-containers
1name: ordered-containers
2−version: 0.1.1
2+version: 0.2.2
3synopsis: Set- and Map-like types that remember the order elements were inserted
3synopsis: Set- and Map-like types that remember the order elements were inserted
4license: BSD3
4license: BSD3
5license-file: LICENSE
5license-file: LICENSE
@@ -15,8 +15,8 @@ source-repository head
15 location: https://github.com/dmwit/ordered-containers
15 location: https://github.com/dmwit/ordered-containers
16
16
17library
17library
18− exposed-modules: Data.Map.Ordered, Data.Set.Ordered
18+ exposed-modules: Data.Map.Ordered, Data.Map.Ordered.Strict, Data.Set.Ordered
19− other-modules: Data.Map.Util
19+ other-modules: Data.Map.Ordered.Internal, Data.Map.Util
20 build-depends: base >=4.7 && <5, containers >=0.1 && <0.7
20 build-depends: base >=4.7 && <5, containers >=0.1 && <0.7
21 default-language: Haskell98
21 default-language: Haskell98
22 ghc-options: -fno-warn-tabs
22 ghc-options: -fno-warn-tabs