disjoint-containers-0.2.4: Disjoint containers

Safe HaskellNone
LanguageHaskell2010

Data.DisjointMap

Contents

Description

Maps with disjoint sets as the key. The type in this module can be roughly understood as:

DisjointMap k v ≈ Map (Set k) v

Internally, DisjointMap is implemented like a disjoint set but the data structure that maps representatives to their rank also holds the value associated with that representative element. Additionally, it holds the set of all keys that in the same equivalence class as the representative. This makes it possible to implementat functions like foldlWithKeys' efficiently.

Synopsis

Documentation

data DisjointMap k v Source #

A map having disjoints sets of k as keys and v as values.

Instances
Functor (DisjointMap k) Source # 
Instance details

Defined in Data.DisjointMap

Methods

fmap :: (a -> b) -> DisjointMap k a -> DisjointMap k b #

(<$) :: a -> DisjointMap k b -> DisjointMap k a #

Foldable (DisjointMap k) Source # 
Instance details

Defined in Data.DisjointMap

Methods

fold :: Monoid m => DisjointMap k m -> m #

foldMap :: Monoid m => (a -> m) -> DisjointMap k a -> m #

foldr :: (a -> b -> b) -> b -> DisjointMap k a -> b #

foldr' :: (a -> b -> b) -> b -> DisjointMap k a -> b #

foldl :: (b -> a -> b) -> b -> DisjointMap k a -> b #

foldl' :: (b -> a -> b) -> b -> DisjointMap k a -> b #

foldr1 :: (a -> a -> a) -> DisjointMap k a -> a #

foldl1 :: (a -> a -> a) -> DisjointMap k a -> a #

toList :: DisjointMap k a -> [a] #

null :: DisjointMap k a -> Bool #

length :: DisjointMap k a -> Int #

elem :: Eq a => a -> DisjointMap k a -> Bool #

maximum :: Ord a => DisjointMap k a -> a #

minimum :: Ord a => DisjointMap k a -> a #

sum :: Num a => DisjointMap k a -> a #

product :: Num a => DisjointMap k a -> a #

Traversable (DisjointMap k) Source # 
Instance details

Defined in Data.DisjointMap

Methods

traverse :: Applicative f => (a -> f b) -> DisjointMap k a -> f (DisjointMap k b) #

sequenceA :: Applicative f => DisjointMap k (f a) -> f (DisjointMap k a) #

mapM :: Monad m => (a -> m b) -> DisjointMap k a -> m (DisjointMap k b) #

sequence :: Monad m => DisjointMap k (m a) -> m (DisjointMap k a) #

