1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
-- ----------------------------------------------------------------------------
{- |
Module : Holumbus.Data.MultiMap
Copyright : Copyright (C) 2008 Stefan Schmidt
License : MIT
Maintainer : Stefan Schmidt (stefanschmidt@web.de)
Stability : experimental
Portability: portable
Version : 0.1
This module provides a MultiMap, that means a Map, which can hold
multiple values for one key, but every distinct value is only stores once.
So adding the same key-value-pair twice will only create one new entry in
the map.
This Map is helpfull to examine how many different key-values-pairs you
have in your application.
Most of the functions are borrowed from Data.Map
-}
-- ----------------------------------------------------------------------------
module Holumbus.Data.MultiMap
(
MultiMap
, empty
, null
, insert
, insertSet
, insertKeys
, lookup
, keys
, elems
, filterElements
, member
, delete
, deleteKey
, deleteElem
, deleteElemIf
, deleteAllElems
, fromList
, fromTupleList
, toList
, toAscList
)
where
import Prelude hiding (null, lookup)
import qualified Data.Map as Map
import qualified Data.Set as Set
-- | A MultiMap, it can hold more (different!!!) Elements for one key.
data MultiMap k a = MM (Map.Map k (Set.Set a))
deriving (Show, Eq, Ord)
{-
instance (Show k, Show a) => Show (MultiMap k a) where
show (MM m) = msShow
where
ms = map (\(k,s) -> (k, Set.toList s)) (Map.toList m)
msShow = concat $ map (\(k,s) -> (show k) ++ "\n" ++ (showL s)) ms
showL ls = concat $ map (\s -> show s ++ "\n") ls
-}
-- | The empty MultiMap.
empty :: (Ord k, Ord a) => MultiMap k a
empty = MM Map.empty
-- | Test, if the MultiMap is empty.
null :: (Ord k, Ord a) => MultiMap k a -> Bool
null (MM m) = Map.null m
-- | Inserts an element in the MultiMap.
insert :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a
insert k a (MM m) = MM $ Map.alter altering k m
where
altering Nothing = Just $ Set.singleton a
altering (Just s) = Just $ Set.insert a s
-- | Inserts multiple elements in a set to the MultiMap.
insertSet :: (Ord k, Ord a) => k -> Set.Set a -> MultiMap k a -> MultiMap k a
insertSet k newSet mm@(MM m) =
if (Set.null newSet) then mm else MM $ Map.alter altering k m
where
altering Nothing = Just newSet
altering (Just s) = Just $ Set.union newSet s
-- | Inserts multiple keys with the same values.
insertKeys :: (Ord k, Ord a) => [k] -> Set.Set a -> MultiMap k a -> MultiMap k a
insertKeys ks a m = foldl (\m' k -> insertSet k a m') m ks
-- | Gets all different elements for one key or an empty set.
lookup :: (Ord k, Ord a) => k -> MultiMap k a -> Set.Set a
lookup k (MM m) = maybe (Set.empty) (id) (Map.lookup k m)
-- | Get all different elements from a list of keys.
lookupKeys :: (Ord k, Ord a) => [k] -> MultiMap k a -> Set.Set a
lookupKeys ks m = Set.unions $ map (\k -> lookup k m) ks
-- | Get all different keys from the map.
keys :: (Ord k, Ord a) => MultiMap k a -> Set.Set k
keys (MM m) = Set.fromList $ Map.keys m
-- | Get all different values in the map without regarding their keys.
elems :: (Ord k, Ord a) => MultiMap k a -> Set.Set a
elems (MM m) = Set.unions $ Map.elems m
-- | Like lookup keys, but an empty input list will give all elements back,
-- not the empty set.
filterElements :: (Ord k, Ord a) => [k] -> MultiMap k a -> Set.Set a
filterElements [] m = elems m -- get all
filterElements ks m = lookupKeys ks m
-- | Test, if a key is in the Map.
member :: (Ord k, Ord a) => k -> MultiMap k a -> Bool
member k m = Set.empty /= lookup k m
-- | Deletes an Element from the Map, if the data in Nothing, the whole key is
-- deleted.
delete :: (Ord k, Ord a) => k -> Maybe a -> MultiMap k a -> MultiMap k a
delete k Nothing m = deleteKey k m
delete k (Just a) m = deleteElem k a m
-- | Deletes a whole key from the map.
deleteKey :: (Ord k, Ord a) => k -> MultiMap k a -> MultiMap k a
deleteKey k (MM m) = MM $ Map.delete k m
-- | Deletes a single Element from the map.
deleteElem :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a
deleteElem k a (MM m) = MM $ Map.alter delSet k m
where
delSet Nothing = Nothing
delSet (Just set) = filterEmpty $ Set.delete a set
filterEmpty set
| set == Set.empty = Nothing
| otherwise = Just set
-- | Deletes a single Element from the map.
deleteElemIf :: (Ord k, Ord a) => k -> (a -> Bool) -> MultiMap k a -> MultiMap k a
deleteElemIf k pred (MM m) = MM $ Map.alter delSet k m
where
delSet Nothing = Nothing
delSet (Just set) = filterEmpty $ Set.filter (not . pred) set
filterEmpty set
| set == Set.empty = Nothing
| otherwise = Just set
-- | Deletes all Elements (*,a) (slow!!!).
deleteAllElems :: (Ord k, Ord a) => a -> MultiMap k a -> MultiMap k a
deleteAllElems a m = foldl (\m'' k -> deleteElem k a m'') m ks
where
ks = Set.toList $ keys m
-- | Creates a MultiMap from a list of pairs (key,set value).
fromList :: (Ord k, Ord a) => [(k,Set.Set a)] -> MultiMap k a
fromList ks = foldl (\m (k,as) -> insertSet k as m) empty ks
-- | Creates a MultiMap from a list of tuples.
fromTupleList :: (Ord k, Ord a) => [(k,a)] -> MultiMap k a
fromTupleList ks = foldl (\m (k,a) -> insert k a m) empty ks
-- | Transforms a MultiMap to a list of pairs (key,set value).
toList :: (Ord k, Ord a) => MultiMap k a -> [(k,Set.Set a)]
toList (MM m) = Map.toList m
-- | The same as toList, but the keys are in ascending order.
toAscList :: (Ord k, Ord a) => MultiMap k a -> [(k,Set.Set a)]
toAscList (MM m) = Map.toAscList m
|
