-- Algorithm", JACM 22(2), 1975) in order to maintain an equivalence

+-- This implementation is a port of the /union-find/ package using the

+-- ST monad transformer (instead of the IO monad).

-- The implementation is based on mutable references. Each

-- equivalence class has exactly one member that serves as its

-- representative element. Every element either is the representative

-- element. Consequently future lookups will be have a path length of

+-- Each equivalence class remains a descriptor, i.e. some piece of

+-- data attached to an equivalence class which is combined when two

--------------------------------------------------------------------------------

import qualified Data.Map as Map

+{-| This type represents a reference to an entry in the tree data

+structure. An entry of type 'Entry' @s c a@ lives in the state space

+indexed by @s@, contains equivalence class descriptors of type @c@ and

+has elements of type @a@.-}

newtype Entry s c a = Entry (STRef s (EntryData s c a))

+{-| This type represents entries (nodes) in the tree data

+structure. Entry data of type 'EntryData' @s c a@ lives in the state space

+indexed by @s@, contains equivalence class descriptors of type @c@ and

+has elements of type @a@. -}

data EntryData s c a = Node {

entryParent :: Entry s c a,

+{-| This is the top-level data structure that represents an

+equivalence relation. An equivalence relation of type 'Equiv' @s c a@

+lives in the state space indexed by @s@, contains equivalence class

+descriptors of type @c@ and has elements of type @a@. -}

data Equiv s c a = Equiv {

- entries :: STRef s (Map a (Entry s c a)),

+ -- | maps elements to their entry in the tree data structure

+ entries :: STRef s (Map a (Entry s c a)),

+ -- | constructs an equivalence class descriptor for a singleton class

+ -- | combines the equivalence class descriptor of two classes

+ -- which are meant to be combined.

+ This function modifies the content of a reference cell.

modifySTRef :: (Monad m) => STRef s a -> (a -> a) -> STT s m ()

modifySTRef r f = readSTRef r >>= (writeSTRef r . f)

-leastEquiv :: Monad m => (a -> c) -> (c -> c -> c) -> STT s m (Equiv s c a)

+{-| This function constructs the initial data structure for

+maintaining an equivalence relation. That is it represents, the fines

+(or least) equivalence class (of the set of all elements of type

+@a@). The arguments are used to maintain equivalence class

+ -- | used to construct an equivalence class descriptor for a singleton class

+ -- | used to combine the equivalence class descriptor of two classes

+ -- which are meant to be combined.

+ -> STT s m (Equiv s c a)

return Equiv {entries = es, singleDesc = mk, combDesc = com}

--- | /O(1)/. @repr point@ returns the representative point of

--- @point@'s equivalence class or @Nothing$ if it itself is the

--- representative of its class.

--- This method performs the path compresssion.

+{-| This function returns the representative entry of the argument's

+equivalence class (i.e. the root of its tree) or @Nothing@ if it is

+the representative itself.

+This function performs path compression. -}

representative' :: Monad m => Entry s c a -> STT s m (Maybe (Entry s c a))

representative' (Entry e) = do

Just parent' -> writeSTRef e ed{entryParent = parent'} >> return (Just parent')

--- | /O(1)/. @repr point@ returns the representative point of

--- @point@'s equivalence class.

--- This method performs the path compresssion.

+{-| This function returns the representative entry of the argument's

+equivalence class (i.e. the root of its tree).

+This function performs path compression. -}

representative :: Monad m => Entry s c a -> STT s m (Entry s c a)

representative entry = do

mrepr <- representative' entry

+{-| This function looks up the entry of the given element in the given

+equivalence relation representation. If there is none yet, then a

+fresh one is constructed which then represents a new singleton

getEntry' :: (Monad m, Ord a) => Equiv s c a -> a -> STT s m (Entry s c a)

getEntry' Equiv {entries = mref, singleDesc = mkDesc} val = do

Just entry -> return entry

+{-| This function looks up the entry of the given element in the given

+equivalence relation representation or @Nothing@ if there is none,

getEntry :: (Monad m, Ord a) => Equiv s c a -> a -> STT s m (Maybe (Entry s c a))

getEntry Equiv { entries = mref} val = do

Nothing -> return Nothing

Just entry -> return $ Just entry

+{-| This function equates the two given elements. That is, it unions

+the equivalence classes of the two elements and combines their

equate :: (Monad m, Ord a) => Equiv s c a -> a -> a -> STT s m ()

+{-| This function equates the two given entries. That is, it performs

+a weighted union of their trees combines their descriptor. -}

equate' :: (Monad m, Ord a) => Equiv s c a -> Entry s c a -> Entry s c a -> STT s m ()

equate' Equiv {combDesc = mkDesc} x y = do

repx@(Entry rx) <- representative x

writeSTRef rx Node {entryParent = repy, entryValue = vx}

writeSTRef ry dy{entryWeight = wx + wy, entryDesc = mkDesc chx chy}

+{-| This function returns the descriptor of the given element's

classDesc :: (Monad m, Ord a) => Equiv s c a -> a -> STT s m c

mentry <- getEntry eq val

Nothing -> return $ singleDesc eq val

Just entry -> classDesc' entry

+{-| This function returns the descriptor of the given entry's tree. -}

classDesc' :: (Monad m) => Entry s c a -> STT s m c

Entry e <- representative entry

liftM entryDesc $ readSTRef e

--- | /O(1)/. Return @True@ if both points belong to the same

+{-| This function decides whether the two given elements are in the

+same equivalence class according to the given equivalence relation

equivalent :: (Monad m, Ord a) => Equiv s c a -> a -> a -> STT s m Bool

(Nothing, Nothing) -> return $ v1 == v2

+{-| This function decides whether the two given entries are in the

+same tree (by comparing their roots).-}

equivalent' :: (Monad m, Ord a) => Entry s c a -> Entry s c a -> STT s m Bool

equivalent' e1 e2 = liftM2 (==) (representative e1) (representative e2)