connections-0.1.0: Orders, Galois connections, and lattices.

Safe HaskellSafe
LanguageHaskell2010

Data.Order.Topology

Contents

Synopsis

Left and right separated Alexandrov topologies

data Kan Source #

A data kind distinguishing the chirality of a Kan extension.

Constructors

L 
R 

data Open (k :: Kan) a Source #

A pointed open set in a separated left or right Alexandrov topology.

Instances
Lattice a => Semigroup (Meet (Sup a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

(<>) :: Meet (Sup a) -> Meet (Sup a) -> Meet (Sup a) #

sconcat :: NonEmpty (Meet (Sup a)) -> Meet (Sup a) #

stimes :: Integral b => b -> Meet (Sup a) -> Meet (Sup a) #

Lattice a => Semigroup (Meet (Inf a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

(<>) :: Meet (Inf a) -> Meet (Inf a) -> Meet (Inf a) #

sconcat :: NonEmpty (Meet (Inf a)) -> Meet (Inf a) #

stimes :: Integral b => b -> Meet (Inf a) -> Meet (Inf a) #

Lattice a => Semigroup (Join (Sup a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

(<>) :: Join (Sup a) -> Join (Sup a) -> Join (Sup a) #

sconcat :: NonEmpty (Join (Sup a)) -> Join (Sup a) #

stimes :: Integral b => b -> Join (Sup a) -> Join (Sup a) #

Lattice a => Semigroup (Join (Inf a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

(<>) :: Join (Inf a) -> Join (Inf a) -> Join (Inf a) #

sconcat :: NonEmpty (Join (Inf a)) -> Join (Inf a) #

stimes :: Integral b => b -> Join (Inf a) -> Join (Inf a) #

Bounded a => Monoid (Meet (Sup a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

mempty :: Meet (Sup a) #

mappend :: Meet (Sup a) -> Meet (Sup a) -> Meet (Sup a) #

mconcat :: [Meet (Sup a)] -> Meet (Sup a) #

Bounded a => Monoid (Meet (Inf a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

mempty :: Meet (Inf a) #

mappend :: Meet (Inf a) -> Meet (Inf a) -> Meet (Inf a) #

mconcat :: [Meet (Inf a)] -> Meet (Inf a) #

LowerBounded a => Monoid (Join (Sup a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

mempty :: Join (Sup a) #

mappend :: Join (Sup a) -> Join (Sup a) -> Join (Sup a) #

mconcat :: [Join (Sup a)] -> Join (Sup a) #

UpperBounded a => Monoid (Join (Inf a)) Source # 
Instance details

Defined in Data.Order.Topology

Methods

mempty :: Join (Inf a) #

mappend :: Join (Inf a) -> Join (Inf a) -> Join (Inf a) #

mconcat :: [Join (Inf a)] -> Join (Inf a) #

(Finite a, Bounded a) => Bounded (Sup a) Source # 
Instance details

Defined in Data.Order.Topology

Methods

reduce :: (Foldable f, Functor f) => f (f (Sup a)) -> Sup a Source #

(Finite a, Bounded a) => Bounded (Inf a) Source # 
Instance details

Defined in Data.Order.Topology

Methods

reduce :: (Foldable f, Functor f) => f (f (Inf a)) -> Inf a Source #

(Finite a, Lattice a) => Lattice (Sup a) Source # 
Instance details

Defined in Data.Order.Topology

Methods

reduce1 :: (Foldable1 f, Functor f) => f (f (Sup a)) -> Sup a Source #

glb :: Sup a -> Sup a -> Sup a -> Sup a Source #

lub :: Sup a -> Sup a -> Sup a -> Sup a Source #

(Finite a, Lattice a) => Lattice (Inf a) Source # 
Instance details

Defined in Data.Order.Topology

Methods

reduce1 :: (Foldable1 f, Functor f) => f (f (Inf a)) -> Inf a Source #

glb :: Inf a -> Inf a -> Inf a -> Inf a Source #

lub :: Inf a -> Inf a -> Inf a -> Inf a Source #

Show a => Show (Open k a) Source # 
Instance details

Defined in Data.Order.Topology

Methods

showsPrec :: Int -> Open k a -> ShowS #

show :: Open k a -> String #

showList :: [Open k a] -> ShowS #

Finite a => Preorder (Open k a) Source #

Note that ~~ is strictly weaker than ==, as it ignores the location of the base point.

Instance details

Defined in Data.Order.Topology

Methods

(<~) :: Open k a -> Open k a -> Bool Source #

(>~) :: Open k a -> Open k a -> Bool Source #

(<) :: Open k a -> Open k a -> Bool Source #

(>) :: Open k a -> Open k a -> Bool Source #

(?~) :: Open k a -> Open k a -> Bool Source #

(~~) :: Open k a -> Open k a -> Bool Source #

(/~) :: Open k a -> Open k a -> Bool Source #

similar :: Open k a -> Open k a -> Bool Source #

pcompare :: Open k a -> Open k a -> Maybe Ordering Source #

pmax :: Open k a -> Open k a -> Maybe (Open k a) Source #

pmin :: Open k a -> Open k a -> Maybe (Open k a) Source #

lower :: Open k a -> a Source #

The base point of a pointed lower set (i.e. an Inf).

upper :: Open k a -> a Source #

The base point of a pointed upper set (i.e. a Sup).

omap :: Trip a b -> Open k a -> Open k b Source #

Map over a pointed open set in either topology.

The left (Inf) topology

type Inf = Open L Source #

inf :: UpperBounded a => a -> Inf a Source #

Create an upper set: \( X_\geq(x) = \{ y \in X | y \geq x \} \)

Upper sets are the open sets of the left Alexandrov topology.

This function is monotone:

x <~ y <=> inf x <~ inf y

by the Yoneda lemma for preorders.

(.?) :: Preorder a => Inf a -> a -> Bool infix 4 Source #

Check for membership in an Inf.

filterL :: Lattice a => a -> Inf a -> Inf a infixr 5 Source #

Filter an Inf with an anti-filter.

The resulting set is open in the separated left Alexandrov topology.

Intersecting with an incomparable element cuts out everything larger than its join with the base point:

>>> p = inf pi :: Inf Double
>>> p .? 1/0
True
>>> filterL (0/0) p .? 1/0
False

An example w/ the set inclusion lattice: >>> x = Set.fromList [6,40] :: Set.Set Word8 >>> y = Set.fromList [1,6,9] :: Set.Set Word8 >>> z = filterL y $ inf x fromList [6,40] ... fromList [1,6,9,40] >>> z .? Set.fromList [1,6,40] True >>> z .? Set.fromList [6,9,40] True >>> z .? Set.fromList [1,6,9,40] False

The right (Sup) topology

type Sup = Open R Source #

sup :: LowerBounded a => a -> Sup a Source #

Create a lower set \( X_\leq(x) = \{ y \in X | y \leq x \} \)

Lower sets are the open sets of the right Alexandrov topology.

This function is antitone:

x <~ y <=> sup x >~ sup y

by the Yoneda lemma for preorders.

(?.) :: Preorder a => a -> Sup a -> Bool infix 4 Source #

Check for membership in a Sup.

filterR :: Lattice a => a -> Sup a -> Sup a infixl 5 Source #

Filter a Sup with an anti-ideal.

The resulting set is open in the separated right Alexandrov topology.

>>> p = sup pi :: Sup Double
>>> -1/0 ?. p
True
>>> -1/0 ?. filterR (0/0) p
False