equivalence-0.2.1: Maintaining an equivalence relation implemented as union-find using STT.

Portabilityunknown
Stabilityunknown
MaintainerPatrick Bahr

Data.Equivalence.Monad

Description

This is an alternative interface to the union-find implementation in ''Data.Equivalence.STT''. It is wrapped into the monad transformer EquivT.

Synopsis

Documentation

class (Monad m, Ord v) => MonadEquiv c v d m | m -> v, m -> c, m -> d whereSource

This class specifies the interface for a monadic computation that maintains an equivalence relation.

Methods

equivalent :: v -> v -> m BoolSource

This function decides whether the two given elements are equivalent in the current equivalence relation

classDesc :: v -> m dSource

This function obtains the descriptor of the given element's equivalence class.

equateAll :: [v] -> m ()Source

This function equates the element in the given list. That is, it unions the equivalence classes of the elements and combines their descriptor.

equate :: v -> v -> m ()Source

This function equates the given two elements. That is it unions the equivalence classes of the two elements.

removeClass :: v -> m BoolSource

This function removes the equivalence class of the given element. If there is no corresponding equivalence class, False is returned; otherwise True.

getClass :: v -> m cSource

This function provides the equivalence class the given element is contained in.

combineAll :: [c] -> m ()Source

This function combines all equivalence classes in the given list. Afterwards all elements in the argument list represent the same equivalence class!

combine :: c -> c -> m cSource

This function combines the two given equivalence classes. Afterwards both arguments represent the same equivalence class! One of it is returned in order to represent the new combined equivalence class.

(===) :: c -> c -> m BoolSource

This function decides whether the two given equivalence classes are the same.

desc :: c -> m dSource

This function returns the descriptor of the given equivalence class.

remove :: c -> m BoolSource

This function removes the given equivalence class. If the equivalence class does not exists anymore False is returned; otherwise True.

Instances

MonadEquiv c v d m => MonadEquiv c v d (ReaderT r m) 
MonadEquiv c v d m => MonadEquiv c v d (StateT s m) 
(MonadEquiv c v d m, Error e) => MonadEquiv c v d (ErrorT e m) 
(MonadEquiv c v d m, Monoid w) => MonadEquiv c v d (WriterT w m) 
(Monad m, Ord v) => MonadEquiv (Class s d v) v d (EquivT s d v m) 

newtype EquivT s c v m a Source

This monad transformer encapsulates computations maintaining an equivalence relation. A monadic computation of type EquivT s c v m a maintains a state space indexed by type s, maintains an equivalence relation over elements of type v with equivalence class descriptors of type c and contains an internal monadic computation of type m a.

Constructors

EquivT 

Fields

unEquivT :: ReaderT (Equiv s c v) (STT s m) a
 

Instances

MonadReader r m => MonadReader r (EquivT s c v m) 
MonadState st m => MonadState st (EquivT s c v m) 
MonadError e m => MonadError e (EquivT s c v m) 
(Monoid w, MonadWriter w m) => MonadWriter w (EquivT s c v m) 
MonadTrans (EquivT s c v) 
(Monad m, Ord v) => MonadEquiv (Class s d v) v d (EquivT s d v m) 
Monad m => Monad (EquivT s c v m) 

type EquivM s c v = EquivT s c v IdentitySource

This monad encapsulates computations maintaining an equivalence relation. A monadic computation of type EquivM s c v a maintains a state space indexed by type s, maintains an equivalence relation over elements of type v with equivalence class descriptors of type c and returns a value of type a.

runEquivTSource

Arguments

:: Monad m 
=> (v -> c)

used to construct an equivalence class descriptor for a singleton class

-> (c -> c -> c)

used to combine the equivalence class descriptor of two classes which are meant to be combined.

-> (forall s. EquivT s c v m a) 
-> m a 

This function runs a monadic computation that maintains an equivalence relation. The first tow arguments specify how to construct an equivalence class descriptor for a singleton class and how to combine two equivalence class descriptors.

runEquivMSource

Arguments

:: (v -> c)

used to construct an equivalence class descriptor for a singleton class

-> (c -> c -> c)

used to combine the equivalence class descriptor of two classes which are meant to be combined.

-> (forall s. EquivM s c v a) 
-> a 

This function runs a monadic computation that maintains an equivalence relation. The first tow arguments specify how to construct an equivalence class descriptor for a singleton class and how to combine two equivalence class descriptors.