(Ord k, Ord v) => Eq (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

Methods

(==) :: DisjointMap k v -> DisjointMap k v -> Bool #

(/=) :: DisjointMap k v -> DisjointMap k v -> Bool #

(Ord k, Ord v) => Ord (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

Methods

compare :: DisjointMap k v -> DisjointMap k v -> Ordering #

(<) :: DisjointMap k v -> DisjointMap k v -> Bool #

(<=) :: DisjointMap k v -> DisjointMap k v -> Bool #

(>) :: DisjointMap k v -> DisjointMap k v -> Bool #

(>=) :: DisjointMap k v -> DisjointMap k v -> Bool #

max :: DisjointMap k v -> DisjointMap k v -> DisjointMap k v #

min :: DisjointMap k v -> DisjointMap k v -> DisjointMap k v #

(Show k, Ord k, Show v) => Show (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

Methods

showsPrec :: Int -> DisjointMap k v -> ShowS #

show :: DisjointMap k v -> String #

showList :: [DisjointMap k v] -> ShowS #

(Ord k, Semigroup v) => Semigroup (DisjointMap k v) Source #

This only satisfies the associativity law when the Monoid instance for v is commutative.

Instance details

Defined in Data.DisjointMap

Methods

(<>) :: DisjointMap k v -> DisjointMap k v -> DisjointMap k v #

sconcat :: NonEmpty (DisjointMap k v) -> DisjointMap k v #

stimes :: Integral b => b -> DisjointMap k v -> DisjointMap k v #

(Ord k, Monoid v) => Monoid (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

Methods

mempty :: DisjointMap k v #

mappend :: DisjointMap k v -> DisjointMap k v -> DisjointMap k v #

mconcat :: [DisjointMap k v] -> DisjointMap k v #

(ToJSON k, ToJSON v) => ToJSON (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

(FromJSON k, FromJSON v, Ord k) => FromJSON (DisjointMap k v) Source # 
Instance details

Defined in Data.DisjointMap

Construction

empty :: DisjointMap k v Source #

The empty map

singleton :: k -> v -> DisjointMap k v Source #

Create a disjoint map with one key: a singleton set. O(1).

singletons :: Eq k => Set k -> v -> DisjointMap k v Source #

Create a disjoint map with one key. Everything in the Set argument is consider part of the same equivalence class.

insert :: (Ord k, Semigroup v) => k -> v -> DisjointMap k v -> DisjointMap k v Source #

Insert a key-value pair into the disjoint map. If the key is is already present in another set, combine the value monoidally with the value belonging to it. The new value is on the left side of the append, and the old value is on the right. Otherwise, this creates a singleton set as a new key and associates it with the value.

union :: (Ord k, Monoid v) => k -> k -> DisjointMap k v -> DisjointMap k v Source #

Create an equivalence relation between x and y. If either x or y are not already in the disjoint set, they are first created as singletons with a value that is mempty.

unionWeakly :: (Ord k, Semigroup v) => k -> k -> DisjointMap k v -> DisjointMap k v Source #

Create an equivalence relation between x and y. If both x and y are missing, do not create either of them. Otherwise, they will both exist in the map.

Query

lookup :: (Ord k, Monoid v) => k -> DisjointMap k v -> v Source #

Find the value associated with the set containing the provided key. If the key is not found, use mempty.

lookup' :: Ord k => k -> DisjointMap k v -> Maybe v Source #

Find the value associated with the set containing the provided key.

representative :: Ord k => k -> DisjointMap k v -> Maybe k Source #

Find the set representative for this input. This function ignores the values in the map.

representative' :: Ord k => k -> DisjointMap k v -> (Maybe k, DisjointMap k v) Source #

Find the set representative for this input. Returns a new disjoint set in which the path has been compressed.

Conversion

toLists :: DisjointMap k v -> [([k], v)] Source #

toSets :: DisjointMap k v -> [(Set k, v)] Source #

fromSets :: Ord k => [(Set k, v)] -> Maybe (DisjointMap k v) Source #

pretty :: (Show k, Show v) => DisjointMap k v -> String Source #

prettyList :: (Show k, Show v) => DisjointMap k v -> [String] Source #

foldlWithKeys' :: (a -> Set k -> v -> a) -> a -> DisjointMap k v -> a Source #

Tutorial

The disjoint map data structure can be used to model scenarios where the key of a map is a disjoint set. Let us consider trying to find the lowest rating of our by town. Due to differing subcultures, inhabitants do not necessarily agree on a canonical name for each town. Consequently, the survey allows participants to write in their town name as they would call it. We begin with a rating data type:

>>> import Data.Function ((&))
>>> data Rating = Lowest | Low | Medium | High | Highest deriving (Eq,Ord,Show)
>>> instance Monoid Rating where mempty = Highest; mappend = min

Notice that the Monoid instance combines ratings by choosing the lower one. Now, we consider the data from the survey:

>>> let resA = [("Big Lake",High),("Newport Lake",Medium),("Dustboro",Low)]
>>> let resB = [("Sand Town",Medium),("Sand Town",High),("Mount Lucy",High)]
>>> let resC = [("Lucy Hill",Highest),("Dustboro",High),("Dustville",High)]
>>> let m1 = foldMap (uncurry singleton) (resA ++ resB ++ resC)
>>> :t m1
m1 :: DisjointMap [Char] Rating
>>> mapM_ putStrLn (prettyList m1)
{"Big Lake"} -> High
{"Dustboro"} -> Low
{"Dustville"} -> High
{"Lucy Hill"} -> Highest
{"Mount Lucy"} -> High
{"Newport Lake"} -> Medium
{"Sand Town"} -> Medium

Since we haven't defined any equivalence classes for the town names yet, what we have so far is no different from an ordinary Map. Now we will introduce some equivalences:

>>> let m2 = m1 & union "Big Lake" "Newport Lake" & union "Sand Town" "Dustboro"
>>> let m3 = m2 & union "Dustboro" "Dustville" & union "Lucy Hill" "Mount Lucy"
>>> mapM_ putStrLn (prettyList m3)
{"Dustboro","Dustville","Sand Town"} -> Low
{"Lucy Hill","Mount Lucy"} -> High
{"Big Lake","Newport Lake"} -> Medium

We can now query the map to find the lowest rating in a given town:

>>> lookup "Dustville" m3
Low
>>> lookup "Lucy Hill" m3
High