pomaps-0.0.1.0: Maps and sets of partial orders

Safe HaskellNone
LanguageHaskell2010

Data.POSet.Internal

Contents

Description

This module doesn't respect the PVP! Breaking changes may happen at any minor version (>= *.*.m.*)

Synopsis

Documentation

This is some setup code for doctest. >>> :set -XGeneralizedNewtypeDeriving >>> import Algebra.PartialOrd >>> import Data.POSet >>> :{ newtype Divisibility = Div Int deriving (Eq, Num) instance Show Divisibility where show (Div a) = show a instance PartialOrd Divisibility where Div a leq Div b = b mod a == 0 type DivSet = POSet Divisibility default (Divisibility, DivSet) :}

newtype POSet k Source #

A set of partially ordered values k.

Constructors

POSet (POMap k ()) 

Instances

Foldable POSet Source # 

Methods

fold :: Monoid m => POSet m -> m #

foldMap :: Monoid m => (a -> m) -> POSet a -> m #

foldr :: (a -> b -> b) -> b -> POSet a -> b #

foldr' :: (a -> b -> b) -> b -> POSet a -> b #

foldl :: (b -> a -> b) -> b -> POSet a -> b #

foldl' :: (b -> a -> b) -> b -> POSet a -> b #

foldr1 :: (a -> a -> a) -> POSet a -> a #

foldl1 :: (a -> a -> a) -> POSet a -> a #

toList :: POSet a -> [a] #

null :: POSet a -> Bool #

length :: POSet a -> Int #

elem :: Eq a => a -> POSet a -> Bool #

maximum :: Ord a => POSet a -> a #

minimum :: Ord a => POSet a -> a #

sum :: Num a => POSet a -> a #

product :: Num a => POSet a -> a #

PartialOrd k => IsList (POSet k) Source # 

Associated Types

type Item (POSet k) :: * #

Methods

fromList :: [Item (POSet k)] -> POSet k #

fromListN :: Int -> [Item (POSet k)] -> POSet k #

toList :: POSet k -> [Item (POSet k)] #

PartialOrd k => Eq (POSet k) Source # 

Methods

(==) :: POSet k -> POSet k -> Bool #

(/=) :: POSet k -> POSet k -> Bool #

(Read a, PartialOrd a) => Read (POSet a) Source # 
Show a => Show (POSet a) Source # 

Methods

showsPrec :: Int -> POSet a -> ShowS #

show :: POSet a -> String #

showList :: [POSet a] -> ShowS #

NFData a => NFData (POSet a) Source # 

Methods

rnf :: POSet a -> () #

PartialOrd k => PartialOrd (POSet k) Source # 

Methods

leq :: POSet k -> POSet k -> Bool

comparable :: POSet k -> POSet k -> Bool

type Item (POSet k) Source # 
type Item (POSet k) = k

Instances

Query

size :: POSet k -> Int Source #

\(\mathcal{O}(1)\). The number of elements in this set.

width :: POSet k -> Int Source #

\(\mathcal{O}(w)\). The width \(w\) of the chain decomposition in the internal data structure. This is always at least as big as the size of the biggest possible anti-chain.

member :: PartialOrd k => k -> POSet k -> Bool Source #

\(\mathcal{O}(w\log n)\). Is the key a member of the map? See also notMember.

notMember :: PartialOrd k => k -> POSet k -> Bool Source #

\(\mathcal{O}(w\log n)\). Is the key not a member of the map? See also member.

lookupLT :: PartialOrd k => k -> POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). Find the largest set of keys smaller than the given one and return the corresponding list of (key, value) pairs.

Note that the following examples assume the Divisibility partial order defined at the top.

>>> lookupLT 3 (fromList [3, 5])
[]
>>> lookupLT 6 (fromList [3, 5])
[3]

lookupLE :: PartialOrd k => k -> POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). Find the largest key smaller or equal to the given one and return the corresponding list of (key, value) pairs.

Note that the following examples assume the Divisibility partial order defined at the top.

>>> lookupLE 2  (fromList [3, 5])
[]
>>> lookupLE 3  (fromList [3, 5])
[3]
>>> lookupLE 10 (fromList [3, 5])
[5]

lookupGE :: PartialOrd k => k -> POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). Find the smallest key greater or equal to the given one and return the corresponding list of (key, value) pairs.

Note that the following examples assume the Divisibility partial order defined at the top.

>>> lookupGE 3 (fromList [3, 5])
[3]
>>> lookupGE 5 (fromList [3, 10])
[10]
>>> lookupGE 6 (fromList [3, 5])
[]

lookupGT :: PartialOrd k => k -> POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). Find the smallest key greater than the given one and return the corresponding list of (key, value) pairs.

Note that the following examples assume the Divisibility partial order defined at the top.

>>> lookupGT 3 (fromList [6, 5])
[6]
>>> lookupGT 5 (fromList [3, 5])
[]

isSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool Source #

