Maintainer | Olaf Klinke |
---|---|
Stability | experimental |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
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
Synopsis
- data Ultrafilter ty
- principalUltrafilter :: ty p -> Ultrafilter ty
- mapUF :: GStone f g -> Ultrafilter f -> Ultrafilter g
- type StoneSpace x = (Generic x, GStoneSpace (Rep x))
- spec :: (Generic x, StoneSpace y) => GStone (Rep x) (Rep y) -> x -> y
- point :: StoneSpace x => Ultrafilter (Rep x) -> x
- toPattern :: StoneSpace x => (x -> Bool) -> Maybe (Predicate (Rep x))
- class Eq (f ()) => GStoneSpace f where
- covers :: GStoneSpace f => Predicate f -> Bool
- deletes :: GStoneSpace f => Predicate f -> Bool
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
type StoneSpace x = (Generic x, GStoneSpace (Rep x)) Source #
spec :: (Generic x, StoneSpace y) => GStone (Rep x) (Rep y) -> x -> y Source #
Predicate transformers between
Rep
resentations 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 ::
.
Define the filter Integer
-> Bool
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 Predicate
s.
Instances
GStoneSpace (U1 :: Type -> Type) Source # | Singletons are Stone spaces |
GStoneSpace f => GStoneSpace (Rec1 f) Source # | |
(GStoneSpace f, GStoneSpace g) => GStoneSpace (f :*: g) Source # | Products of Stone spaces are Stone spaces |
(GStoneSpace f, GStoneSpace g) => GStoneSpace (f :+: g) Source # | Coproducts of Stone spaces are Stone spaces. This crucially relies on the algebraic properties of ultrafilters. |
(Generic c, Eq c, Rep c ~ f, GStoneSpace f) => GStoneSpace (K1 i c :: Type -> Type) Source # | |
GStoneSpace f => GStoneSpace (M1 i m f) Source # | |