refined-subtype-0.1.0.0: compute subtypes from refinement types
MaintainerOlaf Klinke
Stabilityexperimental
Safe HaskellSafe-Inferred
LanguageHaskell2010

Topology.StoneSpace

Description

Stone duality relates Boolean algebras and Boolean homomorphisms to certain topological spaces, today known as Stone spaces. At the heart is a dual adjunction comprising

  1. the contavariant functor spec that maps a Boolean algebra to the space of its ultrafilters,
  2. the contravariant functor Predicate that maps a space to the Boolean algebra of clopen subsets.
Synopsis

Ultrafilters

data Ultrafilter ty Source #

An ultrafilter is a Boolean homomorphism from predicates to truth values.

principalUltrafilter :: ty p -> Ultrafilter ty Source #

Evaluation of predicates at a single point yields the so-called principal ultrafilters.

mapUF :: GStone f g -> Ultrafilter f -> Ultrafilter g Source #

Ultrafilters are functorial on the category GStone.

Stone spaces

spec :: (Generic x, StoneSpace y) => GStone (Rep x) (Rep y) -> x -> y Source #

Predicate transformers between Representations of Stone spaces encode ordinary functions. This mapping is the morphism part of the spectrum functor.

point :: StoneSpace x => Ultrafilter (Rep x) -> x Source #

Find the point at which the ultrafilter is fixed.

toPattern :: StoneSpace x => (x -> Bool) -> Maybe (Predicate (Rep x)) Source #

Attempts to transform a predicate to a Predicate representation. This will not work if the predicate inspects both parts of a tuple. For simple pattern matches, it works:

>>> isJust (toPattern ((either id (LT==).fst) :: (Either Bool Ordering,()) -> Bool))
True

Generic representations of Stone spaces

class Eq (f ()) => GStoneSpace f where Source #

A Stone space is isomorphic to the space of its ultrafilters. gpoint is inverse to principalUltrafilter. Stone spaces are totally disconnected, hence the Eq superclass. Further, every Stone space is topologically compact, whence it is decidable whether the extent of a predicate covers the entire space. The function covers is a meet-semilattice homomorphism and its logical negation deletes is a join-semilattice homomorphism.

Observe that there are types with ultrafilters that are not principal. Their existence is guaranteed by the Ultrafilter Lemma, which is a consequence of the Prime Ideal Theorem. Notably, consider total predicates p :: Integer -> Bool. Define the filter

f p = ∃ n. ∀ m ≥ n. p m

This collects all predicates that are eventually true for sufficiently large numbers. Obviously for every number n the predicate p = (n ==) is not part of the filter f, whence any ultrafilter containing f can not be principal at any number. But by the Ultrafilter Lemma, f is indeed contained in some ultrafilter.

Minimal complete definition

extent, (gpoint | gSpec), maybePattern

Methods

gpoint :: Ultrafilter f -> f p Source #

gSpec :: GStone g f -> g p -> f p Source #

extent :: Predicate f -> K (f p) Source #

maybePattern :: (f () -> Bool) -> Maybe (Predicate f) Source #

predicates that are pattern matches can automatically be transformed into Predicates.

Instances

Instances details
GStoneSpace (U1 :: Type -> Type) Source #

Singletons are Stone spaces

Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter U1 -> U1 p Source #

gSpec :: GStone g U1 -> g p -> U1 p Source #

extent :: Predicate U1 -> K (U1 p) Source #

maybePattern :: (U1 () -> Bool) -> Maybe (Predicate U1) Source #

GStoneSpace f => GStoneSpace (Rec1 f) Source # 
Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter (Rec1 f) -> Rec1 f p Source #

gSpec :: GStone g (Rec1 f) -> g p -> Rec1 f p Source #

extent :: Predicate (Rec1 f) -> K (Rec1 f p) Source #

maybePattern :: (Rec1 f () -> Bool) -> Maybe (Predicate (Rec1 f)) Source #

(GStoneSpace f, GStoneSpace g) => GStoneSpace (f :*: g) Source #

Products of Stone spaces are Stone spaces

Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter (f :*: g) -> (f :*: g) p Source #

gSpec :: GStone g0 (f :*: g) -> g0 p -> (f :*: g) p Source #

extent :: Predicate (f :*: g) -> K ((f :*: g) p) Source #

maybePattern :: ((f :*: g) () -> Bool) -> Maybe (Predicate (f :*: g)) Source #

(GStoneSpace f, GStoneSpace g) => GStoneSpace (f :+: g) Source #

Coproducts of Stone spaces are Stone spaces. This crucially relies on the algebraic properties of ultrafilters.

Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter (f :+: g) -> (f :+: g) p Source #

gSpec :: GStone g0 (f :+: g) -> g0 p -> (f :+: g) p Source #

extent :: Predicate (f :+: g) -> K ((f :+: g) p) Source #

maybePattern :: ((f :+: g) () -> Bool) -> Maybe (Predicate (f :+: g)) Source #

(Generic c, Eq c, Rep c ~ f, GStoneSpace f) => GStoneSpace (K1 i c :: Type -> Type) Source # 
Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter (K1 i c) -> K1 i c p Source #

gSpec :: GStone g (K1 i c) -> g p -> K1 i c p Source #

extent :: Predicate (K1 i c) -> K (K1 i c p) Source #

maybePattern :: (K1 i c () -> Bool) -> Maybe (Predicate (K1 i c)) Source #

GStoneSpace f => GStoneSpace (M1 i m f) Source # 
Instance details

Defined in Topology.StoneSpace

Methods

gpoint :: Ultrafilter (M1 i m f) -> M1 i m f p Source #

gSpec :: GStone g (M1 i m f) -> g p -> M1 i m f p Source #

extent :: Predicate (M1 i m f) -> K (M1 i m f p) Source #

maybePattern :: (M1 i m f () -> Bool) -> Maybe (Predicate (M1 i m f)) Source #

covers :: GStoneSpace f => Predicate f -> Bool Source #

True if the predicate holds for all elements of the spectrum.

deletes :: GStoneSpace f => Predicate f -> Bool Source #

True if the negation of the predicate covers.