\(\mathcal{O}(n_2 w_1 n_1 \log n_1)\). (s1 isSubsetOf s2) tells whether s1 is a subset of s2.

isProperSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool Source #

\(\mathcal{O}(n_2 w_1 n_1 \log n_1)\). Is this a proper subset? (ie. a subset but not equal).

Construction

empty :: POSet k Source #

\(\mathcal{O}(1)\). The empty set.

singleton :: k -> POSet k Source #

\(\mathcal{O}(1)\). A set with a single element.

insert :: PartialOrd k => k -> POSet k -> POSet k Source #

\(\mathcal{O}(w\log n)\). If the key is already present in the map, the associated value is replaced with the supplied value. insert is equivalent to insertWith const.

delete :: PartialOrd k => k -> POSet k -> POSet k Source #

\(\mathcal{O}(w\log n)\). Delete an element from a set.

Combine

Union

union :: PartialOrd k => POSet k -> POSet k -> POSet k Source #

\(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\). The union of two sets, preferring the first set when equal elements are encountered.

unions :: PartialOrd k => [POSet k] -> POSet k Source #

\(\mathcal{O}(wn\log n)\), where \(n=\max_i n_i\) and \(w=\max_i w_i\). The union of a list of sets: (unions == foldl union empty).

Difference

difference :: PartialOrd k => POSet k -> POSet k -> POSet k Source #

\(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\). Difference of two sets.

Intersection

intersection :: PartialOrd k => POSet k -> POSet k -> POSet k Source #

\(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\). The intersection of two sets. Elements of the result come from the first set, so for example

>>> data AB = A | B deriving Show
>>> instance Eq AB where _ == _ = True
>>> instance PartialOrd AB where _ `leq` _ = True
>>> singleton A `intersection` singleton B
fromList [A]
>>> singleton B `intersection` singleton A
fromList [B]

Filter

filter :: (k -> Bool) -> POSet k -> POSet k Source #

\(\mathcal{O}(n)\). Filter all elements that satisfy the predicate.

partition :: (k -> Bool) -> POSet k -> (POSet k, POSet k) Source #

\(\mathcal{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.

takeWhileAntitone :: (k -> Bool) -> POSet k -> POSet k Source #

\(\mathcal{O}(log n)\). Take while a predicate on the keys holds. The user is responsible for ensuring that for all elements j and k in the set, j < k ==> p j >= p k. See note at spanAntitone.

takeWhileAntitone p = filter p

Since: 0.0.1.0

dropWhileAntitone :: (k -> Bool) -> POSet k -> POSet k Source #

\(\mathcal{O}(log n)\). Drop while a predicate on the keys holds. The user is responsible for ensuring that for all elements j and k in the set, j < k ==> p j >= p k. See note at spanAntitone.

dropWhileAntitone p = filter (not . p)

Since: 0.0.1.0

spanAntitone :: (k -> Bool) -> POSet k -> (POSet k, POSet k) Source #

\(\mathcal{O}(log n)\). Divide a set at the point where a predicate on the keys stops holding. The user is responsible for ensuring that for all elements j and k in the set, j < k ==> p j >= p k.

spanAntitone p xs = partition p xs

Note: if p is not actually antitone, then spanAntitone will split the set at some unspecified point where the predicate switches from holding to not holding (where the predicate is seen to hold before the first element and to fail after the last element).

Since: 0.0.1.0

Map

map :: PartialOrd k2 => (k1 -> k2) -> POSet k1 -> POSet k2 Source #

\(\mathcal{O}(wn\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

mapMonotonic :: (k1 -> k2) -> POSet k1 -> POSet k2 Source #

\(\mathcal{O}(n)\). mapMonotonic f s == map f s, but works only when f is strictly increasing. The precondition is not checked. Semi-formally, for every chain ls in s we have:

and [x < y ==> f x < f y | x <- ls, y <- ls]
                    ==> mapMonotonic f s == map f s

Folds

foldr' :: (a -> b -> b) -> b -> POSet a -> b Source #

\(\mathcal{O}(n)\). A strict version of foldr. Each application of the operator is evaluated before using the result in the next application. This function is strict in the starting value.

foldl' :: (b -> a -> b) -> b -> POSet a -> b Source #

\(\mathcal{O}(n)\). A strict version of foldl. Each application of the operator is evaluated before using the result in the next application. This function is strict in the starting value.

Min/Max

lookupMin :: PartialOrd k => POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). The minimal keys of the set.

lookupMax :: PartialOrd k => POSet k -> [k] Source #

\(\mathcal{O}(w\log n)\). The maximal keys of the set.

Conversion

elems :: POSet k -> [k] Source #

\(\mathcal{O}(n)\). The elements of a set in unspecified order.

toList :: POSet k -> [k] Source #

\(\mathcal{O}(n)\). The elements of a set in unspecified order.

fromList :: PartialOrd k => [k] -> POSet k Source #

\(\mathcal{O}(wn\log n)\). Build a set from a list of keys.